old/PAS/!SPbSTU/Kurs/procW2K2.inc

Function Alloc(cbSize:Uint32):Pointer;
var
 ret : Pointer;
begin
 Ret := nil;
 if MaxAvail >= cbSize then
   GetMem(Ret,cbSize);
 Alloc := Ret;
end;
{-------------------------------------------------------}
Function wGetWndbyhWnd(h:hWnd):PWindow;
var
 c   : PWindow;
begin
 wGetWndbyhWnd := nil;
 if h = NULL then exit;
 c := AllWindows^.Next;
 while (c <> nil) and (c^.Handle <> h) do c:=c^.next;
 wGetWndbyhWnd := c;
end; {}
{-------------------------------------------------------}
Function wGetMenuByhMenu(h:hMenu):PMenu;
var
 c   : PMenuList;
begin
 wGetMenuByhMenu := nil;
 if h = NULL then exit;
 c := AllMenus^.Next;
 while (c <> nil) and (c^.Handle <> h) do c:=c^.next;
 if c <> nil then wGetMenuByhMenu := c^.Mn;
end; {}
{-------------------------------------------------------}
Function wSendMessage(aW:PWindow;aMsg,wParam,lParam:UINT32):UINT32;
begin
 if (aW=nil) then Exit;
 wSendMessage := aW^.WClass^.WndProc(aW^.Handle,aMsg,wParam,lParam);
end;{}
{-----------------------------------}
Function wPostMessage(c:PWindow;aMsg,wParam,lParam:UINT32):UINT32;
var
 aNewMsg,cm : PMessageList;
begin
 if c=nil then Exit;
 New(aNewMsg);
 with aNewMsg^ do 
  begin
   Next:=nil;
   msg.Message := aMsg;
   msg.wParam := wParam;
   msg.lParam := lParam;
  end;
 cm := c^.Queue;
 while cm^.Next <> nil do cm:=cm^.next;
 cm^.Next := aNewMsg;
end;{}
{-------------------------------------------------------}
Procedure wGetGlobalRect(wnd:PWindow;aR:LPRECT);
var
 c : PWindow;
begin
  if (wnd = nil) or (aR = NIL) then Exit;

  aR^ := wnd^.Pos;

  c := wnd;
  while c^.Parent <> nil do
   begin
    inc(aR^.A.X,c^.Parent^.Pos.A.X);
    inc(aR^.A.Y,c^.Parent^.Pos.A.Y);
    c := c^.Parent;
   end;

 if (c^.Style AND WS_TITLE) = WS_TITLE then
    Inc(aR^.A.Y,c^.Palette^.ActTitleSize);

 if c^.Menu <> nil then
    Inc(aR^.A.Y,c^.Palette^.MenuSelSize);

  if c^.bActive then
   begin
    Inc(aR^.A.X, c^.Palette^.ActBorderSize);
    Inc(aR^.A.Y, c^.Palette^.ActBorderSize);
   end
  else
   begin
    Inc(aR^.A.X, c^.Palette^.NoActBorderSize);
    Inc(aR^.A.Y, c^.Palette^.NoActBorderSize);
   end;
end;

Procedure wGlobalToClient(aH:PWindow;aX,aY:INT16;aR:LPPOINT);
var
 gR : RECT;
begin
 wGetGlobalRect(aH,@gR);
 if aR = nil then exit;
 aR^.X := aX-gR.A.X;
 aR^.Y := aY-gR.A.Y;
end;

Function wGetClass(var aName:string):PClass;
var
 c : UInt16;
begin
 wGetClass := nil;
 if ClassesCnt = 0 then exit;
 for c := 0 to ClassesCnt-1 do if AllClasses^[c].Name^ = aName then
  begin
   wGetClass := @AllClasses^[c];
   exit;
  end;
end;{}
{-------------------------------------------------------}
Procedure wSetTopMost(aWindow:PWindow);
var
 c : PWindow;
begin
 c := TopMost;

 if TopMost^.zOrder <> nil then TopMost^.zOrder^.bActive := false;
 aWindow^.bActive := true;

 while (c^.zOrder <> aWindow) and (c^.zOrder <> nil) do c:=c^.zOrder;
 if c^.zOrder <> nil then
   c^.zOrder := aWindow^.zOrder;

 aWindow^.zOrder := Topmost^.zOrder;
 TopMost^.zOrder := aWindow;
end;
{--------------------------------}
Function wWindowFromPoint(aP:POINT):PWindow;
var
 c : PWindow;
