paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 09:50:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* mmtk directory corrected to lowercase

Browse Source
This commit is contained in:
Tomas Hajny 2003-02-15 16:59:09 +00:00
parent 06279b36e1
commit ca814778e7
4 changed files with 1441 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1306
packages/extra/os2units/mmtk/tests/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

15
packages/extra/os2units/mmtk/tests/Makefile.fpc Normal file
View File

@ -0,0 +1,15 @@
#
# Makefile.fpc for MMTK sample programs
#
[target]
programs=mciapi1 mciapi2
[require]
packages=mmtk
[install]
fpcpackage=y
[default]
fpcdir=../../../../..

60
packages/extra/os2units/mmtk/tests/mciapi1.pas Normal file
View File

@ -0,0 +1,60 @@
program mciapi1;
uses
Os2Def, PMWin, mciapi;
function ClientWindowProc (Window, Msg: cardinal; MP1, MP2: pointer): pointer;
cdecl; export;
var
Ps: cardinal;
R: TRectL;
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);
WinRegisterClass (Anchor, ClassName, proc (@ClientWindowProc), cs_SizeRedraw,
SizeOf (pointer));
Frame := WinCreateStdWindow (hwnd_Desktop, 0, WinFlags, ClassName,
'MMPM/2 TEST WAVE', 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);
(* Play a wave file set to valid window handle *)
mciPlayFile(Frame, 'test.wav', MCI_ASYNC, nil, 0);
while WinGetMsg (Anchor, Message, 0, 0, 0) do
WinDispatchMsg (Anchor, Message);
WinDestroyWindow (Frame);
end;
WinDestroyMsgQueue (MsgQue);
WinTerminate (Anchor);
end.

60
packages/extra/os2units/mmtk/tests/mciapi2.pas Normal file
View File

@ -0,0 +1,60 @@
program mciapi2;
uses
Os2Def, PMWin, mciapi;
function ClientWindowProc (Window, Msg: cardinal; MP1, MP2: pointer): pointer;
cdecl; export;
var
Ps: cardinal;
R: TRectL;
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);
WinRegisterClass (Anchor, ClassName, proc (@ClientWindowProc), cs_SizeRedraw,
SizeOf (pointer));
Frame := WinCreateStdWindow (hwnd_Desktop, 0, WinFlags, ClassName,
'MMPM/2 TEST', 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);
(* Play a wave file set to valid window handle *)
mciPlayFile(Frame, 'movie.avi', MCI_ASYNC, 'MMPM/2 TEST MOVIE', 0);
while WinGetMsg (Anchor, Message, 0, 0, 0) do
WinDispatchMsg (Anchor, Message);
WinDestroyWindow (Frame);
end;
WinDestroyMsgQueue (MsgQue);
WinTerminate (Anchor);
end.