home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS2.0 / GadgetDemo.p < prev    next >
Encoding:
Text File  |  1994-08-25  |  5.0 KB  |  144 lines
  1. { Gadget-Demo.p    ©1994 by Björn "BOMBER" Schotte }
  2. { written for MaxonPASCAL 3 (© by MAXON)           }
  3. {                                                  }
  4. { C U in the next P.U.R.I.T.Y. !                   }
  5. {                                                  }
  6. { Dieses Programm demonstriert das Kreieren von    }
  7. { Gadgets unter der GadTools-Library.              }
  8. { Es gibt noch viele andere Typen, dies sollte     }
  9. { aber genügen.                                    }
  10. {                                      BS/26/07/94 }
  11.  
  12. PROGRAM GadgetDemo;
  13.  
  14. USES Intuition, Graphics, Exec;
  15.  
  16. {$incl "gadtools.lib"}
  17.  
  18. VAR
  19.   wp            : p_Window;
  20.   t            : ARRAY[1..11] OF TagItem;
  21.   gad            : ARRAY[1..4] OF p_Gadget;
  22.   gl        : p_Gadget;
  23.   lib            : p_Library;
  24.   ps             : p_Screen;
  25.   vi            : PTR;
  26.   ng            : NewGadget;
  27.   tattr        : TextAttr;
  28.   xoff,yoff,
  29.   i         : INTEGER;
  30.   CLabels   : ARRAY[0..9] OF STR;
  31.   MXLabels  : ARRAY[1..3] OF STR;
  32.   dstring   : STRING;
  33.   msg       : p_IntuiMessage;
  34.   class     : LONG;
  35.   act            : INTEGER;
  36.  
  37.  
  38. { Sauberes Verlassen des Programms aus jeder Situation heraus. }
  39. PROCEDURE CleanUp(txt:STRING; rc:BYTE);
  40. BEGIN
  41.   IF wp <> NIL THEN CloseWindow(wp); { Fenster schliessen }
  42.   IF gl <> NIL THEN FreeGadgets(gl); { GadgetListe freigeben }
  43.   IF vi <> NIL THEN FreeVisualInfo(vi); { VisualInfo freigeben }
  44.   IF txt <> "" THEN Writeln(txt);    { Text ausgeben }
  45.   HALT(rc);
  46. END;
  47.  
  48. BEGIN
  49.   { Cycle- bzw. MX-Labels immer mit NIL abschliessen !!
  50.     Labels müssen vom Typ STR sein !!                   }
  51.   CLabels[0] := "Zustand 1";
  52.   CLabels[1] := "Zustand 2";
  53.   CLabels[2] := "Zustand 3";
  54.   CLabels[3] := "Zustand 4";
  55.   CLabels[4] := "Zustand 5";
  56.   CLabels[5] := "Zustand 6";
  57.   CLabels[6] := "Zustand 7";
  58.   CLabels[7] := "Zustand 8";
  59.   CLabels[8] := "Zustand 9";
  60.   CLabels[9] := NIL;
  61.   MXLabels[1] := "6 LPI";
  62.   MXLabels[2] := "8 LPI";
  63.   MXLabels[3] := NIL;
  64.   act := 0;
  65.   gl := NIL;
  66.   wp := NIL;
  67.   vi := NIL;
  68.   tattr := TextAttr("topaz.font",8,0,0);
  69.   lib := IntuitionBase;
  70.   IF lib^.lib_Version < 36 THEN Error("Ich brauche mind. Kick 2.00 !!");
  71.   OpenLib(GadToolsBase, "gadtools.library", 36);
  72.   ps := LockPubScreen(NIL);
  73.   IF ps = NIL THEN CleanUp("Kann den PublicScreen nicht locken !!",20);
  74.   xoff := ps^.WBorLeft;
  75.   yoff := ps^.BarHeight;
  76.   vi := GetVisualInfoA(ps, NIL);
  77.   UnLockPubScreen(NIL, ps);
  78.   IF vi = NIL THEN CleanUp("Konnte keine VisualInfo bekommen !!",20);
  79.  
  80.   { Gadgets kreieren: }
  81.   gl := NIL;
  82.   gl := CreateContext(^gl);
  83.   IF gl = NIL THEN CleanUp("Kein Speicher mehr frei für CreateContext !!",20);
  84.   { Button-Gadget kreieren: }
  85.   ng := NewGadget(xoff+1,yoff+2,            { LeftEdge, TopEdge }
  86.                   200,13,                   { Width, Height }
  87.                   "_Button-Gadget!",^tattr, { GadgetText, TextAttr }
  88.                   1,PLACETEXT_IN,           { GadgetNumber, Flags }
  89.                   vi,NIL);                  { VisualInfo, UserData }
  90.   t[1] := TagItem(GT_Underscore, LONG("_"));
  91.   t[2].ti_Tag := TAG_DONE;
  92.   gad[1] := CreateGadgetA(BUTTON_KIND,gl,^ng,^t);
  93.   IF gad[1] = NIL THEN CleanUp("Kein Speicher für CreateGadgetA frei !!",20);
  94.   { Checkbox-Gadget kreieren: }
  95.   ng := NewGadget(xoff+1,yoff+18,
  96.                   26,11,
  97.                   "Dieses Proggy ist gut",^tattr,
  98.                   2,PLACETEXT_RIGHT,
  99.                   vi,NIL);
  100.   t[1] := TagItem(GTCB_Checked,1);
  101.   t[2].ti_Tag := TAG_DONE;
  102.   gad[2] := CreateGadgetA(CHECKBOX_KIND,gad[1],^ng,^t);
  103.   IF gad[2] = NIL THEN CleanUp("Kein Speicher frei !!",20);
  104.   { Cycle-Gadget kreieren: }
  105.   ng := NewGadget(xoff+1,yoff+33,
  106.                   200,13,
  107.                   NIL,^tattr,
  108.                   3,0,
  109.                   vi,NIL);
  110.   t[1] := TagItem(GTCY_Labels,LONG(^CLabels)); { Cycle-Texte }
  111.   gad[3] := CreateGadgetA(CYCLE_KIND,gad[2],^ng,^t);
  112.   IF gad[3] = NIL THEN CleanUp("Kein Speicher frei !!",20);
  113.   { MX-Gadget kreieren: }
  114.   ng := NewGadget(xoff+203,yoff+33,
  115.                   MX_WIDTH,MX_HEIGHT,
  116.                   NIL,^tattr,
  117.                   4,PLACETEXT_RIGHT,
  118.                   vi,NIL);
  119.   t[1] := TagItem(GTMX_Labels, LONG(^MXLabels)); { MX-Labels }
  120.   gad[4] := CreateGadgetA(MX_KIND,gad[3],^ng,^t);
  121.   IF gad[4] = NIL THEN CleanUp("Kein Speicher frei !!",20);
  122.   { Window-Tags: }
  123.   t[1] := TagItem(WA_InnerWidth, 400); { Breite ohne Fensterrahmen }
  124.   t[2] := TagItem(WA_InnerHeight, 150); { Höhe ohne Fensterrahmen }
  125.   t[3] := TagItem(WA_Flags, WFLG_ACTIVATE+WFLG_NOCAREREFRESH+
  126.                   WFLG_SMART_REFRESH+WFLG_CLOSEGADGET+WFLG_DRAGBAR+
  127.                   WFLG_DEPTHGADGET);
  128.   t[4] := TagItem(WA_Idcmp, IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_GADGETDOWN);
  129.   t[5].ti_Tag := WA_Title;
  130.   t[5].ti_Data := "Gadget-Demo by Björn Schotte";
  131.   t[6] := TagItem(WA_Gadgets, LONG(gl)); { Zeiger auf GadList }
  132.   t[7].ti_Tag := TAG_DONE;
  133.   wp := OpenWindowTagList(NIL, ^t); { Fenster öffnen }
  134.   IF wp = NIL THEN CleanUp("Kann kein Fenster öffnen !!",20);
  135.   { Warten ... Warten ... }
  136.   REPEAT
  137.     msg := p_IntuiMessage(WaitPort(wp^.UserPort));
  138.     msg := GT_GetIMsg(wp^.UserPort);
  139.     class := msg^.Class;
  140.     GT_ReplyIMsg(msg);
  141.   UNTIL class = IDCMP_CLOSEWINDOW;
  142.   CleanUp("",0);
  143. END.
  144.