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

Forum > Jobs

(1/1)

Trenatos:
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.

Trenatos:
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.

Navigation

[0] Message Index