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