Forum > Jobs

[Done] $50 - Create an example of using Gadgets in Intuition for AmigaOS 3.x


I'm having trouble getting Gadgets to work in Intuition for AmigaOS 3.x

All I'm needing is a working example of an Intuition window with three different gadgets and how to read their values/respond to actions/IDCMP messages for them.

Gadgets: Text input, Button, Checkbox/Radio/Toggle (Pick one)

Payment through PayPal.

Many thanks to TRon for providing the following example!
I've tested it on AROS 68k as well as AmigaOS 3.x

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program trenatos; {$ifndef HASAMIGA}{$fatal This source is compatible with Amiga, AROS and MorphOS only !}{$endif} {$h+}{$hints ON}  {  Project     : gadtools gadgets example for Trenatos  Details     : modified example from RKRM to match request  Reference   : RKRM, gadtoolsgadgets.c  Date        : 2024-03-17}  {* ** Simple example of using a number of gadtools gadgets. *} uses  exec, agraphics, intuition, gadtools, utility;  {$ifdef AROS}{* sight, 12 years and still going strong !! outrage ! *}function  GT_GetGadgetAttrs(gad:pGadget; win:pWindow; req:pRequester; Const argv:array of PtrUInt): LONGINT; begin GT_GetGadgetAttrs:=GT_GetGadgetAttrsA(gad,win,req,@argv); end;procedure GT_SetGadgetAttrs(gad:pGadget; win:pWindow; req:pRequester; Const argv:array of PtrUInt); begin GT_SetGadgetAttrsA(gad,win,req,@argv); end;function  CreateGadget(kind:ULONG; gad:pGadget; ng:pNewGadget; Const argv:array of PtrUInt): pGadget; begin CreateGadget:=CreateGadgetA(kind,gad,ng,@argv); end;function  GetVisualInfo(screen:pScreen; const argv:array of PtrUInt):POINTER; begin GetVisualInfo:=GetVisualInfoA(screen,@argv); end;{$endif}  type  {*  ** Gadget defines of our choosing, to be used as GadgetID's,  ** also used as the index into the gadget array my_gads[].  *}  TMyGadgets = (tmgString, tmgCheckBox, tmgRadioBtn, tmgButton); const   Topaz80       : TTextAttr =  (    ta_Name     : 'topaz.font';    ta_YSize    : 8;    ta_Style    : 0;    ta_Flags    : 0;  );  var  // strings used for the radiobuttons. This declaration must  // be similar to ppchar, e.g. terminated with zero.  RadioStrings : array[0..3] of pchar = ('Free Pascal','on','Amiga', nil);  {*** Print any error message.  We could do more fancy handling (like** an EasyRequest()), but this is only a demo.*}procedure errorMessage(error: STRPTR);begin  if assigned(error)    then WriteLn('Error: ', error);end;  {*** Function to handle a GADGETUP or GADGETDOWN event.  For GadTools gadgets,** it is possible to use this function to handle MOUSEMOVEs as well, with** little or no work.*}procedure handleGadgetEvent(win: PWindow; gad: PGadget; code: UWORD; my_gads: array of PGadget);var  StrBuf             : pchar;  CheckBoxStatus     : longbool;  SelectedRadioIndex : ulong;  n                  : integer;  // number of requested/returned attributes, if they differ then an error occured.begin  case TMyGadgets(gad^.GadgetID) of    tmgSTRING:    begin      //* String gadgets report GADGETUP's */      WriteLn('String gadget 1: "', PStringInfo(gad^.SpecialInfo)^.Buffer ,'".');    end;     tmgCheckBox:    begin      writeln('checkbox clicked');    end;     tmgRADIOBTN:    begin      //* String gadgets report GADGETUP's */      WriteLn('radio button clicked');    end;     tmgButton:    begin      //* Buttons report GADGETUP's */      WriteLn('Button was pressed, now displaying some gadget info.');       // obtain and emit info on string gadget      n := GT_GetGadgetAttrs(my_gads[ord(tmgString)], win, nil,      [         GTST_String, AsTag(@StrBuf),         TAG_END      ]);      if n = 1 then writeln('string contents = "', StrBuf, '"')      else writeln('unable to obtain contents from string gadget');       // obtain and emit info on CheckBox gadget      n := GT_GetGadgetAttrs(my_gads[ord(tmgCheckBox)], win, nil,      [        GTCB_Checked, AsTag(@CheckBoxStatus),        TAG_END      ]);      if n = 1 then writeln('checkbox status = ', CheckBoxStatus)      else writeln('unable to obtain status from CheckBox gadget');       // obtain and emit info on MX gadget      n := GT_GetGadgetAttrs(my_gads[ord(tmgRadioBtn)], win, nil,      [        GTMX_Active, AsTag(@SelectedRadioIndex),        TAG_END      ]);      if n = 1 then writeln('selected radio (string) index = ', SelectedRadioIndex)      else writeln('unable to obtain index from RadioBtn (MX) gadget');     end;  end;end;  {*** Function to handle vanilla keys.*}procedure handleVanillaKey(win: PWindow; code: UWORD; my_gads: array of PGadget);begin  case chr(code) of    'f', 'F':    begin      ActivateGadget(my_gads[ord(tmgSTRING)], win, nil);    end;    's', 'S':    begin      ActivateGadget(my_gads[ord(tmgCHECKBOX)], win, nil);    end;    't', 'T':    begin      ActivateGadget(my_gads[ord(tmgRADIOBTN)], win, nil);    end;  end;end;  {*** Here is where all the initialization and creation of GadTools gadgets** take place.  This function requires a pointer to a NULL-initialized** gadget list pointer.  It returns a pointer to the last created gadget,** which can be checked for success/failure.*}function  createAllGadgets(var glistptr: PGadget; vi: Pointer;    topborder: UWORD; var my_gads: array of PGadget): PGadget;var  ng  : TNewGadget;  gad : PGadget;begin  {*  ** All the gadget creation calls accept a pointer to the previous gadget, and  ** link the new gadget to that gadget's NextGadget field.  Also, they exit  ** gracefully, returning NULL, if any previous gadget was NULL.  This limits  ** the amount of checking for failure that is needed.  You only need to check  ** before you tweak any gadget structure or use any of its fields, and finally  ** once at the end, before you add the gadgets.  *}   {*  ** The following operation is required of any program that uses GadTools.  ** It gives the toolkit a place to stuff context data.  *}  gad := CreateContext(@glistptr);   {*  ** Since the NewGadget structure is unmodified by any of the CreateGadget()  ** calls, we need only change those fields which are different.  *}  ng.ng_LeftEdge    := 140;  ng.ng_TopEdge     := 20 + topborder;  ng.ng_Width       := 200;  ng.ng_Height      := 12;  ng.ng_GadgetText  := '_Volume:   ';  ng.ng_TextAttr    := @Topaz80;  ng.ng_VisualInfo  := vi;  ng.ng_Flags       := NG_HIGHLABEL;   // String gadget:  ng.ng_TopEdge     := ng.ng_TopEdge + 20;  ng.ng_Height      := 14;  ng.ng_GadgetText  := '_First:';  ng.ng_GadgetID    := ord(tmgSTRING);   gad := CreateGadget(STRING_KIND, gad, @ng,  [    GTST_String   , AsTag(PChar('A string gadget')),    GTST_MaxChars , 50,    GA_Immediate  , AsTag(true),    GT_Underscore , Ord('_'),    TAG_END  ]);  my_gads[ord(tmgSTRING)] := gad;   // CheckBox gadget:  ng.ng_TopEdge     := ng.ng_TopEdge + 20;  ng.ng_GadgetText  := '_Second:';  ng.ng_GadgetID    := ord(tmgCHECKBOX);  gad := CreateGadget(CHECKBOX_KIND, gad, @ng,  [    GT_Underscore , Ord('_'),    TAG_END  ]);  my_gads[ord(tmgCHECKBOX)] := gad;   // RadioButtons gadget:  ng.ng_TopEdge     := ng.ng_TopEdge + 20;  ng.ng_GadgetText  := '_Third:';  ng.ng_GadgetID    := ord(tmgRADIOBTN);  gad := CreateGadget(MX_KIND, gad, @ng,  [    GTMX_Labels   , AsTag(@RadioStrings[0]),    GT_Underscore , Ord('_'),    TAG_END  ]);  my_gads[ord(tmgRADIOBTN)] := gad;   // Button gadget:  ng.ng_LeftEdge    := ng.ng_LeftEdge + 50;  ng.ng_TopEdge     := ng.ng_TopEdge + 30;  ng.ng_Width       := 100;  ng.ng_Height      := 12;  ng.ng_GadgetText  := '_Click Here';  ng.ng_GadgetID    := ord(tmgBUTTON);  ng.ng_Flags       := 0;  gad := CreateGadget(BUTTON_KIND, gad, @ng,  [    GT_Underscore , Ord('_'),    TAG_END  ]);  createAllGadgets := (gad);end;  {*** Standard message handling loop with GadTools message handling functions** used (GT_GetIMsg() and GT_ReplyIMsg()).*}procedure process_window_events(mywin: PWindow; my_gads: array of PGadget);var  imsg       : PIntuiMessage;  imsgClass  : ULONG;  imsgCode   : UWORD;  gad        : PGadget;  terminated : Boolean = false;begin  while not(terminated) do  begin    Wait(1 shl mywin^.UserPort^.mp_SigBit);     {*    ** GT_GetIMsg() returns an IntuiMessage with more friendly information for    ** complex gadget classes.  Use it wherever you get IntuiMessages where    ** using GadTools gadgets.    *}     imsg := GT_GetIMsg(mywin^.UserPort);    while not(terminated) and assigned(iMsg) do    begin      {*      ** Presuming a gadget, of course, but no harm...      ** Only dereference this value (gad) where the Class specifies      ** that it is a gadget event.      *}      gad := PGadget(imsg^.IAddress);       imsgClass := imsg^.IClass;      imsgCode := imsg^.Code;       //* Use the toolkit message-replying function here... */      GT_ReplyIMsg(imsg);       case (imsgClass) of        {*        **  --- WARNING --- WARNING --- WARNING --- WARNING --- WARNING ---        ** GadTools puts the gadget address into IAddress of IDCMP_MOUSEMOVE        ** messages.  This is NOT true for standard Intuition messages,        ** but is an added feature of GadTools.        *}        IDCMP_GADGETDOWN,        IDCMP_MOUSEMOVE,        IDCMP_GADGETUP:        begin          handleGadgetEvent(mywin, gad, imsgCode, my_gads);        end;        IDCMP_VANILLAKEY:        begin          handleVanillaKey(mywin, imsgCode, my_gads);        end;        IDCMP_CLOSEWINDOW:        begin          terminated := true;        end;        IDCMP_REFRESHWINDOW:        begin          {*          ** With GadTools, the application must use GT_BeginRefresh()          ** where it would normally have used BeginRefresh()          *}          GT_BeginRefresh(mywin);          GT_EndRefresh(mywin, ord(true));        end;      end;      imsg := GT_GetIMsg(mywin^.UserPort);    end;  end;end;  {*** Prepare for using GadTools, set up gadgets and open window.** Clean up and when done or on error.*}procedure gadtoolsWindow;var  font          : PTextFont;  mysc          : PScreen;  mywin         : PWindow;  glist         : PGadget = nil;  vi            : Pointer;  topborder     : UWORD;  my_gads       : array[TMyGadgets] of PGadget;begin   {*  ** Open topaz 8 font, so we can be sure it's openable  ** when we later set ng_TextAttr to &Topaz80:  *}  font := OpenFont(@Topaz80);  if not assigned(font) then errorMessage('Failed to open Topaz 80')  else  begin    mysc := LockPubScreen(nil);    if not assigned(mysc) then errorMessage('Couldn''t lock default public screen"')    else    begin      vi := GetVisualInfo(mysc, [TAG_END]);      if not assigned(vi) then errorMessage('GetVisualInfo() failed')      else      begin        //* Here is how we can figure out ahead of time how tall the  */        //* window's title bar will be:                               */        topborder := mysc^.WBorTop + (mysc^.Font^.ta_YSize + 1);         if (nil = createAllGadgets(glist, vi, topborder, my_gads))        then errorMessage('createAllGadgets() failed')        else        begin          mywin := OpenWindowTags(nil,          [            WA_Title        , AsTag(pchar('GadTools Gadget Demo')),            WA_Gadgets      , AsTag(glist),            WA_AutoAdjust   , AsTag(true),            WA_Width        , 400,            WA_MinWidth     ,  60,            WA_InnerHeight  , 140,            WA_MinHeight    ,  60,            WA_DragBar      , AsTag(true),            WA_DepthGadget  , AsTag(true),            WA_Activate     , AsTag(true),            WA_CloseGadget  , AsTag(true),            WA_SizeGadget   , AsTag(true),            WA_SimpleRefresh, AsTag(true),            WA_IDCMP        , IDCMP_CLOSEWINDOW or IDCMP_REFRESHWINDOW or IDCMP_VANILLAKEY or STRINGIDCMP or CHECKBOXIDCMP or MXIDCMP or BUTTONIDCMP,            WA_PubScreen    , AsTag(mysc),            TAG_END          ]);           if not assigned(mywin)          then errorMessage('OpenWindow() failed')          else          begin            {*            ** After window is open, gadgets must be refreshed with a            ** call to the GadTools refresh window function.            *}             GT_RefreshWindow(mywin, nil);              process_window_events(mywin, my_gads);              CloseWindow(mywin);          end;        end;        {*        ** FreeGadgets() even if createAllGadgets() fails, as some        ** of the gadgets may have been created...If glist is NULL        ** then FreeGadgets() will do nothing.        *}        FreeGadgets(glist);        FreeVisualInfo(vi);      end;      UnlockPubScreen(nil, mysc);    end;    CloseFont(font);  end;end;  {*** Check all libraries and run.  Clean up when finished or on error..*}begin  if (pLibrary(IntuitionBase)^.lib_version < 37)   then errorMessage('Requires V37 intuition.library')  else  begin    if (pLibrary(GfxBase)^.lib_version < 37)     then errorMessage('Requires V37 graphics.library')    else    begin      if (pLibrary(GadtoolsBase)^.lib_version < 37)       then errorMessage('Requires V37 gadtools.library')      else      begin        gadtoolsWindow;      end;    end;  end;end. 


[0] Message Index

Go to full version