home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / demos / imagegadget.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-22  |  9.7 KB  |  402 lines
  1. PROGRAM ImageGadget;
  2.  
  3. {
  4.    An example on how to use GadTools gadgets,
  5.    on the same time how to use images.
  6.  
  7.    20 Sep 1998.
  8.    nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11. USES Intuition, Exec, Graphics, GadTools, Utility;
  12.  
  13. {$I tagutils.inc}
  14.  
  15. CONST
  16.   MSG_CANT_OPEN_GTLIB  : PChar = 'Can''t open gadtools.library V37 or higher.';
  17.   MSG_NO_PS            : PChar = 'Can''t lock Public Screen';
  18.   MSG_NO_VI            : PChar = 'Can''t get Visual Info';
  19.   MSG_NO_MEM           : PChar = 'Not enough memory free';
  20.   MSG_NO_WP            : PChar = 'Can''t open window';
  21.  
  22.   WIN_TITLE            : PChar = 'Images-Example';
  23.   OK_TEXT              : PChar = 'OK';
  24.  
  25.   type
  26.       data = array[1..176] of word;
  27.       pdata = ^data;
  28.  
  29.   const
  30.     renderd : data = (
  31.     {* Plane 0 *}
  32.         $0000,$0000,
  33.         $0000,$0010,
  34.         $0000,$0010,
  35.         $0000,$0010,
  36.         $01C0,$0010,
  37.         $03E0,$0010,
  38.         $07F0,$0010,
  39.         $0000,$0010,
  40.         $0000,$0810,
  41.         $039A,$C810,
  42.         $0000,$0810,
  43.         $031E,$0810,
  44.         $0000,$4810,
  45.         $03E6,$0810,
  46.         $0000,$0810,
  47.         $0000,$0810,
  48.         $07FF,$F810,
  49.         $0000,$0010,
  50.         $0000,$0010,
  51.         $0000,$0010,
  52.         $0000,$0010,
  53.         $7FFF,$FFF0,
  54.     {* Plane 1 *}
  55.         $FFFF,$FFE0,
  56.         $8000,$0000,
  57.         $8000,$0000,
  58.         $8000,$0000,
  59.         $81C0,$0000,
  60.         $83E0,$0000,
  61.         $87F0,$0000,
  62.         $8000,$0000,
  63.         $87FF,$E000,
  64.         $8465,$2000,
  65.         $87FF,$E000,
  66.         $84E1,$E000,
  67.         $87FF,$A000,
  68.         $8419,$E000,
  69.         $87FF,$E000,
  70.         $8400,$0000,
  71.         $8000,$0000,
  72.         $8000,$0000,
  73.         $8000,$0000,
  74.         $8000,$0000,
  75.         $8000,$0000,
  76.         $0000,$0000,
  77.     {* Plane 2 *}
  78.         $0000,$0000,
  79.         $0000,$0020,
  80.         $0000,$0020,
  81.         $0000,$0020,
  82.         $0000,$0020,
  83.         $01C0,$0020,
  84.         $03E0,$0020,
  85.         $0FFF,$F820,
  86.         $0800,$1020,
  87.         $0800,$1020,
  88.         $0800,$1020,
  89.         $0800,$1020,
  90.         $0800,$1020,
  91.         $0800,$1020,
  92.         $0800,$1020,
  93.         $0BFF,$F020,
  94.         $0800,$0020,
  95.         $0000,$0020,
  96.         $0000,$0020,
  97.         $0000,$0020,
  98.         $7FFF,$FFE0,
  99.         $0000,$0000,
  100.  
  101.         $0000,$0000,
  102.         $0000,$0000,
  103.         $0000,$0000,
  104.         $0000,$0000,
  105.         $0000,$0000,
  106.         $0000,$0000,
  107.         $0000,$0000,
  108.         $0000,$0000,
  109.         $0000,$0000,
  110.         $0000,$0000,
  111.         $0000,$0000,
  112.         $0000,$0000,
  113.         $0000,$0000,
  114.         $0000,$0000,
  115.         $0000,$0000,
  116.         $0000,$0000,
  117.         $0000,$0000,
  118.         $0000,$0000,
  119.         $0000,$0000,
  120.         $0000,$0000,
  121.         $0000,$0000,
  122.         $0000,$0000
  123.     );
  124.  
  125.      selectd : data = (
  126.         { Plane 0 }
  127.                 $FFFF,$FFE0,
  128.                 $8000,$0000,
  129.                 $8000,$0000,
  130.                 $8000,$0000,
  131.                 $8000,$0000,
  132.                 $80E0,$0000,
  133.                 $81F0,$0000,
  134.                 $83F8,$0000,
  135.                 $8000,$0000,
  136.                 $8000,$0400,
  137.                 $81CD,$6400,
  138.                 $8000,$0400,
  139.                 $818F,$0400,
  140.                 $8000,$2400,
  141.                 $81F3,$0400,
  142.                 $8000,$0400,
  143.                 $8000,$0400,
  144.                 $83FF,$FC00,
  145.                 $8000,$0000,
  146.                 $8000,$0000,
  147.                 $8000,$0000,
  148.                 $0000,$0000,
  149.         { Plane 1 }
  150.                 $0000,$0000,
  151.                 $0000,$0010,
  152.                 $0000,$0010,
  153.                 $0000,$0010,
  154.                 $0000,$0010,
  155.                 $00E0,$0010,
  156.                 $01F0,$0010,
  157.                 $03F8,$0010,
  158.                 $0000,$0010,
  159.                 $03FF,$F010,
  160.                 $0232,$9010,
  161.                 $03FF,$F010,
  162.                 $0270,$F010,
  163.                 $03FF,$D010,
  164.                 $020C,$F010,
  165.                 $03FF,$F010,
  166.                 $0200,$0010,
  167.                 $0000,$0010,
  168.                 $0000,$0010,
  169.                 $0000,$0010,
  170.                 $0000,$0010,
  171.                 $7FFF,$FFF0,
  172.         { Plane 2 }
  173.                 $0000,$0000,
  174.                 $0000,$0020,
  175.                 $0000,$0020,
  176.                 $0000,$0020,
  177.                 $0000,$0020,
  178.                 $0000,$0020,
  179.                 $00E0,$0020,
  180.                 $01F0,$0020,
  181.                 $07FF,$FC20,
  182.                 $0400,$0820,
  183.                 $0400,$0820,
  184.                 $0400,$0820,
  185.                 $0400,$0820,
  186.                 $0400,$0820,
  187.                 $0400,$0820,
  188.                 $0400,$0820,
  189.                 $05FF,$F820,
  190.                 $0400,$0020,
  191.                 $0000,$0020,
  192.                 $0000,$0020,
  193.                 $7FFF,$FFE0,
  194.                 $0000,$0000,
  195.  
  196.         $0000,$0000,
  197.         $0000,$0000,
  198.         $0000,$0000,
  199.         $0000,$0000,
  200.         $0000,$0000,
  201.         $0000,$0000,
  202.         $0000,$0000,
  203.         $0000,$0000,
  204.         $0000,$0000,
  205.         $0000,$0000,
  206.         $0000,$0000,
  207.         $0000,$0000,
  208.         $0000,$0000,
  209.         $0000,$0000,
  210.         $0000,$0000,
  211.         $0000,$0000,
  212.         $0000,$0000,
  213.         $0000,$0000,
  214.         $0000,$0000,
  215.         $0000,$0000,
  216.         $0000,$0000,
  217.         $0000,$0000
  218.                      );
  219.  
  220.  
  221. VAR
  222.   ps                : pScreen;
  223.   vi                : Pointer;
  224.   ng                : tNewGadget;
  225.   xoff, yoff,i      : Longint;
  226.   gl,g              : pGadget;
  227.   firstimage        : pdata;
  228.   secondimage       : pdata;
  229.   renderi,
  230.   selecti           : tImage;
  231.   wp                : pWindow;
  232.   t                 : ARRAY[0..6] OF tTagItem;
  233.  
  234.  
  235. function NewGadget(left,top,width,height : Integer; txt : PChar; txtattr: pTextAttr;
  236.                    id : word; flags: Longint; visinfo, userdata : Pointer): tNewGadget;
  237. var
  238.     ng : tNewGadget;
  239. begin
  240.     with ng do begin
  241.         ng_LeftEdge   := left;
  242.         ng_TopEdge    := top;
  243.         ng_Width      := width;
  244.         ng_Height     := height;
  245.         ng_GadgetText := txt;
  246.         ng_TextAttr   := txtattr;
  247.         ng_GadgetID   := id;
  248.         ng_Flags      := flags;
  249.         ng_VisualInfo := visinfo;
  250.         ng_UserData   := userdata;
  251.     END;
  252.     NewGadget := ng;
  253. end;
  254.  
  255. function Image(left,top,width,height,depth: Integer; imdata : pointer;
  256.                ppick, ponoff: byte; nextim : pImage): tImage;
  257. var
  258.     im : tImage;
  259. begin
  260.  
  261.         im.LeftEdge    := left;
  262.         im.TopEdge     := top;
  263.         im.Width       := width;
  264.         im.Height      := height;
  265.         im.Depth       := depth;
  266.         im.ImageData   := imdata;
  267.  
  268.         im.PlanePick   := ppick;
  269.         im.PlaneOnOff  := ponoff;
  270.  
  271.         im.NextImage   := nextim;
  272.  
  273.     Image := im;
  274. end;
  275.  
  276.  
  277.  
  278. FUNCTION EasyReq(wp : pWindow; title,body,gad : PChar) : Longint;
  279. VAR
  280.   es : tEasyStruct;
  281. BEGIN
  282.   es.es_StructSize:=SizeOf(tEasyStruct);
  283.   es.es_Flags:=0;
  284.   es.es_Title:=title;
  285.   es.es_TextFormat:=body;
  286.   es.es_GadgetFormat:=gad;
  287.  
  288.   EasyReq := EasyRequestArgs(wp,@es,0,NIL);
  289. END;
  290.  
  291. PROCEDURE CleanUp(why : PChar; rc : BYTE);
  292. BEGIN
  293.   IF wp <> NIL THEN CloseWindow(wp);
  294.   IF gl <> NIL THEN FreeGadgets(gl);
  295.   IF vi <> NIL THEN FreeVisualInfo(vi);
  296.   IF firstimage <> NIL THEN FreeVec(firstimage);
  297.   IF secondimage <> NIL THEN FreeVec(secondimage);
  298.    IF why <> nil THEN i := EasyReq(NIL,WIN_TITLE,why,OK_TEXT);
  299.   IF GadToolsBase <> NIL THEN CloseLibrary(GadToolsBase);
  300.   HALT(rc);
  301. END;
  302.  
  303. { Clones some datas from default pubscreen for fontsensitive
  304.   placing of gadgets. }
  305. PROCEDURE CloneDatas;
  306. BEGIN
  307.   ps := LockPubScreen(NIL);
  308.   IF ps = NIL THEN CleanUp(MSG_NO_PS,20)
  309.   ELSE
  310.   BEGIN
  311.      xoff := ps^.WBorLeft;
  312.      yoff := ps^.WBorTop + ps^.Font^.ta_YSize + 1;
  313.      vi := GetVisualInfoA(ps,NIL);
  314.      UnLockPubScreen(NIL, ps);
  315.      IF vi = NIL THEN CleanUp(MSG_NO_VI, 20);
  316.   END;
  317. END;
  318.  
  319. procedure AllocateImages;
  320. begin
  321.   firstimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
  322.   if firstimage = nil then CleanUp(MSG_NO_MEM,20);
  323.  
  324.   firstimage^ := renderd;
  325.  
  326.   renderi := Image(0,0,28,22,3,firstimage,$ff,$0,nil);
  327.  
  328.   secondimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
  329.   if secondimage = nil then CleanUp(MSG_NO_MEM,20);
  330.  
  331.   secondimage^ := selectd;
  332.  
  333.   selecti := Image(0,0,28,22,3,secondimage,$ff,$0,nil);
  334.  
  335. END;
  336.  
  337. PROCEDURE GenerateWindow;
  338. BEGIN
  339.   gl := NIL; gl := CreateContext(addr(gl));
  340.   IF gl = NIL THEN CleanUp(MSG_NO_MEM, 20);
  341.   ng := NewGadget(xoff+1,yoff+1,28,22,nil,nil,1,0,vi,nil);
  342.  
  343.   g := CreateGadgetA(GENERIC_KIND,gl,@ng,NIL);
  344.   IF g = NIL THEN CleanUp(MSG_NO_MEM, 20);
  345.  
  346.   g^.GadgetType := GTYP_BOOLGADGET;
  347.   g^.Flags := GFLG_GADGIMAGE OR GFLG_GADGHIMAGE; { 2 Images }
  348.   g^.Activation := GACT_RELVERIFY; { Verhalten wie ein BUTTON_KIND-Gadget }
  349.   g^.GadgetRender := @renderi;
  350.   g^.SelectRender := @selecti;
  351.  
  352.   t[0] := TagItem(WA_Gadgets, LONG(gl));
  353.   t[1].ti_Tag := WA_Title;
  354.   t[1].ti_Data := long(PChar('Images in Gadgets'#0));
  355.   t[2] := TagItem(WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
  356.                   WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
  357.                         WFLG_ACTIVATE);
  358.   t[3] := TagItem(WA_Idcmp, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW);
  359.   t[4] := TagItem(WA_InnerWidth, 100);
  360.   t[5] := TagItem(WA_InnerHeight, 50);
  361.   t[6].ti_Tag := TAG_DONE;
  362.   wp := OpenWindowTagList(NIL,@t);
  363.   IF wp = NIL THEN CleanUp(MSG_NO_WP, 20);
  364. END;
  365.  
  366. PROCEDURE MainWait;
  367. VAR
  368.   msg : pIntuiMessage;
  369.   iclass : LONG;
  370.   ende : BOOLEAN;
  371. BEGIN
  372.   ende := FALSE;
  373.   REPEAT
  374.     msg := pIntuiMessage(WaitPort(wp^.UserPort));
  375.      msg := GT_GetIMsg(wp^.UserPort);
  376.      WHILE msg <> NIL DO
  377.      BEGIN
  378.         iclass := msg^.IClass;
  379.         GT_ReplyIMsg(msg);
  380.         CASE iclass OF
  381.           IDCMP_CLOSEWINDOW : ende := TRUE;
  382.           IDCMP_GADGETUP :
  383.              i := EasyReq(wp,WIN_TITLE,PChar('You have clicked on the Gadget!'#0),pchar('Wheeew!'#0));
  384.         ELSE END;
  385.        msg := GT_GetIMsg(wp^.UserPort);
  386.      END;
  387.   UNTIL ende;
  388. END;
  389.  
  390. BEGIN
  391.   GadToolsBase := OpenLibrary(GADTOOLSNAME,37);
  392.   IF GadToolsBase = NIL THEN CleanUp(MSG_CANT_OPEN_GTLIB, 20);
  393.   new(gl);
  394.   CloneDatas;
  395.   AllocateImages;
  396.   GenerateWindow;
  397.   MainWait;
  398.   CleanUp(nil,0);
  399. END.
  400.  
  401.  
  402.