unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
EXTEND_EXTRA = 56;
procedure SetProperty(WinHandle: HWND; Item: integer; V: integer);
begin
if (Item > 0)
and (Item < EXTEND_EXTRA + 1)
and (WinHandle <> 0)
then
SetWindowLong(WinHandle, (Item - 1) * 4, V);
end;
function GetProperty(WinHandle: HWND; Item: integer): integer;
begin
Result := 0;
if (Item > 0)
and (Item < EXTEND_EXTRA + 1)
and (WinHandle <> 0)
then
Result := GetWindowLongPtr(WinHandle, (Item - 1) * 4);
end;
procedure Test;
var
Item: integer;
V: integer;
DesktopDeviceContext: HDC;
I: Integer;
begin
for I := 0
to 100
do
begin
Item := 1;
DesktopDeviceContext := GetDC(0);
SetProperty(Form1.Handle, Item, DesktopDeviceContext);
V := GetProperty(Form1.Handle, Item);
ReleaseDC(Form1.Handle, DesktopDeviceContext)
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Test;
end;
end.