home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / ruzne / zcd30120.exe / Demo / sbtest_1.pas < prev    next >
Pascal/Delphi Source File  |  1997-06-02  |  7KB  |  237 lines
  1. unit Sbtest_1;
  2.  
  3. {
  4.              A unit for SBTEST.PAS, a testprogram for TzShapeBtn
  5.  
  6.                       The ZieglerCollection one (TM)
  7.                                 Version 1,01
  8.                         (Changed for version 1.12)
  9.  
  10.            (C) Copyright 1995,96,97 By ZieglerSoft, all rights reserved
  11. }
  12.  
  13. Interface
  14.  
  15. Uses
  16.   SysUtils,  Messages, Classes, Graphics, Controls,
  17.   Forms, Dialogs, Buttons, ExtCtrls, Mystd, StdCtrls, Animate,Wintypes,Winprocs;
  18.  
  19. Type
  20.   TForm1 = Class(TForm)
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     Edit1: TEdit;
  24.     zShapeBtn1: TzShapeBtn;
  25.     zShapeBtn2: TzShapeBtn;
  26.     zShapeBtn3: TzShapeBtn;
  27.     zShapeBtn4: TzShapeBtn;
  28.     zShapeBtn5: TzShapeBtn;
  29.     zShapeBtn6: TzShapeBtn;
  30.     zShapeBtn7: TzShapeBtn;
  31.     zShapeBtn8: TzShapeBtn;
  32.     zShapeBtn9: TzShapeBtn;
  33.     zShapeBtn10: TzShapeBtn;
  34.     zShapeBtn11: TzShapeBtn;
  35.     zShapeBtn12: TzShapeBtn;
  36.     zShapeBtn13: TzShapeBtn;
  37.     Procedure zShapeBtn1Click(Sender: TObject);
  38.     Procedure zShapeBtn2Click(Sender: TObject);
  39.     Procedure zShapeBtn3Click(Sender: TObject);
  40.     Procedure zShapeBtn4Click(Sender: TObject);
  41.     Procedure zShapeBtn5Click(Sender: TObject);
  42.     Procedure zShapeBtn6Click(Sender: TObject);
  43.     Procedure zShapeBtn7Click(Sender: TObject);
  44.     Procedure zShapeBtn8Click(Sender: TObject);
  45.     Procedure zShapeBtn9Click(Sender: TObject);
  46.     Procedure zShapeBtn10Click(Sender: TObject);
  47.     Procedure zShapeBtn11Click(Sender: TObject);
  48.     Procedure zShapeBtn12Click(Sender: TObject);
  49.     Procedure zShapeBtn13Click(Sender: TObject);
  50.     Procedure FormCreate(Sender: TObject);
  51.     {$IfnDef Win32}
  52.     procedure zShapeBtn2GetReg(Sender: TObject; var Region: Word; Width,
  53.       Height: Integer);
  54.     procedure zShapeBtn2OwnerD(Sender: TObject; Canvas: TCanvas;
  55.       Down: Boolean; Width, Height: Integer; Region: Word; Shadow,
  56.       Highlight: TColor);
  57.     {$else}
  58.     procedure zShapeBtn2GetRegion(Sender: TObject; var Region: Integer; Width,
  59.       Height: Integer);
  60.     procedure zShapeBtn2OwnerDraw(Sender: TObject; Canvas: TCanvas;
  61.       Down: Boolean; Width, Height: Integer; Region: Integer; Shadow,
  62.       Highlight: TColor);
  63.     {$endif}
  64.   End;
  65.  
  66. Var
  67.   Form1: TForm1;
  68.  
  69. Implementation
  70. {$R *.DFM}
  71.  
  72. {$ifnDef Win32}
  73. procedure TForm1.zShapeBtn2OwnerD(Sender: TObject; Canvas: TCanvas;
  74.   Down: Boolean; Width, Height: Integer; Region: Word; Shadow,
  75.   Highlight: TColor);
  76. {$else}
  77. Procedure TForm1.zShapeBtn2OwnerDraw(Sender: TObject; Canvas: TCanvas;
  78.   Down: Boolean; Width, Height: Integer; Region: Integer; Shadow,
  79.   Highlight: TColor);
  80. {$endif}
  81.   {- in this procedure, we draw the Ownerdraw-TzShapeBtn.}
  82. Var
  83.   H1,H2,H3,V1,V2,V3 : Integer;
  84. Begin
  85.   If Sender=zShapeBtn2 Then With Canvas Do begin
  86.     H1:=(Height-1) Div 3; H2:=H1+H1; H3:=H1+H2;
  87.     V1:=(Width-1) Div 3;  V2:=V1+V1; V3:=V1+V2;
  88.     PaintRgn(Handle,Region);
  89.     Pen.Color:=Shadow;
  90.     PolyLine([Point(0,H3),Point(0,0),Point(V3,0)]);
  91.     PolyLine([Point(V2,H1),Point(V3,H2)]);
  92.     PolyLine([Point(V1,H2),Point(V2,H3)]);
  93.     PolyLine([Point(0,H3-2),Point(V1,H2-2)]);
  94.     PolyLine([Point(V2,H1-2),Point(V3-2,0)]);
  95.     PolyLine([Point(V2-1,H3-1),Point(V3-1,H2-1)]);
  96.     If Down Then Pen.Color:=clBlack Else Pen.Color:=HighLight;
  97.     PolyLine([point(1,H3-4),Point(1,1),Point(V3-3,1)]);
  98.     PolyLine([Point(V1,H2-2),Point(V2,H3-2)]);
  99.     PolyLine([Point(V2,H1+1),Point(V3-1,H2)]);
  100.     If Down Then pen.Color:=HighLight Else pen.Color:=clblack;
  101.     PolyLine([Point(0,H3),Point(v1,H2)]);
  102.     PolyLine([point(V2,H3),Point(V3,H2)]);
  103.     PolyLine([Point(V3,0),Point(V2,H1)]);
  104.   End;
  105. End;
  106.  
  107. {$IfNDef Win32}
  108. procedure TForm1.zShapeBtn2GetReg(Sender: TObject; var Region: Word;
  109.   Width, Height: Integer);
  110. {$else}
  111. Procedure TForm1.zShapeBtn2GetRegion(Sender: TObject; var Region: Integer;
  112.   Width, Height: Integer);
  113. {$endif}
  114.   {- In this procedure, we give the OwnerDraw-TzShapeBtn the information it
  115.      needs to know where the button must be down, and where it must be up,
  116.      when a user clicks the button.}
  117. Var
  118.   fWhere : Array[0..6] of tPoint;
  119.   H1,H2,H3,V1,V2,V3 : Integer;
  120. Begin
  121.   If Sender=zShapeBtn2 Then Begin
  122.     H1:=(Height-1) Div 3; H2:=H1+H1; H3:=H2+H1;
  123.     V1:=(Width-1) Div 3;  V2:=V1+V1; V3:=V2+V1;
  124.     fWhere[0]:=Point(0,0);
  125.     fWhere[1]:=Point(V3,0);
  126.     fWhere[2]:=Point(V2,H1);
  127.     fWhere[3]:=Point(V3,H2);
  128.     fWhere[4]:=Point(V2,H3);
  129.     fWhere[5]:=Point(V1,H2);
  130.     fWhere[6]:=Point(0,H3);
  131.     Region:=CreatePolygonRgn(fWhere,7,Alternate);
  132.   End;
  133. End;
  134.  
  135. Procedure TForm1.zShapeBtn1Click(Sender: TObject);
  136. Begin
  137.   Label1.Caption:='';
  138. End;
  139.  
  140. Procedure TForm1.zShapeBtn2Click(Sender: TObject);
  141. Begin
  142.   Label1.Caption:='Can you get the point?';
  143. End;
  144.  
  145. Procedure TForm1.zShapeBtn3Click(Sender: TObject);
  146. Begin
  147.   Label1.Caption:='You got the point';
  148. End;
  149.  
  150. Procedure TForm1.zShapeBtn4Click(Sender: TObject);
  151. Begin
  152.   Label1.Caption:='Pointing Down and Right';
  153. End;
  154.  
  155. Procedure TForm1.zShapeBtn5Click(Sender: TObject);
  156. Begin
  157.   Label1.Caption:='Pointing Up and Right';
  158. End;
  159.  
  160. Procedure TForm1.zShapeBtn6Click(Sender: TObject);
  161. Begin
  162.   Label1.Caption:='Pointing Down and Left';
  163. End;
  164.  
  165. Procedure TForm1.zShapeBtn7Click(Sender: TObject);
  166. Begin
  167.   Label1.Caption:='Pointing Up and Left';
  168. End;
  169.  
  170. Procedure TForm1.zShapeBtn8Click(Sender: TObject);
  171. Begin
  172.   Try
  173.     Label2.Caption:=IntToStr(StrToInt(Label2.Caption)+1);
  174.   Except
  175.     Label2.Caption:='0';
  176.   End;
  177. End;
  178.  
  179. Procedure TForm1.zShapeBtn9Click(Sender: TObject);
  180. Begin
  181.   Try
  182.     Label2.Caption:=IntToStr(StrToInt(Label2.Caption)-1);
  183.   Except
  184.     Label2.Caption:='0';
  185.   End;
  186. End;
  187.  
  188. Procedure TForm1.FormCreate(Sender: TObject);
  189. Begin
  190.   Label1.Caption:='Try the buttons';
  191.   Label2.Caption:='0';
  192.   {$ifNdef Win32}
  193.   zShapeBtn2.OngetRegion:=zShapeBtn2GetReg;
  194.   zShapeBtn2.OnOwnerDraw:=zShapeBtn2OwnerD;
  195.   {$else}
  196.   zShapeBtn2.OngetRegion:=zShapeBtn2GetRegion;
  197.   zShapeBtn2.OnOwnerDraw:=zShapeBtn2OwnerDraw;
  198.   {$endif}
  199. End;
  200.  
  201. procedure TForm1.zShapeBtn11Click(Sender: TObject);
  202. begin
  203.   Try
  204.     Edit1.Text:=IntToStr(StrToInt(Edit1.Text)+1);
  205.   Except
  206.     Edit1.Text:='1';
  207.   End;
  208. end;
  209.  
  210. procedure TForm1.zShapeBtn10Click(Sender: TObject);
  211. begin
  212.   Try
  213.     Edit1.Text:=IntToStr(StrToInt(Edit1.Text)-1);
  214.   Except
  215.     Edit1.Text:='-1';
  216.   End;
  217. end;
  218.  
  219. procedure TForm1.zShapeBtn12Click(Sender: TObject);
  220. begin
  221.   Edit1.Text:='0';
  222. end;
  223.  
  224. procedure TForm1.zShapeBtn13Click(Sender: TObject);
  225. begin
  226.   Try
  227.     If StrToInt(Edit1.Text)<0 then
  228.       Edit1.Text:=IntToStr(-1-MaxLongInt)
  229.     Else
  230.       Edit1.Text:=IntToStr(MaxlongInt);
  231.   Except
  232.     Edit1.Text:=IntToStr(-1-MaxLongInt)
  233.   End;
  234. end;
  235.  
  236. End.
  237.