home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
windows
/
tps
/
tpslib.pas
< prev
Wrap
Pascal/Delphi Source File
|
1992-09-06
|
3KB
|
137 lines
library tpslib;
{Unit to tile Turbo Pascal for Windows Child windows
such that windows are tiled above each other rather
than side by side. This unit sets up a hook into the
get message filter and intercepts the specified menu
command replacing it with a message tile message
to the MDIClient window.
This program does not intercept TPW accelerators.
Therefore to tile vertically you can still use Shift-f4
(C) N.Waltham August 1992
Email 100013.3330@Compuserve.Com
}
{'Interface' section of library}
Uses
WinProcs,WinTypes,WinCrt,Strings,CLipLib,Win31;
function TileInStall(aFile : pChar; aCommand : integer) : integer;export;forward;
function Uninstall : integer;export;forward;
exports TileInstall index 1;
exports Uninstall index 2;
{Implementation section of library}
{Callback function for wh_GetMessage}
type
pMsg = ^tMsg;
tCharStr = array [0..128] of char;
var
Command : integer; {the command to intercept}
PrevGetMessage : tfarProc; {the previous message handling filter}
TaskWindow : hWnd; {the handle of TPW main window}
TaskInstance : integer; {the instance of TPW}
progname : tCharStr; {the program name}
{message filter}
function GetMessage(nCode : integer;wParam : word;var Msg : TMsg) : longint; export;
begin
GetMessage:=0;
With Msg do
begin
If hWnd <> TaskWindow then exit; {If this message is for another window then exit}
If message<>wm_command then exit; {If this message is not a menu command then exit}
If wParam=Command then {If its our command then replace it}
begin
hWNd:=GetWindow(hWnd,gw_child);
Message:=wm_MDITile;
lParam:=0;
wParam:=MDITile_Horizontal;
end;
end;
end;
{Call back function to find handle of TPW main window}
function WndFmInst(H : hWnd; L : Longint) : Boolean; Export;
begin
WndFmInst:=False; {Stop Enumerating}
If GetWindowWord(H,gww_HInstance)=L then TaskWindow:=H
else WndFmInst:=True; {continue enumerating}
end;
procedure ExecuteProgram;
var
paramblk : record
pbEnvSeg : Word;
pbCmdLine : pChar;
pbCmdShow : pointer;
pbReserved : Longint;
end;
CmdShow : longint;
progline : tcharstr;
TheInst : tFarProc;
begin
StrCopy(progline,progname);
StrCat(progline,'.EXE');
CmdShow:=MakeLong(2,sw_ShowNormal);
With ParamBlk do
begin
pbEnvSeg:=0;
pbCmdLine:=#0;
pbCmdShow:=Addr(CmdShow);
pbReserved:=0;
end;
TaskInstance:=LoadModule(Progline,@paramblk);
If TaskInstance>32 then
begin
TheInst:=MakeProcInstance(@WndFmInst,hInstance);
TaskWindow:=0;
EnumWindows(TheInst,TaskInstance);
FreeProcInstance(TheInst);
end else Halt(255);
end;
{Install Hook}
function TileInStall;
begin
StrCopy(progname,aFile);
Command:=aCommand;
ExecuteProgram;
PrevGetMessage:=SetWindowsHook(wh_GetMessage,@GetMessage);
TileInstall:=TaskWindow;
end;
{UnInstall Hook}
function Uninstall;
begin
UnHookWindowsHook(wh_GetMessage,@GetMessage);
end;
{No Initialization}
begin
end.