begin
  wWindowFromPoint := nil;
  c := TopMost^.NEXT;
  while (c<>NIL) do
   begin
    with c^.Pos do 
     if (aP.X>=A.X) AND (aP.X<=(B.X+A.X)) AND (aP.Y>=A.Y) AND (aP.Y<=(B.Y+A.Y)) then
      begin
        wWindowFromPoint := c;
        Exit;
      end;
    c:=c^.zOrder;
   end;
end; {WindowFromPoint}
{-----------------------------------}
Function wChildWindowFromPoint(aParent:PWindow;aP:POINT):PWindow;
var
 c  : PWindow;
 RT : RECT;
begin
  wChildWindowFromPoint := aParent;
  if aParent=nil then Exit;

  c:=aParent^.Child^.Brother;
  while (c<>NIL) do
   begin
    wGetGlobalRect(c,@RT);
    with RT do
     if (aP.X>=A.X) AND (aP.X<=(B.X+A.X)) AND (aP.Y>=A.Y) AND (aP.Y<=(B.Y+A.Y)) then
      begin
        wChildWindowFromPoint := c;
        Exit;
      end;
    c:=c^.Brother;
   end;
end; {wChildWindowFromPoint}
{-----------------------------------}
Procedure wRenderHorizMenu(aW:PWindow);
begin
end;
{--------------------------------}
Procedure wRenderBG(aW:PWindow);
var
 CR : RECT;
 CP : TPalette;
begin
 CR := aW^.Pos;
 CP := aW^.Palette^;
 SetFillStyle(CP.ThreeDStyle,CP.ThreeDColor1);
 SetColor(CP.ThreeDColor2);
 Bar(CR.A.X,CR.A.Y,CR.A.X+CR.B.X,CR.A.Y+CR.B.Y);
end;
{--------------------------------}
Procedure wRenderFrame(aW:PWindow);
var
 i,Tst,Tfn,Tfc,Tfs,Tcl,Tsz,Bs  : INT16;
 CP : TPalette;
 CR : RECT;
begin
 CP := aW^.Palette^;
 CR := aW^.Pos;

 inc(CR.B.X,CR.A.X-1);
 inc(CR.B.Y,CR.A.Y-1);

{ SetFillStyle(CP.ThreeDStyle,CP.ThreeDColor1);
 SetColor(CP.ThreeDColor2);
 Bar(CR.A.X,CR.A.Y,CR.B.X,CR.B.Y);}

 if aW^.bActive then
 begin
  SetColor(CP.ActBorderColor);
  Bs   := CP.ActBorderSize;
  Tst := CP.ActTitleStyle;
  Tsz := CP.ActTitleSize;
  Tcl := CP.ActTitleColor;
  Tfn := CP.ActTitleFont;
  Tfs := CP.ActTitleFontSize;
  Tfc := CP.ActTitleFontColor;
 end else
  begin
   SetColor(CP.NoActBorderColor);
   Bs   := cp.NoActBorderSize;
   Tst := CP.NoActTitleStyle;
   Tsz := CP.NoActTitleSize;
   Tcl := CP.NoActTitleColor;
   Tfn := CP.NoActTitleFont;
   Tfs := CP.NoActTitleFontSize;
   Tfc := CP.NoActTitleFontColor;
  end;
 for i:=0 to Bs-1 do
  Rectangle(CR.A.X+i,CR.A.Y+i,CR.B.X-i,CR.B.Y-i);

 if (aW^.Style AND WS_TITLE) = WS_TITLE then
  begin
    SetFillStyle(TSt,Tcl);
    SetColor(CP.ThreeDColor1);
    Bar(CR.A.X+Bs ,CR.A.Y+Bs+1, CR.B.X-Bs, CR.A.Y+Tsz-Bs-1);
    SetColor(CP.ThreeDColor1);
    Line(CR.A.X+Bs ,CR.A.Y+Bs, CR.B.X-Bs, CR.A.Y+Bs);
    Line(CR.A.X+Bs ,CR.A.Y+Tsz+Bs, CR.B.X-Bs, CR.A.Y+Tsz+Bs);
    SetColor(Tfc);
    SetTextStyle(Tfn,HorizDir,Tfs);
    SetTextJustify(LeftText,CenterText);
    OutTextXY(CR.A.X+5,CR.A.Y+Bs+(Tsz shr 1),aW^.Title^);
    if aW^.Menu <> nil then wRenderHorizMenu(aW);
  end
end;{---}
{---------}
Procedure wSendPaint(aW:PWindow);
var
 ch : PWindow;
begin
 aW^.WClass^.WndProc(aW^.Handle,WM_PAINT,0,0);
 ch := aW^.Child^.Brother;
 while ch <> nil do
  begin
   wSendPaint(ch);
   ch:=ch^.Brother;
  end;
