The Mother of All Windows Books/CD-MOM.iso/cd_mom/newsletr/vbz/vbz1-3/dll_src.exe/MWATCH.PAS

Pascal/Delphi Source File | 1993-02-25 | 5KB | 174 lines

library MWatch;
{DLL to Support Status bar help in Visual Basic}
{Copyright 1993 Jonathan Zuck & User Friendly, Inc.}

{$C Fixed Permanent}
{$R MWATCH}

uses WinTypes, WinProcs, VBAPI2;

type
    WinInfo = Record
       hWatch:hWnd;
       hTell:hWnd;
    Old:hWnd;
    DefProc:TFarProc;
  end;

var
  WinArray: array [1..1024] of WinInfo;
  TWins:Integer;
  SaveExit:Pointer;
  Menu:Integer;
  PopUp:Bool;

function Wnd2El (Wnd:HWND):Integer;
    Var
      El:Integer;
    Match:Bool;
    Begin
      El := 0;
    Match := FALSE;
    While (Match = FALSE) do
        Begin
          Inc (El);
        if (WinArray[El].hWatch = Wnd) then Match := TRUE;
      end;
    Wnd2El := El;
  end;

procedure RemoveEl (El:Integer);
    Begin
      SetWindowLong (WinArray[El].hWatch, GWL_WNDPROC, LongInt (WinArray[El].DefProc));
       Move (WinArray[El + 1].hWatch, WinArray[El].hWatch,
          SizeOf (WinInfo) * (TWins - El));
    Dec (TWins);
    end;


function FrameProc (Wnd:HWND; Msg, wParam:WORD; lParam:Longint):longint;export;
    var
      El:Integer;

    begin
        El := Wnd2El(Wnd);
    if (Msg = WM_DESTROY) then
        Begin
               FrameProc := CallWindowProc (WinArray[El].DefProc, Wnd, Msg, wParam, lParam);
            RemoveEl (El);
      end
      else
        Case (Msg) of
            WM_SETCURSOR:
          Begin
                     FrameProc := CallWindowProc (WinArray[El].DefProc, Wnd, Msg, wParam, lParam);
                 if WinArray[El].Old <> wParam then
                Begin
                      SendMessage (WinArray[El].hTell, WM_KEYDOWN, wParam, 0);
                        WinArray[El].Old := wParam;
              end;
          end;
         WM_MENUSELECT:
              Begin
                  WinArray[El].Old := 0;
                   if (Integer (LoWord(lParam)) <> -1)  And
                     Bool(Not Bool((LoWord(lParam) And MF_SYSMENU))) then
                    Begin
                    if Bool (LoWord(lParam) And MF_POPUP)
                        then PopUp := True
                    else
                        PopUp := False;
                        Menu := HiWord(lParam);
                          SendMessage (WinArray[El].hTell, WM_KEYDOWN, -1 * wParam, 0);
                  end;
                         FrameProc := CallWindowProc (WinArray[El].DefProc, Wnd, Msg, wParam, lParam);
              end;
         Else
                     FrameProc := CallWindowProc (WinArray[El].DefProc, Wnd, Msg, wParam, lParam);
        end;
    end;

procedure StartMouseWatch (hWatch, hTell:hWnd);export;
  begin
      Inc (TWins);
    WinArray[TWins].hWatch := hWatch;
    WinArray[TWins].hTell := hTell;
    WinArray[TWins].Old := 0;
    WinArray[TWins].DefProc := TFarProc(GetWindowLong (hWatch, GWL_WNDPROC));
    SetWindowLong (hWatch, GWL_WNDPROC, Longint (@FrameProc));
  end;

procedure StopMouseWatch (Wnd:hWnd);export;
    Begin
      RemoveEl (Wnd2El (Wnd));
  end;

function HWndTag (Wnd:HWND):HLSTR;export;
Var
  StdPropIndex:Integer;
  TempHsz:HSZ;
  CtlTemp:HCTL;
  TempStr:PChar;

Begin
  CtlTemp := VBGetHwndControl (Wnd);
  if CtlTemp = nil then CtlTemp := VBGetHwndControl (GetParent (Wnd));
  StdPropIndex := GetStdPropIndex(CtlTemp, IPROP_STD_TAG);
  VBGetControlProperty (CtlTemp, StdPropIndex, @TempHsz);
  TempStr := VBLockHsz (TempHsz);
  HWndTag := VBCreateHlStr (TempStr, lstrlen(TempStr));
  VBUnLockHsz (TempHsz);
  VBDestroyHsz (TempHsz);
end;

function HWndCtlName (Wnd:HWND):HLSTR;export;
Var
  Buff: array [0..40] of Byte;
  CtlTemp:HCTL;
Begin
    CtlTemp := VBGetHwndControl (Wnd);
  if CtlTemp = nil then CtlTemp := VBGetHwndControl (GetParent (Wnd));
    VBGetControlName (CtlTemp, @Buff);
    HWndCtlName := VBCreateHlStr (@Buff, lstrlen (@Buff));
end;


function MenuCaption (MenuID:Integer):HLSTR;export;
Var
    Buff: array [0..40] of Byte;
  i: Integer;
Begin
    if PopUp then
      Begin
        i := 0;
      while GetSubMenu (Menu, i) <> MenuID do Inc (i);
          GetMenuString (Menu, i, @Buff, 40, MF_BYPOSITION);
    end
  else
     GetMenuString (Menu, MenuID, @Buff, 40, MF_BYCOMMAND);
     MenuCaption := VBCreateHlStr (@Buff, lstrlen (@Buff));
end;

procedure LibExit; far;
 var
       El:Integer;
 begin
       For El := 1 to TWins do
          SetWindowLong (WinArray[El].hWatch, GWL_WNDPROC, LongInt(WinArray[El].DefProc));
        ExitProc := SaveExit;
    end;

Exports
  FrameProc,
  StartMouseWatch resident,
  StopMouseWatch resident,
  HWndTag resident,
  HWndCtlName resident,
  MenuCaption resident;

begin
  TWins := 0;
  SaveExit := ExitProc;
  ExitProc := @LibExit;
end.