1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
{ %target=win32 }
{ %norun }
{ %cpu=i386 }
{ %opt=-s -Amasm -TWin32 -Rintel }
{ Source provided for Free Pascal Bug Report 3540 }
{ Submitted by "Vladimir Panteleev" on 2005-01-11 }
{ e-mail: thecybershadow@gmail.com }
library Test;
type
Integer=LongInt;
ULONG=Cardinal;
PUCHAR=PChar;
type
TMyVars=record
RandSeed: Integer;
SX: Integer;
end;
TMyData=record
SomeConst: Integer;
end;
var
RMyData:TMyData=(
SomeConst: 31337;
);
{$R-,Q-}
function CalcAddr(const V):Pointer;stdcall;assembler;
var
P: Integer absolute V;
asm
call @@next
@@next:
pop eax
sub eax, offset @@next
add eax, P
end;
type
PMyVars=^TMyVars;
var
RMyVars: TMyVars;
function MyVars:PMyVars;
begin MyVars:=CalcAddr(RMyVars) end;
type
PMyData=^TMyData;
function MyData:PMyData;
begin MyData:=CalcAddr(RMyData) end;
procedure VidBufferToScreenBlt(Buffer:PUCHAR; x:ULONG; y:ULONG; width:ULONG; height:ULONG; lDelta:ULONG); stdcall; external;
type TPalette=array[0..15,0..3]of byte;PPalette=^TPalette;
function Palette:PPalette; external;
type
TBitmapInfo=record
Width, Height: Word;
Bits: Pointer;
end;
procedure DrawBitmap(X, Y: Integer; const Bitmap: TBitmapInfo);
begin
VidBufferToScreenBlt(CalcAddr(Bitmap.Bits^), X, Y, Bitmap.Width, Bitmap.Height, 4);
end;
const
test_palette: TPalette = (
($00, $00, $00, 0),
($80, $00, $00, 0),
($00, $80, $00, 0),
($80, $80, $00, 0),
($00, $00, $80, 0),
($80, $00, $80, 0),
($00, $80, $80, 0),
($80, $80, $80, 0),
($C0, $C0, $C0, 0),
($FF, $00, $00, 0),
($00, $FF, $00, 0),
($FF, $FF, $00, 0),
($00, $00, $FF, 0),
($FF, $00, $FF, 0),
($00, $FF, $FF, 0),
($FF, $FF, $FF, 0));
procedure Draw; stdcall;
var
i:integer;
x1,y1,x2,y2:integer;
begin
Palette^:=TPalette(CalcAddr(Test_palette)^);
end;
end.
|
