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
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1993-2001 by Free Pascal team
The most basic Presentation Mode example.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program BasicPM;
{$APPTYPE GUI}
uses
Os2Def, PMWin;
function ClientWindowProc (Window, Msg: cardinal; MP1, MP2: pointer): pointer;
cdecl; export;
var
Li: longint;
Ps: cardinal;
R: TRectL;
P: TPointL;
Rgn: cardinal;
begin
ClientWindowProc := nil;
case Msg of
wm_Paint: begin
PS := WinBeginPaint (Window, 0, @R);
WinFillRect (PS, @R, SYSCLR_WINDOW);
WinEndPaint (PS);
end;
else ClientWindowProc := WinDefWindowProc (Window, Msg, MP1, MP2);
end;
end;
const
idClientWindow = 11000;
WinFlags: cardinal = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder +
fcf_MinMax + fcf_TaskList + fcf_NoByteAlign;
ClassName = 'MYVIEW';
var
Anchor, MsgQue: cardinal;
Message: TQMsg;
Frame, Client: cardinal;
begin
Anchor := WinInitialize(0);
{ It might be beneficial to set the second parameter of the following }
{ call to something large, such as 1000. The OS/2 documentation does }
{ not recommend this, however } MsgQue := WinCreateMsgQueue (Anchor, 0);
if MsgQue = 0 then Halt (254);
WinMessageBox (HWND_DESKTOP, HWND_DESKTOP, 'FPC test', 'Basic PM', 0,
MB_OK or MB_INFORMATION);
WinRegisterClass (Anchor, ClassName, proc (@ClientWindowProc), cs_SizeRedraw,
SizeOf (pointer));
Frame := WinCreateStdWindow (hwnd_Desktop, 0, WinFlags, ClassName,
'BASIC PM', 0, 0, idClientWindow, Client);
if (Frame <> 0) then
begin
WinSetWindowPos (Frame, 0, 0, WinQuerySysValue (hwnd_Desktop,
sv_CyScreen) - 200, 200, 200, swp_Move + swp_Size + swp_Activate +
swp_Show);
while WinGetMsg (Anchor, Message, 0, 0, 0) do
WinDispatchMsg (Anchor, Message);
WinDestroyWindow (Frame);
end;
WinDestroyMsgQueue (MsgQue);
WinTerminate (Anchor);
end.
|