end;
{--------------------------------}
Procedure wRenderWindows(aW:PWindow);
begin
 if aW = nil then exit;
 wRenderWindows(aW^.zOrder);
 wRenderBG(aW);
 wRenderFrame(aW);
 wSendPaint(aW);
end;{}
{--------------------------------}
Procedure wRenderTaskbar;
begin
 
end;
{--------------------------------}
Procedure wRenderAll;
begin
HideMouse;
 ClearDevice;
 wRenderWindows(Topmost^.zOrder);
 wRenderTaskbar;
 bNeedRender := false;
ShowMouse;
end;
{--------------------------------}
Procedure wInitGlobalPalette;
begin
  with GlobalPalette do
   begin
    MenuSelSize         := 5;
    MenuSelColor        := Green;
    MenuSelFont         := DEFAULTFONT;
    MenuSelFontSize     := 1;
    MenuSelFontColor    := Black;

    ActBorderSize       := 1;
    ActBorderColor      := Green;

    NoActBorderSize     := 1;
    NoActBorderColor    := White;

    ActTitleStyle       := SolidFill;
    ActTitleSize        := 15;
    ActTitleColor       := Magenta;
    ActTitleFont        := DEFAULTFONT;
    ActTitleFontSize    := 1;
    ActTitleFontColor   := Black;

    NoActTitleStyle     := CloseDotFill;
    NoActTitleSize      := 15;
    NoActTitleColor     := Magenta;
    NoActTitleFont      := DEFAULTFONT;
    NoActTitleFontSize  := 1;
    NoActTitleFontColor := White;

    WindowBGColor       := DarkGray;
    WindowStyle         := SolidFill;
    WindowFontColor     := White;

    ThreeDColor1        := LightGray;
    ThreeDColor2        := DarkGray;
    ThreeDStyle         := SolidFill;
   end;
end;

Procedure wInitFonts;
var
 DirInfo : SearchRec;
 i       : UINT16;
begin
 FontCount := 5;
 FindFirst('*.CHR', Archive, DirInfo);
 while DosError = 0 do
 begin
   Inc(FontCount);
   FindNext(DirInfo);
 end;
 AllFonts := Alloc(Sizeof(TFontDef) * FontCount);
 AllFonts^[0].aName := Alloc(30);
 AllFonts^[0].aName^ := 'Default';
 AllFonts^[0].wFont := DefaultFont;

 AllFonts^[1].aName := Alloc(30);
 AllFonts^[1].aName^ := 'Triplex';
 AllFonts^[1].wFont := TriplexFont;

 AllFonts^[2].aName := Alloc(30);
 AllFonts^[2].aName^ := 'Small';
 AllFonts^[2].wFont := SmallFont;

 AllFonts^[3].aName := Alloc(30);
 AllFonts^[3].aName^ := 'SansSerif';
 AllFonts^[3].wFont := SansSerifFont;

 AllFonts^[4].aName := Alloc(30);
 AllFonts^[4].aName^ := 'Gothic';
 AllFonts^[4].wFont := GothicFont;

 i := 5;
 FindFirst('*.CHR', Archive, DirInfo);
 while DosError = 0 do
 begin
   AllFonts^[i].aName := Alloc(ord(Dirinfo.Name[0])+1);
   AllFonts^[i].aName^ := Dirinfo.Name;
   AllFonts^[i].wFont := InstallUserFont(DirInfo.Name);
   FindNext(DirInfo);
   INc(i);
 end;
end;
{--------------------------------}
Var
 AllKeys         : PKeyTable;
 KeyActive       : PWindow;
 gActiveParent   : PWindow;
 gLastWindow     : PWindow;
 gActiveWindow   : PWindow;

Procedure ProcessKeyboard;
var
 i : EScanCode;
 pr: boolean;
begin
  while GetScanCode(i,pr) do
   begin
     if KeyActive <> nil then 
      if pr then wPostMessage(KeyActive,WM_KEYDOWN,ord(i),UINT32(GetChar(ord(i))))
        else wPostMessage(KeyActive,WM_KEYUP,ord(i),UINT32(GetChar(ord(i))))
   end;
end;
{-------------------------------------------------------}
Procedure wPosTitleButtons(mNew:PWindow);
var 
 gH : HWND;
 gW : PWindow;
 Txt: string;
