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; {-----------------------------------}