home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS2.0 / TSGad.p < prev    next >
Encoding:
Text File  |  1994-08-25  |  4.7 KB  |  163 lines
  1. { Programm:  ToggleSelect-Gadget
  2.   ~~~~~~~~~
  3.   Sprache:   MaxonPASCAL 3 / KickPASCAL 2.12 & OS 2.0-Includes
  4.   ~~~~~~~~   
  5.  
  6.   Sinn:      Toggleselect-Gadget über Gadtools: Generic_Kind
  7.   ~~~~
  8.   ©:         FREEWARE, für Rout. wenn Autor in nicht komerziellem
  9.   ~~         Programm gegrüßt wird und selbiges kostenlos zugesand
  10.              bekommt.
  11.  
  12.   Autor:     PackMAN
  13.   ~~~~~~     c/o Falk Zühlsdorff
  14.              Lindenberg 66
  15.              D-98693 Ilmenau / Thüringen
  16.  
  17.   Kommentar: Version für MAXON
  18.   ~~~~~~~~~~ ab OS 2.0                                 }
  19.  
  20. Program TSG;
  21.  
  22. USES INTUITION,GRAPHICS,GADTOOLS;
  23.  
  24. VAR  Win               : p_Window;
  25.      NWTags            : array[1..14] of TagItem; STATIC;
  26.      RP                : p_RastPort;
  27.      PScr              : p_Screen;
  28.      drawinfo          : p_drawinfo;
  29.      txattr            : TextAttr; STATIC;
  30.      font              : p_textfont;
  31.      myfont,gfx        : long; STATIC;
  32.      vi                : PTR;
  33.      title             : string;STATIC;
  34.      msg               : p_IntuiMessage;
  35.      ng                : NewGadget;STATIC;
  36.      G,PGad,Glist,Akt  : p_Gadget;
  37.      Tag               : TagItem;STATIC;
  38.      ex                : boolean;STATIC;
  39.  
  40. {------------------------------------------------------------------------}
  41.  
  42. PROCEDURE GRand(ziel:p_window;x,y,b,h:cardinal);
  43.  
  44. TYPE  type1=array[0..5] of cardinal;
  45.       type2=array[0..5] of cardinal;
  46.       type3=array[0..3] of cardinal;
  47.  
  48. VAR   F1:type1;STATIC;
  49.       F2:type2;STATIC;
  50.       F3:type3;STATIC;
  51.       Bor1,Bor2,Bor3:BORDER;STATIC;
  52.  
  53. BEGIN
  54.  F1:=type1(b-1,0,0,0,0,h);            {Gadgetumrandungen}
  55.  F2:=type2(b,0,b,h,1,h);
  56.  F3:=type3(b-1,1,b-1,h-1);
  57.  Bor1:=BORDER(0,0,2,0,0,3,^F1,^Bor2);
  58.  Bor2:=BORDER(0,0,1,0,0,3,^F2,^Bor3);
  59.  Bor3:=BORDER(0,0,1,0,0,2,^F3,NIL);
  60.  DRAWBORDER(ziel^.RPort,^Bor1,x,y);
  61. END;
  62. {-----------------------------------------------------------------------}
  63. PROCEDURE Pick;
  64. BEGIN
  65.  IF (g^.flags and GFLG_SELECTED)<>0
  66.   THEN SetAPen(RP,3)
  67.   ELSE SetAPen(RP,0);
  68.  move(RP,60,40);
  69.  gfx:=_Text(RP,'X',1);
  70. END;
  71.  
  72. BEGIN
  73.  PScr:=NIL;
  74.  PScr:=lockpubscreen(NIL);
  75.  IF PScr<>NIL
  76.   THEN
  77.    BEGIN
  78.     drawinfo:=getscreendrawinfo(PScr);
  79.     IF drawinfo<>NIL
  80.      THEN
  81.       BEGIN
  82.        font:=drawinfo^.dri_font;
  83.        vi:=GetVisualInfoA(PScr,nil);
  84.        Freescreendrawinfo(PScr,drawinfo);
  85.        UnlockPubScreen(NIL,PScr);
  86.        PGad:=NIL;
  87.        GList:=NIL;
  88.        PGad:=CreateContext(^GList);
  89.        IF PGad<>NIL
  90.         THEN
  91.          BEGIN
  92.           txattr:=TextAttr('topaz.font',8,0,0);         {simple for test}
  93.           Font:=OpenFont(^txattr);
  94.  
  95.           Tag.ti_tag:=Tag_End;
  96.  
  97.           ng:=NewGadget(50,30,28,14,NIL,^Txattr,0,0,vi,NIL);
  98.           g:=CreateGadgetA(GENERIC_KIND,pgad,^ng,^Tag);
  99.           g^.GadgetType   :=GTYP_BOOLGADGET;
  100.           g^.Activation   :=GACT_TOGGLESELECT+GACT_IMMEDIATE;
  101.           g^.Flags        :=GFLG_GADGHNONE+GFLG_SELECTED;
  102.  
  103.           title:='ToggleSelect-Gad V0.2 © by PackMAN 03.07.94';
  104.           NWTags[1] :=TagItem(wa_left,0);
  105.           NWTags[2] :=TagItem(wa_top,0);
  106.           NWTags[3] :=TagItem(wa_width,400);
  107.           NWTags[4] :=TagItem(wa_height,100);
  108.           NWTags[5] :=TagItem(wa_activate,ord(true));
  109.           NWTags[6] :=TagItem(wa_smartrefresh,ord(true));
  110.           NWTags[7] :=TagItem(wa_rmbtrap,ord(true));
  111.           NWTags[8] :=TagItem(wa_title,long(^title));
  112.           NWTags[9] :=TagItem(wa_flags,WFLG_CLOSEGADGET);
  113.           NWTags[10]:=TagItem(wa_idcmp,IDCMP_RAWKEY+
  114.                                        IDCMP_CLOSEWINDOW+
  115.                                        IDCMP_GADGETDOWN);
  116.           NWTags[11]:=TagItem(wa_gadgets,long(GList));
  117.           NWTags[12].ti_tag:=tag_done;
  118.  
  119.           Win:=openwindowtaglist(nil,^NWTags[1]);
  120.           IF Win<>NIL
  121.            THEN
  122.             BEGIN
  123.              RP:=Win^.RPort;
  124.              myfont:=setfont(RP,font);
  125.              GRand(Win,50,30,28,14);
  126.              Pick;
  127.              move(RP,100,40);
  128.              gfx:=_Text(RP,'Pick up !',9);
  129.              SetAPen(RP,2);
  130.              move(RP,40,70);
  131.              gfx:=_Text(RP,'Arbeitet über Gadtools: GENERIC_KIND.',37);
  132.              ex:=false;
  133.              REPEAT
  134.               Msg:=Wait_Port(Win^.UserPort);
  135.               Msg:=GT_GetIMsg(Win^.Userport);
  136.               GT_ReplyIMsg(Msg);
  137.               CASE Msg^.class OF
  138.                IDCMP_CLOSEWINDOW : ex:=true;
  139.                IDCMP_GADGETDOWN:
  140.                 BEGIN
  141.                  Akt:=Msg^.IAddress;
  142.                  IF Akt^.GadgetID=0 THEN Pick;
  143.                 END;
  144.               ELSE;END;
  145.              UNTIL ex;
  146.              CloseWindow(Win);
  147.             END;
  148.           FreeGadgets(Glist);
  149.           FreeVisualInfo(vi);
  150.           CloseLib(Gadtoolsbase);
  151.           CloseLib(Intuitionbase);
  152.           CloseLib(GfxBase);
  153.          END;
  154.       END;
  155.    END;
  156. END.
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.