-
Notifications
You must be signed in to change notification settings - Fork 2
/
README.win32
204 lines (184 loc) · 6.61 KB
/
README.win32
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
=pod -*- perl -*-
This file is a Perl program that tests the C::DynaLib package on Windows. To run
it after installation, type `perl README.win32'. If you want to run it before
installing the module, your best bet is to rename test.pl to something like
test.bak.pl, rename this file test.pl, and do `make test' (or nmake, or dmake,
whatever make you use). If successful, it will create a window with a message
in the center.
The program is modeled after the kind of "hello world" examples found in
introductory books on Windows programming in C. However, Perl lacks an
important feature of C, namely the preprocessor (unless someone has written a
Cpp module that I don't know about?) Therefore, all function declarations and
constants from <windows.h> are hard-coded.
Another difficulty is the use of resources. Windows resources are binary data
associated with an application; for example, menus, bitmaps, and dialog box
templates. Typically, resources are linked into the program's .exe file. Of
course, Perl programs are text and don't use the binary format which can contain
resources. Although it is possible to construct at run time the objects which
would otherwise be stored as resources, this is rather wasteful and complicated.
One alternative is to put the resources in a DLL or EXE which the Perl program
would then load via LoadLibrary(). A more radical solution would be to generate
a cross-breed file which has the EXE format and is at the same time parsable by
perl. A similar principle is used by the pl2bat utility in the Win32 Perl
distribution. However, the "Portable Executable" format used by Win32 is quite
a bit nastier on text editors than are .bat files. Wordpad, for instance, won't
open them at all, and Notepad leaves them hopelessly corrupt when you save.
Be that as it may, I, John Tobey, have developed a pl2exe program that does what
its name suggests. It takes a perl script and adds some stuff at the beginning
to make it have the PE format (well, close enough to fool Windows). When
executed, the program invokes perl on itself the way a pl2bat script does (and
avoids the 9-argument limit on Windows 95, btw). The thing lacking in pl2exe
that would make it really useful is a way to link in resources without
disrupting the delicate PE/script balance. Maybe someday.
One final note about this file. This is a demo/test program. It is not
necessarily good coding style.
=cut
use 5.00402;
use C::DynaLib;
use C::DynaLib::Struct;
use strict;
my $user32 = new C::DynaLib("USER32");
my $gdi32 = new C::DynaLib("GDI32");
# either let it parse the types
Parse C::DynaLib::Struct('<<EOFC');
typedef struct _WNDCLASS { // wc
UINT style;
WNDPROC lpfnWndProc;
int cbClsExtra;
int cbWndExtra;
HANDLE hInstance;
HICON hIcon;
HCURSOR hCursor;
HBRUSH hbrBackground;
LPCTSTR lpszMenuName;
LPCTSTR lpszClassName;
} WNDCLASS;
EOFC
# or define the pack types by yourself
Define C::DynaLib::Struct('WNDCLASS',
I => ['style'],
I => ['lpfnWndProc'],
i => ['cbClsExtra'],
i => ['cbWndExtra'],
I => ['hInstance'],
I => ['hIcon'],
I => ['hCursor'],
I => ['hbrBackground'],
p => ['lpszMenuName'],
p => ['lpszClassName'],
);
# The results of much sifting through C header files.
# These functions should be generated by parsing though
# <win32.h> also.
my $PostQuitMessage = $user32->DeclareSub("PostQuitMessage",
"i", # return type
"i"); # argument type(s)
my $GetClientRect = $user32->DeclareSub("GetClientRect",
"i",
"i", "P");
my $BeginPaint = $user32->DeclareSub("BeginPaint",
"i",
"i", "P");
my $DrawText = $user32->DeclareSub("DrawTextA",
"i",
"I", "p", "I", "P", "I");
my $EndPaint = $user32->DeclareSub("EndPaint",
"i",
"i", "P");
my $DefWindowProc = $user32->DeclareSub("DefWindowProcA",
"i",
"i", "i", "i", "i");
my $LoadIcon = $user32->DeclareSub("LoadIconA",
"i",
"i", "i");
my $LoadCursor = $user32->DeclareSub("LoadCursorA",
"i",
"i", "i");
my $GetStockObject = $gdi32->DeclareSub("GetStockObject",
"i",
"i");
my $RegisterClass = $user32->DeclareSub("RegisterClassA",
"i",
"P");
my $CreateWindowEx = $user32->DeclareSub("CreateWindowExA",
"i",
"i", "p", "p", "i", "i", "i", "i", "i", "i", "i", "i", "i");
my $ShowWindow = $user32->DeclareSub("ShowWindow",
"i",
"i", "i");
my $UpdateWindow = $user32->DeclareSub("UpdateWindow",
"i",
"i");
my $GetMessage = $user32->DeclareSub("GetMessageA",
"i",
"P", "i", "i", "i");
my $TranslateMessage = $user32->DeclareSub("TranslateMessage",
"i",
"P");
my $DispatchMessage = $user32->DeclareSub("DispatchMessageA",
"i",
"P");
#
# Main window's callback.
#
sub window_proc {
my ($hwnd, $uMsg, $wParam, $lParam) = @_;
# Wanna log your window messages?
#print "hwnd=$hwnd, uMsg=$uMsg, wParam=$wParam, lParam=$lParam\n";
if ($uMsg == 0x0201 # WM_LBUTTONDOWN
|| $uMsg == 0x0002 # WM_DESTROY
) {
&$PostQuitMessage(0);
return 0;
} elsif ($uMsg == 0x000F) { # WM_PAINT
my $text = "Hello from Perl!";
# This should be big enough for a PAINTSTRUCT, I hope:
my $ps = "\0" x 1024;
my $rect = "\0" x 64;
my $hdc;
&$GetClientRect($hwnd, $rect);
$hdc = &$BeginPaint($hwnd, $ps);
&$DrawText($hdc, $text, length($text), $rect,
0x00000025); # DT_SINGLELINE | DT_CENTER | DT_VCENTER
&$EndPaint($hwnd, $ps);
return 0;
}
return &$DefWindowProc($hwnd, $uMsg, $wParam, $lParam);
}
my $wnd_proc = new C::DynaLib::Callback
(
\&window_proc, "i", "i", "i", "i", "i");
#
# Register the window class.
#
my $wc;
my $rwc = tie $wc, 'WNDCLASS';
$rwc->style(0x0003); # CS_HREDRAW | CS_VREDRAW
$rwc->lpfnWndProc($wnd_proc->Ptr());
$rwc->hInstance(0x00400000);
$rwc->hIcon(&$LoadIcon(0, 32512));
$rwc->hCursor(&$LoadCursor(0, 32512));
$rwc->hbrBackground(&$GetStockObject(0)); # WHITE_BRUSH
$rwc->lpszClassName("w32test");
&$RegisterClass($wc) or die "can't register window class";
#
# Create the window.
#
my $title_text = "Perl Does Win32";
my $hwnd = &$CreateWindowEx(0, $rwc->lpszClassName,
$title_text,
0x00CF0000, # WS_OVERLAPPEDWINDOW
0x80000000, # CW_USEDEFAULT
0x80000000, 0x80000000, 0x80000000,
0, 0, $rwc->hInstance,
0) or die "can't create window";
&$ShowWindow($hwnd, 10); # SW_SHOWDEFAULT
&$UpdateWindow($hwnd);
#
# Message loop.
#
my $msg = "\0" x 64;
while (&$GetMessage($msg, 0, 0, 0)) {
&$TranslateMessage($msg);
&$DispatchMessage($msg);
}