begin
  if (mNew^.Style AND WS_TITLE) = WS_TITLE then
    begin
     Txt := 'CLOSEBUTTON';
     gH:=  FindChildWindow(mNew^.Handle,nil,@Txt);
     gW := wGetWndByHWND(gH);
     if gW <> nil then with gW^.Pos do
     begin
       A.X := mNew^.Pos.B.X-mNew^.Palette^.ActTitleSize-2;
       A.Y := -mNew^.Palette^.ActTitleSize+2;
       B.X := mNew^.Palette^.ActTitleSize-5;
       B.Y := mNew^.Palette^.ActTitleSize-5;
     end;

     if (mNew^.Style AND WS_MINMAX) = WS_MINMAX then
      begin
         Txt := 'MINBUTTON';
         gH:=FindChildWindow(mNew^.Handle,nil,@Txt);
         gW := wGetWndByHWND(gH);
         if gW <> nil then with gW^.Pos do
         begin
           A.X := mNew^.Pos.B.X-3*mNew^.Palette^.ActTitleSize-2;
           A.Y := -mNew^.Palette^.ActTitleSize+2;
           B.X := mNew^.Palette^.ActTitleSize-5;
           B.Y := mNew^.Palette^.ActTitleSize-5;
         end;
         Txt := 'MAXBUTTON';
         gH:=FindChildWindow(mNew^.Handle,nil,@Txt);
         gW := wGetWndByHWND(gH);
         if gW <> nil then with gW^.Pos do
         begin
           A.X := mNew^.Pos.B.X-2*mNew^.Palette^.ActTitleSize-4;
           A.Y := -mNew^.Palette^.ActTitleSize+2;
           B.X := mNew^.Palette^.ActTitleSize-5;
           B.Y := mNew^.Palette^.ActTitleSize-5;
         end;
      end;
    end;
end;
var
 gMouseState     : PMouseState;
 gLastMouseState : TMouseState;
 gMove           : Boolean;
 gwMove,gwSize   : Boolean;
 gReSize         : Boolean;
 gDir            : UINT8;
 gSize           : RECT;

Procedure ProcessMouse;
var
  aH    : HWND;
  aP,nP : POINT;
  RT    : RECT;
