freepascal.compiler/packages/amunits/examples/otherlibs/gttest.pas

program gttest;

{

    This is just a small test of gtlayout.library.
    It's from gtlayout.doc.

    No problems so far.
    16 Jul 2000.

    Added MessageBox for report.
    31 Jul 2000.

    Updated to use fpc 1.0.7
    07 Jan 2003.

    [email protected]

}

uses intuition, exec, gadtools, utility, gtlayout, amsgbox;

const
    ltrue : longint = 1;
    lfalse : longint = 0;

var
    handle : pLayoutHandle;
    win : pWindow;
    msg : pIntuiMessage;
    msgQuali : ulong;
    msgclass : ulong;
    msgcode : word;
    msggadget : pGadget;
    done : boolean;

procedure CleanUp(why : string; rc : integer);
begin
    LT_DeleteHandle(handle);
    if why <> '' then MessageBox('GTLayout Report',why,'OK');
    halt(rc);
end;

begin
  if not Assigned(GTLayoutBase) then
  begin
    writeln('cannot open ' + GTLAYOUTNAME);
    Halt(5);
  end;
    done := false;
    handle := LT_CreateHandleTags(nil,[
                    LAHN_AutoActivate, lfalse,
                    TAG_DONE]);

    if handle = nil then CleanUp('Could''t create a handle',20);

    LT_New(handle,[LA_Type,VERTICAL_KIND,       { A vertical group. }
                   LA_LabelText, AsTag('Main Group'),
                   TAG_DONE]);

    LT_New(handle,[LA_Type,BUTTON_KIND,         { A plain button. }
                   LA_LabelText, AsTag('A button'),
                   LA_ID,11,
                   TAG_DONE]);

    LT_New(handle,[LA_Type,XBAR_KIND,TAG_DONE]); { A separator bar. }

    LT_New(handle,[LA_Type,BUTTON_KIND,          { A plain button. }
                   LA_LabelText, AsTag('Another button'),
                   LA_ID,22,
                   TAG_DONE]);

    LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,AsTag('test'),LA_ID,33,LA_BOOL,1,TAG_DONE]);

    LT_New(handle,[La_Type,END_KIND,TAG_DONE]);  { This ends the current group. }

    win := LT_Build(handle,[LAWN_Title, AsTag('Window title'),
                            LAWN_IDCMP, IDCMP_CLOSEWINDOW,
                            WA_CloseGadget, ltrue,
                            TAG_DONE]);

    if win = nil then CleanUp('Can''t open the window',20);

    repeat
        msg := pIntuiMessage(WaitPort(win^.UserPort));
        msg := GT_GetIMsg(win^.UserPort);
        while msg <> nil do begin
            msgclass := msg^.IClass;
            msgcode := msg^.Code;
            msgQuali := msg^.Qualifier;
            msggadget := msg^.IAddress;
            GT_ReplyIMsg(msg);
            LT_HandleInput(handle,msgQuali,@msgclass,@msgcode,@msggadget);
            case msgclass of
                 IDCMP_CLOSEWINDOW : begin
                                     writeln(LT_GetAttributesA(handle,33,nil));
                                     done := true;
                                     end;
                 IDCMP_GADGETUP: begin
                                 case msggadget^.GadgetId of
                                      11 : writeln('First gadget');
                                      22 : writeln('Second gadget');
                                 end;
                                 end;
            end;
            msg := GT_GetIMsg(win^.UserPort);
         end;
     until done;
     CleanUp('all ok',0);
end.