[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]

(*
  The intent of this program is to provide the ability to add additional functionality
  to WinCRT.  Like the ablity to add and use a menubar and to be able to respond to
  mouse clicks.      WinCRT does NOT need to be modified to run this app.

  This program is Public Domain by Cedar Island Software. Use it as you see fit.
  All the usual disclaimers apply.

  Thanks to Neil Rubenking and his book 'Turbo Pascal for Windows Techniques and Utilities'.
  Thanks to Kurt Barthlemess of BPASCAL (TeamB).
  Thanks also to Paul A. LeBlanc of BCPPWIN (TeamB).


  Good Luck and Have Fun.
  Mike Caughran
  Cedar Island Software
  [71034,2371]
*)

program HookCRT;
uses WinCRT, WinTypes, WinProcs;
var
  OldCRTProc : TFarProc;
  NewCRTProc : TFarProc;
  ps         :  TPaintStruct;
  appIcon    :  hIcon;
const
  hHookedWnd : HWND = 0;
  cm_Exit    = 100;
  cm_About   = 101;

function ShellAbout(hwnd:HWND; Title,Text:PChar; icon:HICON):integer; external 'SHELL' index 22;
procedure MyDoneWinCRT; forward;

function NewMsgHandler(Window : HWnd; Message : Word;
                       wParam : Word; lParam : LongInt) : LongInt; export;
begin
  case Message of
    wm_char        : MessageBeep(0);
    wm_LButtonDown : MessageBox(0,'Left button','Mouse',MB_OK);
    wm_Command     : begin
      case WParam of
	cm_About:   ShellAbout(0,'Hooked CRT#Public Domain by Cedar Island Software','', appIcon);
	cm_Exit:    MyDoneWinCRT;
      end;
    end;
  end;
  NewMsgHandler := CallWindowProc(OldCRTProc, Window, Message, wParam, lParam);
end;

procedure FindWindowHandle;
begin
  ClrScr;   {force active window}
  hHookedWnd := GetActiveWindow;
end;

procedure myInitWinCRT;
var
  Menu      : HMenu;
  FileMenu  : HMenu;
begin
  cmdShow := sw_ShowNormal;
  InitWinCrt;
  FindWindowHandle;
  OldCRTProc := TFarProc(GetWindowLong(hHookedWnd, gwl_WndProc));
  NewCrtProc := MakeProcInstance(@NewMsgHandler, hInstance);
  SetWindowLong(hHookedWnd, gwl_WndProc, LongInt(NewCrtProc));
  Menu := CreateMenu;
  FileMenu := CreateMenu;
  AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
  AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
  AppendMenu(Menu, mf_Enabled, cm_About, 'About');
  SetMenu(hHookedWnd,Menu);
  SetWindowText(hHookedWnd,'Test Sub-Classed WinCRT');
  appIcon:=LoadIcon(0,IDI_Exclamation);
  SetClassWord(hHookedWnd,gcw_hIcon, appIcon);
end;

procedure myDoneWinCrt;
begin
  DoneWinCrt;
  FreeProcInstance(NewCrtProc);
end;

procedure DoTest;
var
  Name    : String;
begin
  LoadString(GetModuleHandle('USER'),514,@Name[1],79);
  Name[0]:=Char(LStrLen(@Name[1]));
  Writeln('Hello ',Name);
  Writeln('Welcome to Subclassed WinCRT World!');
  readln;
end;

begin
  myInitWinCrt;
  DoTest;
  myDoneWinCrt;
end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]