begin
 getMouseState(gMouseState^);
 aP.X := gMouseState^.X;
 aP.Y := gMouseState^.Y;

 if (gLastMouseState.X <> aP.X) or
    (gLastMouseState.Y <> aP.Y) then
 begin
   if gMove or gResize then
    begin
     SetWriteMode(XORPut);
     SetColor(White);
     HideMouse;
     with gSize do
     begin
       Rectangle(A.X,A.Y,A.X+B.X-1,A.Y+B.Y-1);
       if gMove then
        begin
         inc(A.X,aP.X-gLAstMouseState.X);
         inc(A.Y,aP.Y-gLAstMouseState.Y);
        end;
       if gReSize then
        begin
         if (gDir AND 1) = 1 then
          begin
           inc(A.Y,aP.Y-gLAstMouseState.Y);
           dec(B.Y,aP.Y-gLAstMouseState.Y);
          end;
         if (gDir AND 2) = 2 then
           inc(B.X,aP.X-gLAstMouseState.X);

         if (gDir AND 8) = 8 then
          begin
           inc(A.X,aP.X-gLAstMouseState.X);
           dec(B.X,aP.X-gLAstMouseState.X);
          end;
         if (gDir AND 4) = 4 then
           inc(B.Y,aP.Y-gLAstMouseState.Y);
        end;
       Rectangle(A.X,A.Y,A.X+B.X-1,A.Y+B.Y-1);
       ShowMouse;
       SetWriteMode(NormalPut);
     end;
    end
   else
   begin
   if gActiveParent <> nil then
    begin
     RT := gActiveParent^.Pos;
     inc(RT.B.X,RT.A.X-1);
     inc(RT.B.Y,RT.A.Y-1);
     with RT do
      if not ((aP.X>=A.X) AND (aP.X<=B.X) AND (aP.Y>=A.Y) AND (aP.Y<=B.Y)) then
      begin
        wPostMessage(gActiveParent,WM_MOUSEOUT,0,UINT32(aP.Y) shl 16 + aP.x);
        gActiveParent := NIL;
      end
    end;

    if gActiveParent = NIL then 
     begin
       gActiveParent := wWindowFromPoint(aP);       
       SetMouseShape(AllCursors^[0].HotX,AllCursors^[0].HotY,@AllCursors^[0].AndMask);
       wPostMessage(gActiveParent,WM_MOUSEIN,0,UINT32(aP.Y) shl 16 + aP.x);
     end;

    if gActiveParent <> nil then
    begin
      gActiveWindow := wChildWindowFromPoint(gActiveParent,aP);
      wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
      if gActiveWindow <> gLastWindow then
       begin
        if gLastWindow <> nil then 
          wPostMessage(gLastWindow,WM_MOUSEOUT,0,UINT32(aP.Y) shl 16 + aP.x);
        wPostMessage(gActiveWindow,WM_MOUSEIN,0,UINT32(aP.Y) shl 16 + aP.x); 
        gLastWindow := gActiveWindow;
       end;
      gDir:=0;
      with gActiveParent^.Pos do
      begin
       if (aP.Y-A.Y) < gResizeThr then gDir := 1;
       if (A.X+B.X-1-aP.X) < gResizeThr then gDir := gDir + 2;
       if (aP.X-A.X) < gResizeThr then gDir := gDir + 8;
       if (A.Y+B.Y-1-aP.Y) < gResizeThr then gDir := gDir + 4;
      end;

     
      if gDir <> 0 then
       begin
{        if not gwSize then}
         case gDir of
          1: SetMouseShape(AllCursors^[1].HotX,AllCursors^[1].HotY,
                           @AllCursors^[1].AndMask);
          2: SetMouseShape(AllCursors^[2].HotX,AllCursors^[2].HotY,
                           @AllCursors^[2].AndMask);
          3: SetMouseShape(AllCursors^[3].HotX,AllCursors^[3].HotY,
                           @AllCursors^[3].AndMask);
          4: SetMouseShape(AllCursors^[1].HotX,AllCursors^[1].HotY,
                           @AllCursors^[1].AndMask);
          6: SetMouseShape(AllCursors^[4].HotX,AllCursors^[4].HotY,
                           @AllCursors^[4].AndMask);
          8: SetMouseShape(AllCursors^[2].HotX,AllCursors^[2].HotY,
                           @AllCursors^[2].AndMask);
          9: SetMouseShape(AllCursors^[4].HotX,AllCursors^[4].HotY,
                           @AllCursors^[4].AndMask);
          12: SetMouseShape(AllCursors^[3].HotX,AllCursors^[3].HotY,
                           @AllCursors^[3].AndMask);
         end;
        gwSize := true
       end
      else
       begin
        if gwSize then SetMouseShape(AllCursors^[0].HotX,AllCursors^[0].HotY,
                                     @AllCursors^[0].AndMask);
        gwSize := false;
        gwMove := (aP.Y-gActiveParent^.Pos.A.Y) < gActiveParent^.Palette^.ActTitleSize;
       end;

      wPostMessage(gActiveWindow,WM_MOUSEMOVE,0,UINT32(nP.Y) shl 16 + nP.X);
    end;
   end;
 end;


 if ((gMouseState^.Buttons AND 1) = 1) AND
    ((gLastMouseState.Buttons AND 1) = 0)  then
 begin
   if (gActiveParent = nil) and (TopMost^.zOrder <> nil) then
    begin
     TopMost^.zOrder^.bActive := false;
     if KeyActive <> nil then wPostMessage(KeyActive,WM_LOSTFOCUS,0,0);
     KeyActive := nil;
     bNeedRender := true;
    end
   else
    if not gActiveParent^.bActive then
     begin
      wSetTopMost(gActiveParent);
      bNeedRender := true;
     end;
    if KeyActive <> nil then wPostMessage(KeyActive,WM_LOSTFOCUS,0,0);
    KeyActive := gActiveWindow;
    wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
    wPostMessage(gActiveWindow,WM_LBUTTONDOWN,0,UINT32(nP.Y) shl 16 + nP.X);

    if gwSize or gwMove then
    begin
     gReSize := gwSize;
     if not gResize then gMove := gwMove;
     gSize:=gActiveParent^.Pos;
     SetWriteMode(XORPut);
     SetColor(White);
     HideMouse;
     with gSize do
       Rectangle(A.X,A.Y,A.X+B.X-1,A.Y+B.Y-1);
     ShowMouse;
     SetWriteMode(NormalPut);
    end;
 end;

 if ((gMouseState^.Buttons AND 1) = 0) AND
    ((gLastMouseState.Buttons AND 1) = 1) then
 begin
   if gActiveParent <> nil then
    begin
     wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
     wPostMessage(gActiveWindow,WM_LBUTTONUP,0,UINT32(nP.Y) shl 16 + nP.X);
    end;
   if gResize or gMove then
   begin
    SetWriteMode(XORPut);
    SetColor(White);
    HideMouse;
    with gSize do
      Rectangle(A.X,A.Y,A.X+B.X-1,A.Y+B.Y-1);
    SetWriteMode(NormalPut);
    ShowMouse;
    gActiveParent^.Pos := gSize;
    wPosTitleButtons(gActiveParent);
    wPostMessage(gActiveParent,WM_SIZE,UINT32(gSize.A),UINT32(gSize.B));
    bNeedRender := true;
    gResize := false;
    gMove   := false;
   end;
 end;

 if ((gMouseState^.Buttons AND 2) = 2) AND
    ((gLastMouseState.Buttons AND 2) = 0)  then
 begin
   if (gActiveParent = nil) and (TopMost^.zOrder <> nil) then
    begin
     TopMost^.zOrder^.bActive := false;
     KeyActive := nil;
     bNeedRender := true;
    end
   else
    if not gActiveParent^.bActive then
    begin
       wSetTopMost(gActiveParent);
       bNeedRender := true;
    end;
    KeyActive := gActiveWindow;
    wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
    wPostMessage(gActiveWindow,WM_RBUTTONDOWN,0,UINT32(nP.Y) shl 16 + nP.X);
 end;

 if ((gMouseState^.Buttons AND 2) = 0) AND
    ((gLastMouseState.Buttons AND 2) = 2) AND
    (gActiveParent <> nil) then
 begin
    wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
    wPostMessage(gActiveWindow,WM_RBUTTONUP,0,UINT32(nP.Y) shl 16 + nP.X);
 end;

 if ((gMouseState^.Buttons AND 4) = 4) AND
    ((gLastMouseState.Buttons AND 4) = 0)  then
 begin
   if (gActiveParent = nil) and (TopMost^.zOrder <> nil) then
    begin
     TopMost^.zOrder^.bActive := false;
     KeyActive := nil;
     bNeedRender := true;
    end
   else
    if not gActiveParent^.bActive then
    begin
       wSetTopMost(gActiveParent);
       bNeedRender := true;
    end;
    KeyActive := gActiveWindow;
    wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
    wPostMessage(gActiveWindow,WM_MBUTTONDOWN,0,UINT32(nP.Y) shl 16 + nP.X);
 end;

 if ((gMouseState^.Buttons AND 4) = 0) AND
    ((gLastMouseState.Buttons AND 4) = 4) AND
    (gActiveParent <> nil) then
 begin
    wGlobalToClient(gActiveWindow,aP.X,aP.Y,@nP);
    wPostMessage(gActiveWindow,WM_MBUTTONUP,0,UINT32(nP.Y) shl 16 + nP.X);
 end;

 gLastMouseState := gMouseState^;
