home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / PointerLib / PointerDemo.p < prev    next >
Encoding:
Text File  |  1997-05-06  |  4.0 KB  |  174 lines
  1. program PointerDemo;
  2.  
  3. { *    PointerDemo.p                               * }
  4. { *    Ein kleines Beispielprogramm zur Benutzung der pointer.library .   * }
  5. { *    Dieses Programm ist Public Domain !                   * }
  6. { *    Coded 11/11/1992 by "Diesel" B. Künnen                   * }
  7.  
  8. {$I "Include:libraries/Dos.i"}
  9. {$I "Include:intuition/intuition.i"}
  10. {$I "Include:libraries/Pointerlib.i"}
  11. {$I "Include:Utils/stringlib.i"}
  12. {$I "Include:exec/libraries.i"}
  13. {$I "Include:exec/ports.i"}
  14.  
  15.  
  16. CONST    breit   = 500;    { * werden für die Gadgets gebraucht * }
  17.     gadleft = 20;
  18.  
  19.     MyNewWindow : NewWindow = ( 0,10,breit,150,  0,1,
  20.     GADGETUP_f + MENUPICK_f,
  21.     ACTIVATE + WINDOWDRAG + WINDOWDEPTH,
  22.     NIL,NIL, "Pointer.lib/PCQ-Demo/Diesel - Rechte Maustaste = Exit",
  23.     NIL,NIL, 0,0,0,0, WBENCHSCREEN_f);
  24.  
  25.     Ptrname : Array[1..6] of String = ("Standard.ilbm",
  26.                        "CrossHair.ilbm",
  27.     { * hier die Namen der * }       "GhostPointer.ilbm",
  28.     { * Pointer, die im    * }       "HourGlass.ilbm",
  29.     { * Verzeichnis        * }       "StopWatch.ilbm",
  30.     { * :pointers/ stehen  * }       "ZZBubble.ilbm");
  31.     { * sollten ...        * }
  32.  
  33. VAR
  34.     MyWindow : WindowPtr;
  35.     new_Point,
  36.     zZ_Point : MousePointerPtr;
  37.     I_Msg     : IntuiMessagePtr;
  38.     slect     : GadgetPtr;
  39.     Pgad     : Array[1..6] of GadgetPtr;
  40.     MyPort     : Address;        { MessagePortPtr }
  41.     ilbm     : String;
  42.     class     : Integer;
  43.     i     : Short;
  44.  
  45.  
  46. { * Wir wollen ja auch alles sauber hinterlassen ... * }
  47.  
  48. Procedure CleanExit( why: String; rt : Integer );
  49. Begin
  50.     if zZ_Point    <> NIL then  FreePointer (  zZ_Point );
  51.     if MyWindow    <> NIL then  CloseWindow (  MyWindow );
  52.     if PointerBase    <> NIL then  CloseLibrary( PointerBase );
  53.  
  54.     if why <> NIL then begin
  55.       write( why );
  56.       Delay(150);
  57.     End;
  58.  
  59.     Exit( rt );
  60. End;
  61.  
  62.  
  63. { * Fkt., um die Gadgets einzurichten * }
  64.  
  65. Function MakeGadget( next: gadgetPtr; id : Short ): gadgetPtr;
  66. var
  67.     gad   : GadgetPtr;
  68.     gadIT : IntuiTextPtr;
  69. Begin
  70.  
  71.     New( gadIT );            { * IntuiText einrichten * }
  72.     With gadIT^ do begin
  73.       FrontPen := 3;
  74.       BackPen  := 0;
  75.       DrawMode := jam1;
  76.       IText    := Ptrname[id];
  77.       LeftEdge := ((breit-2*gadleft) div 2) - ( IntuiTextLength(gadIT) DIV 2 );
  78.       TopEdge  := 3;
  79.     end;
  80.  
  81.     New( Gad );            { * Gadget einrichten * }
  82.     With Gad^ Do Begin
  83.       NextGadget   := next;
  84.       LeftEdge     := gadleft;
  85.       TopEdge      := id * 18;
  86.       Width        := breit - ( 2 * gadleft );
  87.       Height       := 12;
  88.       Flags        := gadgHBox;
  89.       Activation   := relverify;
  90.       gadgetType   := BoolGadget;
  91.       gadgetText   := gadIT;
  92.       gadgetRender := NIL;
  93.       gadgetID     := id;
  94.     end;
  95.  
  96.     MakeGadget := Gad;        { * GadgetPtr zurückgeben * }
  97. end;
  98.  
  99.  
  100.  
  101.  
  102. { * Hauptschleife * }
  103.  
  104. BEGIN
  105.     ilbm:=AllocString(80);
  106.  
  107.     { *    Pointer.library öffnen     * }
  108.  
  109.     PointerBase := OpenLibrary( PointerName, 33 );
  110.     if PointerBase = NIL  then
  111.         CleanExit( "Kann pointer.librarynicht öffnen\n", 20 );
  112.  
  113.     { * 6 Gadgets einrichten * }
  114.  
  115.     Pgad[6] := MakeGadget( NIL, 6 );
  116.     For i:=6 downto 1 do
  117.         Pgad[i]:=MakeGadget( Pgad[i+1], i );
  118.  
  119.     { * Window öffnen * }
  120.  
  121.     MyNewWindow.FirstGadget := Pgad[1];
  122.     MyWindow := OpenWindow( Adr(MyNewWindow) );
  123.     if( MyWindow = NIL ) then
  124.         Cleanexit( "Kann Window nicht öffnen\n", 10 );
  125.  
  126.  
  127.     MyPort := MyWindow^.userPort;            { * get MsgPort   * }
  128.  
  129.     REPEAT
  130.             { * Msg`s abholen und beantworten * }
  131.       REPEAT
  132.         I_Msg := IntuiMessagePtr( WaitPort(MyPort) ); { * wait4 message * }
  133.         I_Msg := IntuiMessagePtr( GetMsg(MyPort) );      { * Get IntuiMsg  * }
  134.       UNTIL I_Msg <> NIL;
  135.  
  136.       class := I_Msg^.class;
  137.       slect := GadgetPtr( I_Msg^.iAddress );
  138.       ReplyMsg( MessagePtr( I_Msg) );        { * OK to sender  * } 
  139.  
  140.       CASE class OF
  141.  
  142.       GADGETUP_F :
  143.       Begin                    { * da sind die Dateien * }
  144.         strcpy( ilbm, "Purity 8:PCQ-Programme/Pointers/" );
  145.         strcat( ilbm, Ptrname[slect^.gadgetID] );
  146.  
  147.         { * neuen Pointer laden, alten löschen, neuen setzen *}
  148.  
  149.         new_Point := LoadPointer( ilbm );
  150.         If new_Point = NIL then DisplayBeep( NIL ) else
  151.         Begin
  152.           FreePointer( zZ_Point );
  153.           zZ_Point := new_Point;
  154.           SetPointer( MyWindow,
  155.                   zZ_Point^.Data,
  156.                   zZ_Point^.Height,
  157.                   zZ_Point^.Width,
  158.                   zZ_Point^.XOff,
  159.                   zZ_Point^.YOff );
  160.         End;
  161.       end;
  162.  
  163.       MENUPICK_F:        { * EXIT * }
  164.       Begin
  165.         CleanExit( "PointerDemo, 1992 by Diesel", 0 );
  166.       End;
  167.  
  168.       ELSE END;
  169.  
  170.     UNTIL FALSE;
  171.  
  172. END.
  173.  
  174.