home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / call32nt / delphi / testw32.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  3.7 KB  |  119 lines
  1. unit Testw32;   {Draws Bezier curves in Win95/WinNT, which is normally impossible in Win16}
  2.                 {Written in Delphi for Windows 1.0         }
  3.                 {By Christian Ghisler, CIS: 100332,1175    }
  4.                 {Released to the public domain June 14,1995}
  5.  
  6. interface
  7.  
  8. uses
  9.   WinTypes, WinProcs, Forms,
  10.   call32nt;
  11.  
  12. type
  13.   TForm1 = class(TForm)
  14.     procedure FormCreate(Sender: TObject);
  15.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  16.   private
  17.     { Private-Declarations }
  18.   public
  19.     { Public-Declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.DFM}
  28.  
  29.  
  30. type tagpoint=array[0..3] of record
  31.        x,y:longint;
  32.      end;
  33.  
  34. {Declaration of the 32 bit functions}
  35. var
  36.   GetDC:function(hwnd,id:longint):longint;
  37.   ReleaseDC:function(hwnd,hdc,id:Longint):longint;
  38.   PolyBezier:function(hdc:longint;var points:tagPoint;count,id:Longint):Longint;
  39.   GetDesktopWindow:function(id:Longint):longint;
  40.   CreatePen:function(style,w,c,id:Longint):Longint;
  41.   SelectObject:function(hdc,hpen,id:longint):Longint;
  42.   DeleteObject:function(hpen,id:Longint):Longint;
  43.  
  44. {Declaration of a unique identifier for each 32 bit function}
  45. var
  46.   idGetDC,
  47.   idReleaseDC,
  48.   idPolyBezier,
  49.   idCreatePen,
  50.   idSelectObject,
  51.   idDeleteObject,
  52.   dc:longint;
  53.   finished:boolean;
  54.  
  55. {Here comes the code which actually uses the 32-bit functions}
  56. procedure TForm1.FormCreate(Sender: TObject);
  57. var points:tagPoint;
  58. var i,j:Integer;
  59.     r,hpen,oldpen:Longint;
  60.     msg:tmsg;
  61. Const PointCount = 4;
  62.  
  63. begin
  64.   Show;
  65.   dc:=GetDC(Form1.handle, idGetDC);
  66.   finished:=false;
  67.   repeat
  68.     hpen:=CreatePen(PS_SOLID, 5,trunc(Random*$1000000), idCreatePen);
  69.     For i:=0 To 3 do begin
  70.       points[i].x:=Random(Form1.width);
  71.       points[i].y:=Random(form1.height);
  72.     end;
  73.     OldPen:=SelectObject(dc, hpen, idSelectObject);
  74.     PolyBezier(dc, points, PointCount, idPolyBezier);
  75.     SelectObject(dc, OldPen, idSelectObject);  {Very important! A selected pen cannot be deleted!}
  76.     DeleteObject(hpen, idDeleteObject);
  77.     Application.ProcessMessages;
  78.   until finished;
  79.   Application.Terminate;
  80. end;
  81.  
  82. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  83. begin
  84.   if not finished then begin
  85.     finished:=true;
  86.     ReleaseDC(Form1.handle,dc,idReleaseDC);
  87.    {No need to un-initialize, the 32-bit libraries are automatically freed when the program terminates}
  88.     CanClose:=false;
  89.   end else
  90.     CanClose:=true;
  91. end;
  92.  
  93. begin
  94.   {Initialization of the 32 bit functions}
  95.   @GetDC:=@Call32;
  96.   @ReleaseDC:=@Call32;
  97.   @PolyBezier:=@Call32;
  98.   @GetDesktopWindow:=@Call32;
  99.   @CreatePen:=@Call32;
  100.   @SelectObject:=@Call32;
  101.   @DeleteObject:=@Call32;
  102.  
  103.   {Each function must be declared with Declare32. The handle returned by Declare32
  104.    must be passed as the last parameter of the function when the function is called}
  105.   {Parameters of Declare32: }
  106.   {First:  The name of the original win32 function: CASE SENSITIVE!!!!!}
  107.   {Second: The name of the 32 bit module where the function is located}
  108.   {Third:  A string describing all parameters. p=pointer, i=longint, w=Windows handle}
  109.   idGetDC:=Declare32('GetDC', 'user32', 'w');
  110.   idReleaseDC:=Declare32('ReleaseDC', 'user32', 'wi');
  111.   idPolyBezier:=Declare32('PolyBezier', 'gdi32', 'ipi');
  112.   idCreatePen:=Declare32('CreatePen', 'gdi32', 'iii');
  113.   idSelectObject:=Declare32('SelectObject', 'gdi32', 'ii');
  114.   idDeleteObject:=Declare32('DeleteObject', 'gdi32', 'i');
  115.   {Check if everything went well. If there was only a single error, Call32NTError=false}
  116.   if Call32NTError then begin
  117.     messagebox(0,'Sorry, cannot load 32 bit system!','testw32',mb_ok);
  118.     halt(1);
  119.   end;
  120. end.
  121.