end;
{-------------------------------------------------------}
Function wInitKeyboard:UInt16;
begin
 AllKeys := InitKeyboard;
 KeyActive := nil;
 wInitKeyboard := ERR_OK;
end;
{-------------------------------------------------------}
Function wInitMouse:UInt16;
begin
  gActiveParent := nil;
  gActiveWindow := nil;
  if InitMouse(gMouseState) then
  begin
   wInitMouse := ERR_OK;
   ShowMouse;
  end
  else
   wINitMouse := ERR_ERROR;
end;

Procedure wLoadCursors;
var
 i : UINT16;
 F : FILE;

begin
 Assign(F,'cursors.cur');
 {$I-}
   Reset(F,1);
   if IOResult <> 0 then Exit;
 {$I+}
 BlockRead(F,CursorCnt,2);
 if CurSorCnt <> 0 then
  begin
   AllCursors := Alloc(SizeOf(TCursor)*CursorCNT);
   for i := 0 to CursorCnt-1 do BlockRead(F,AllCursors^[i],Sizeof(TCursor));
  end;
 Close(F);
end;

Var
 ScrMaxX, ScrMaxY : INT16;
 grDriver, grMode : INT16;

Function wInitGraph:UInt16;
begin
 grDriver := Detect;
 grMode := 0;
 {$L EGAVGA.OBJ}
 RegisterBGIDriver(@EGAVGADriver);
 InitGraph(grDriver,grMode,'');
 if GraphResult = GrOK then
  begin
    ScrMaxX := GetMaxX;
    ScrMaxY := GetMaxY;
    ClearDevice;
    wLoadCursors;
    wInitGraph := ERR_OK;
  end
 else
  wInitGraph := ERR_ERROR;
end;

Function wDestroyWindow(Wnd:PWindow):INT16;
var
 c     : PWindow;
 q     : PMessageList;
