{ Programm:  ToggleSelect-Gadget
  ~~~~~~~~~
  Sprache:   MaxonPASCAL 3 / KickPASCAL 2.12 & OS 2.0-Includes
  ~~~~~~~~   

  Sinn:      Toggleselect-Gadget über Gadtools: Generic_Kind
  ~~~~
  ©:         FREEWARE, für Rout. wenn Autor in nicht komerziellem
  ~~         Programm gegrüßt wird und selbiges kostenlos zugesand
             bekommt.

  Autor:     PackMAN
  ~~~~~~     c/o Falk Zühlsdorff
             Lindenberg 66
             D-98693 Ilmenau / Thüringen

  Kommentar: Version für MAXON
  ~~~~~~~~~~ ab OS 2.0                                 }

Program TSG;

USES INTUITION,GRAPHICS,GADTOOLS;

VAR  Win               : p_Window;
     NWTags            : array[1..14] of TagItem; STATIC;
     RP                : p_RastPort;
     PScr              : p_Screen;
     drawinfo          : p_drawinfo;
     txattr            : TextAttr; STATIC;
     font              : p_textfont;
     myfont,gfx        : long; STATIC;
     vi                : PTR;
     title             : string;STATIC;
     msg               : p_IntuiMessage;
     ng                : NewGadget;STATIC;
     G,PGad,Glist,Akt  : p_Gadget;
     Tag               : TagItem;STATIC;
     ex                : boolean;STATIC;

{------------------------------------------------------------------------}

PROCEDURE GRand(ziel:p_window;x,y,b,h:cardinal);

TYPE  type1=array[0..5] of cardinal;
      type2=array[0..5] of cardinal;
      type3=array[0..3] of cardinal;

VAR   F1:type1;STATIC;
      F2:type2;STATIC;
      F3:type3;STATIC;
      Bor1,Bor2,Bor3:BORDER;STATIC;

BEGIN
 F1:=type1(b-1,0,0,0,0,h);            {Gadgetumrandungen}
 F2:=type2(b,0,b,h,1,h);
 F3:=type3(b-1,1,b-1,h-1);
 Bor1:=BORDER(0,0,2,0,0,3,^F1,^Bor2);
 Bor2:=BORDER(0,0,1,0,0,3,^F2,^Bor3);
 Bor3:=BORDER(0,0,1,0,0,2,^F3,NIL);
 DRAWBORDER(ziel^.RPort,^Bor1,x,y);
END;
{-----------------------------------------------------------------------}
PROCEDURE Pick;
BEGIN
 IF (g^.flags and GFLG_SELECTED)<>0
  THEN SetAPen(RP,3)
  ELSE SetAPen(RP,0);
 move(RP,60,40);
 gfx:=_Text(RP,'X',1);
END;

BEGIN
 PScr:=NIL;
 PScr:=lockpubscreen(NIL);
 IF PScr<>NIL
  THEN
   BEGIN
    drawinfo:=getscreendrawinfo(PScr);
    IF drawinfo<>NIL
     THEN
      BEGIN
       font:=drawinfo^.dri_font;
       vi:=GetVisualInfoA(PScr,nil);
       Freescreendrawinfo(PScr,drawinfo);
       UnlockPubScreen(NIL,PScr);
       PGad:=NIL;
       GList:=NIL;
       PGad:=CreateContext(^GList);
       IF PGad<>NIL
        THEN
         BEGIN
          txattr:=TextAttr('topaz.font',8,0,0);         {simple for test}
          Font:=OpenFont(^txattr);

          Tag.ti_tag:=Tag_End;

          ng:=NewGadget(50,30,28,14,NIL,^Txattr,0,0,vi,NIL);
          g:=CreateGadgetA(GENERIC_KIND,pgad,^ng,^Tag);
          g^.GadgetType   :=GTYP_BOOLGADGET;
          g^.Activation   :=GACT_TOGGLESELECT+GACT_IMMEDIATE;
          g^.Flags        :=GFLG_GADGHNONE+GFLG_SELECTED;

          title:='ToggleSelect-Gad V0.2 © by PackMAN 03.07.94';
          NWTags[1] :=TagItem(wa_left,0);
          NWTags[2] :=TagItem(wa_top,0);
          NWTags[3] :=TagItem(wa_width,400);
          NWTags[4] :=TagItem(wa_height,100);
          NWTags[5] :=TagItem(wa_activate,ord(true));
          NWTags[6] :=TagItem(wa_smartrefresh,ord(true));
          NWTags[7] :=TagItem(wa_rmbtrap,ord(true));
          NWTags[8] :=TagItem(wa_title,long(^title));
          NWTags[9] :=TagItem(wa_flags,WFLG_CLOSEGADGET);
          NWTags[10]:=TagItem(wa_idcmp,IDCMP_RAWKEY+
                                       IDCMP_CLOSEWINDOW+
                                       IDCMP_GADGETDOWN);
          NWTags[11]:=TagItem(wa_gadgets,long(GList));
          NWTags[12].ti_tag:=tag_done;

          Win:=openwindowtaglist(nil,^NWTags[1]);
          IF Win<>NIL
           THEN
            BEGIN
             RP:=Win^.RPort;
             myfont:=setfont(RP,font);
             GRand(Win,50,30,28,14);
             Pick;
             move(RP,100,40);
             gfx:=_Text(RP,'Pick up !',9);
             SetAPen(RP,2);
             move(RP,40,70);
             gfx:=_Text(RP,'Arbeitet über Gadtools: GENERIC_KIND.',37);
             ex:=false;
             REPEAT
              Msg:=Wait_Port(Win^.UserPort);
              Msg:=GT_GetIMsg(Win^.Userport);
              GT_ReplyIMsg(Msg);
              CASE Msg^.class OF
               IDCMP_CLOSEWINDOW : ex:=true;
               IDCMP_GADGETDOWN:
                BEGIN
                 Akt:=Msg^.IAddress;
                 IF Akt^.GadgetID=0 THEN Pick;
                END;
              ELSE;END;
             UNTIL ex;
             CloseWindow(Win);
            END;
          FreeGadgets(Glist);
          FreeVisualInfo(vi);
          CloseLib(Gadtoolsbase);
          CloseLib(Intuitionbase);
          CloseLib(GfxBase);
         END;
      END;
   END;
END.