begin
 c:=AllWindows;
 while (c^.Next <> nil) and (c^.Next <> wnd) do c:=c^.next;
 if c^.next = wnd then c^.Next:=wnd^.next;

 if wnd^.Parent <> nil then
  begin
   c:=wnd^.Parent^.Child;
   while (c^.Brother <> nil) and (c^.Brother <> wnd) do c:=c^.Brother;
   if c^.Brother = wnd then c^.Brother := wnd^.Brother;
  end
 else
  begin
   c:=TopMost;
   while (c^.zOrder <> nil) and (c^.zOrder <> wnd) do c:=c^.zOrder;
   if c^.zOrder = wnd then c^.zOrder:=wnd^.zOrder;
  end;
 c:=Wnd^.Child^.Brother;
 while c <> nil do
 begin
   c^.Parent := nil;
   wSendMessage(c,WM_DESTROY,0,0);
   c := C^.Brother;
 end;
  with wnd^ do
   begin
    FreeMem(Title,ord(Title^[0])+1);
    Dispose(Palette);
    while Queue <> nil do
      begin
       q := Queue^.Next;
       Dispose(Queue);
       Queue := q;
      end;
   end;
  if gActiveParent = wnd then
   gActiveParent := nil;
  if gActiveWindow = wnd then 
   gActiveWindow := nil;
  if KeyActive = wnd then
   KeyActive := nil;
  Dispose(Wnd);
end;

Function wDoneKeyboard:UInt16;
begin
 CloseKeyboard;
 wDoneKeyBoard := ERR_OK;
end;
Function wDoneMouse:UInt16;
begin
  DoneMouse;
  wDoneMouse := ERR_OK;
end;
Function wDoneGraph:UInt16;
begin
  CloseGraph;
  wDoneGraph := ERR_OK;
end;
var
 gClosePressed, gMinPressed, gMaxPressed : boolean;

Function CloseButtonProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
var
 c1,c2,bs:UINT8;
 ps  : LPPAINTSTRUCT;
 box : RECT;
begin
 case aMsg of 
   WM_CREATE:
    gClosePressed := false;
   WM_DESTROY:
    begin
      PostQuitMessage(ahWnd);
    end;
   WM_LBUTTONDOWN:
    begin
      gClosePressed := true;
      PostMessage(ahWnd,WM_PAINT,0,0);
    end;
   WM_LBUTTONUP:
    begin
      PostMessage(GetParent(ahWnd),WM_DESTROY,0,0);
      PostMessage(ahWnd,WM_PAINT,0,0);
      gClosePressed := false;
    end;
   WM_PAINT:
    begin
        ps := BeginPaint(ahWnd);
          wSetBGColor(ps,GlobalPalette.ThreeDColor1);
          wSetStyle(ps,SolidFill);
          wSetColor(ps,GlobalPalette.ThreeDColor2);
          GetClientRect(ahWnd,@box);
          wBar(ps,0,0,box.b.x,box.b.y);
          if gClosePressed then
               begin c1:=Black;c2:=White;bs:=1;end
              else
               begin c2:=Black;c1:=White;bs:=0;end;
          wLine(ps,2+bs,         2+bs, box.b.x-2+bs,box.b.y-2+bs);
          wLine(ps,box.b.x-2+bs, 2+bs, 2+bs,        box.b.y-2+bs);

          wSetColor(ps,c1);
          wLine(ps,0,0,Box.B.X-1,0);
          wLine(ps,0,0,0,Box.B.Y-1);

          wSetColor(ps,c2);
          wLine(ps,0,Box.B.Y,Box.B.X-1,Box.B.Y);
          wLine(ps,Box.B.X,0,Box.B.X,Box.B.Y);
        EndPaint(ps);
    end;
 end;
end;

Function MinButtonProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
var
 c1,c2,bs:UINT8;
 ps  : LPPAINTSTRUCT;
 box : RECT;
begin
 case aMsg of 
   WM_CREATE:
    gMinPressed := false;
   WM_DESTROY:
    begin
      PostQuitMessage(ahWnd);
    end;
   WM_LBUTTONDOWN:
    begin
      gMinPressed := true;
      PostMessage(ahWnd,WM_PAINT,0,0);
    end;
   WM_LBUTTONUP:
    begin
      PostMessage(GetParent(ahWnd),WM_MINIMIZE,0,0);
      PostMessage(ahWnd,WM_PAINT,0,0);
      gMinPressed := false;
    end;
   WM_PAINT:
    begin
        ps := BeginPaint(ahWnd);
          wSetBGColor(ps,GlobalPalette.ThreeDColor1);
          wSetStyle(ps,SolidFill);
          wSetColor(ps,GlobalPalette.ThreeDColor2);
          GetClientRect(ahWnd,@box);
          wBar(ps,0,0,box.b.x,box.b.y);

          if gMinPressed then begin c1:=Black;c2:=White;bs:=1;end
          else begin c2:=Black;c1:=White;bs:=0;end;

          wLine(ps, 2+bs, box.b.y-4+bs, box.b.x-2+bs, box.b.y-4+bs);
          wLine(ps, 2+bs, box.b.y-3+bs, box.b.x-2+bs, box.b.y-3+bs);

          wSetColor(ps,c1);

          wLine(ps,0,0,Box.B.X-1,0);
          wLine(ps,0,0,0,Box.B.Y-1);

          wSetColor(ps,c2);
          wLine(ps,0,Box.B.Y,Box.B.X-1,Box.B.Y);
          wLine(ps,Box.B.X,1,Box.B.X,Box.B.Y);
        EndPaint(ps);
    end;
 end;
end;

Function MaxButtonProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
var
 c1,c2,bs:UINT8;
 ps  : LPPAINTSTRUCT;
 box : RECT;
begin
 case aMsg of 
   WM_CREATE:
    gMaxPressed := false;
   WM_DESTROY:
    begin
      PostQuitMessage(ahWnd);
    end;
   WM_LBUTTONDOWN:
    begin
      gMaxPressed := true;
      PostMessage(ahWnd,WM_PAINT,0,0);
    end;
   WM_LBUTTONUP:
    begin
      PostMessage(GetParent(ahWnd),WM_MAXIMIZE,0,0);
      PostMessage(ahWnd,WM_PAINT,0,0);
      gMaxPressed := false;
    end;
   WM_PAINT:
    begin
        ps := BeginPaint(ahWnd);
          wSetBGColor(ps,GlobalPalette.ThreeDColor1);
          wSetStyle(ps,SolidFill);
          wSetColor(ps,GlobalPalette.ThreeDColor2);
          GetClientRect(ahWnd,@box);

          if gMaxPressed then
           begin
            c1:=Black;c2:=White;
            bs:=1;
           end
          else
           begin
            c2:=Black;c1:=White;
            bs:=0;
           end;
          wBar(ps,0,0,box.b.x,box.b.y);
          wRectangle(ps,2+bs,2+bs,box.b.x-2+bs,box.b.y-2+bs);
          wLine(ps,3+bs,3+bs,box.b.x-3+bs,3+bs);

          wSetColor(ps,c1);

          wLine(ps,0,0,Box.B.X-1,0);
          wLine(ps,0,0,0,Box.B.Y-1);

          wSetColor(ps,c2);
          wLine(ps,0,Box.B.Y,Box.B.X-1,Box.B.Y);
          wLine(ps,Box.B.X,0,Box.B.X,Box.B.Y);
        EndPaint(ps);
    end;
 end;
end;

const
 gStartTaskButton : INT16 = 100;
 gTimeSize        : INT16 = 100;

Function TaskbarProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
var
 c1,c2,bs:UINT8;
 ps  : LPPAINTSTRUCT;
 box : RECT;
begin
 case aMsg of 
   WM_DESTROY:
    begin
      PostQuitMessage(ahWnd);
    end;
   WM_LBUTTONDOWN:
    begin
      gMaxPressed := true;
      PostMessage(ahWnd,WM_PAINT,0,0);
    end;
   WM_LBUTTONUP:
    begin
      PostMessage(GetParent(ahWnd),WM_MAXIMIZE,0,0);
      PostMessage(ahWnd,WM_PAINT,0,0);
      gMaxPressed := false;
    end;
   WM_PAINT:
    begin
        ps := BeginPaint(ahWnd);
          wSetBGColor(ps,GlobalPalette.ThreeDColor1);
          wSetStyle(ps,SolidFill);
          wSetColor(ps,GlobalPalette.ThreeDColor2);
          GetClientRect(ahWnd,@box);

          if gMaxPressed then
           begin
            c1:=Black;c2:=White;
            bs:=1;
           end
          else
           begin
            c2:=Black;c1:=White;
            bs:=0;
           end;
          wBar(ps,0,0,box.b.x,box.b.y);
          wRectangle(ps,2+bs,2+bs,box.b.x-2+bs,box.b.y-2+bs);
          wLine(ps,3+bs,3+bs,box.b.x-3+bs,3+bs);

          wSetColor(ps,c1);

          wLine(ps,0,0,Box.B.X-1,0);
          wLine(ps,0,0,0,Box.B.Y-1);

          wSetColor(ps,c2);
          wLine(ps,0,Box.B.Y,Box.B.X-1,Box.B.Y);
          wLine(ps,Box.B.X,0,Box.B.X,Box.B.Y);
        EndPaint(ps);
    end;
 end;
end;

Procedure wInitTitleButtons;
begin
 RegisterClass('CLOSEBUTTON',CloseButtonProc);
 RegisterClass('MINBUTTON',MinButtonProc);
 RegisterClass('MAXBUTTON',MaxButtonProc);
end;

{-----------------------------------}