// **************************************************************************** // // ** ** // // ** Class : cMenu ** // // ** ** // // ** Purpose : cToolbar subclass for use with rebar ** // // ** ** // // ** Author : Ulbe Stellema ** // // ** Data Access Worldwide ** // // ** ** // // ** Date : March 1, 2000 ** // // ** ** // // **************************************************************************** // Use cToolbar.pkg Use cMenuButton.pkg Class cMenu Is A cToolbar // Procedure : Construct_Object // Purpose : Object constructor Procedure Construct_Object Integer iMessage Forward Send Construct_Object Property Integer piMsgMsg 0 Property Integer piWndMsg 0 Property Integer piMsgHook 0 Property Integer piWndHook 0 Property Integer Private.ProcessLeftArrow True Property Integer Private.ProcessRightArrow True Property Integer Private.EscapePressed False Property Integer Private.TrackingState TRACK_NONE // Tracking state Property Integer Private.PopupTracking -1 Property Integer Private.MenuTracking 0 Property Integer Private.MenuIdTracking 0 Property Integer Private.NewPopup -1 Property Integer Private.MouseX 0 Property Integer Private.MouseY 0 // MDI properties Property Boolean Private.pbMDIButtons False Property Integer Private.piPushedButton 0 Property Handle Private.phMDIDialog 0 Property Boolean Private.pbRowAdded False // Register a windows message to be used with the windows hook Move (RegisterWindowMessage("DF_MSGMSG")) To iMessage Set piMsgMsg To iMessage Move (RegisterWindowMessage("DF_WNDMSG")) To iMessage Set piWndMsg To iMessage // External messages Set External_Message (piMsgMsg(Self)) To msg_OnMsgHook Set External_Message (piWndMsg(Self)) To msg_OnWndHook Set External_Message WM_COMMAND To msg_Command Set External_Message WM_CONTEXTMENU To msg_Mouse_Down2 Set Extended_Window_Style To WS_EX_TOOLWINDOW True //Set Window_Style To TBSTYLE_TRANSPARENT True //Set Window_Style To TBSTYLE_WRAPABLE True //Set Window_Style To CCS_NODIVIDER True //Set Window_Style To CCS_NOPARENTALIGN True //Set Window_Style To CCS_NORESIZE True //Set Window_Style To CCS_TOP True End_Procedure // Construct_Object // Procedure : Resize // Purpose : Handles toolbar wrapping and adds space for MDI buttons Procedure Resize Integer iResult iPos iWidth iHeight iButton iMask Integer iBarWidth iBandWidth iRows Integer iLeft iTop iRight iBottom String sRebarInfo sRect Handle hRebar // Get width of MDI buttons Move (GetSystemMetrics(SM_CXSIZE) - 2) To iWidth Move (GetSystemMetrics(SM_CYSIZE) - 4) To iHeight Move (iWidth * 3 + 2) To iWidth // Get window handle of band Delegate Get Window_Handle To hRebar Get Private.IdToIndex (Parent(Self)) To iPos // Get width of toolbar ZeroType tRECT To sRect Get NumberOfButtons To iButton Move (SendMessage(Window_Handle(Self),TB_GETITEMRECT,iButton-1,AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.left To iLeft GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.bottom To iBottom Move (iRight+2) To iBarWidth // Calculate width of the rebar window ZeroType tRECT To sRect Move (GetClientRect(Window_Handle(Parent(Self)),AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.left To iLeft Move (iRight-iLeft) To iBandWidth // Get height of toolbar Move (SendMessage(Window_Handle(Self),TB_GETBUTTONSIZE,0,0)) To iHeight Move (SendMessage(Window_Handle(Self),TB_GETROWS,0,0)) To iRows // Calculate new height of toolbar If (Private.pbMDIButtons(Self)) ; If (iBarWidth+iWidth+9 > iBandWidth) Move (iRows+1) To iRows Move (iRows*Hi(iHeight)) To iHeight Move (iBandWidth) To iWidth // Set new height of toolbar Set GUISize To iHeight iWidth // Set new height of rebar band Move (Window_Handle(Parent(Parent(Self)))) To hRebar Move (RBBIM_CHILDSIZE iOr RBBIM_IDEALSIZE iOr RBBIM_SIZE) To iMask ZeroType REBARBANDINFO To sRebarInfo Put REBARBANDINFO_Size To sRebarInfo at REBARBANDINFO.cbSize Put iMask To sRebarInfo at REBARBANDINFO.fMask Put (iWidth) To sRebarInfo At REBARBANDINFO.cxMinChild Put iHeight To sRebarInfo At REBARBANDINFO.cyMinChild Put iHeight To sRebarInfo At REBARBANDINFO.cyChild Put iHeight To sRebarInfo At REBARBANDINFO.cyMaxChild Put 1 To sRebarInfo At REBARBANDINFO.cyIntegral Put (iWidth) To sRebarInfo At REBARBANDINFO.cxIdeal Put (iWidth) To sRebarInfo At REBARBANDINFO.cx Move (SendMessage(hRebar,RB_SETBANDINFO,iPos,AddressOf(sRebarInfo))) To iResult End_Procedure // Resize // Procedure : Notify // Purpose : Handles WM_NOTIFY Procedure Notify Integer wParam Integer lParam Returns Integer String sHeader sNonClientMetrics sOldFont sNewFont sRect sText Integer iResult iCode iStage iPos iButton Handle hOldFont hNewFont hWindow hDC hoButton Boolean bOldWrap Integer iLeft iTop iRight iBottom iHeight iWidth iRows Handle hBrush hOldBrush // This procedure is used to handle font changes in windows. // A toolbar will not react to changes to the standard menu font, this procedure // sets the font of the toolbar to the font of the menu. ZeroType NMHDR To sHeader Move (CopyMemory(AddressOf(sHeader),lParam,NMHDR_Size)) To iResult GetBuff From sHeader At NMHDR.code To iCode If (iCode = NM_CUSTOMDRAW) Begin ZeroType NMCUSTOMDRAW To sHeader Move (CopyMemory(AddressOf(sHeader),lParam,NMCUSTOMDRAW_Size)) To iResult GetBuff From sHeader At NMCUSTOMDRAW.dwDrawStage To iStage If (iStage = CDDS_PREPAINT) Begin // The resize procedure sets the new size of the menu toolbar Send Resize // // Get the menu font // ZeroType NONCLIENTMETRICS To sNonClientMetrics // Put NONCLIENTMETRICS_Size To sNonClientMetrics At NONCLIENTMETRICS.cbSize // Move (SystemParametersInfo(SPI_GETNONCLIENTMETRICS,NONCLIENTMETRICS_Size,AddressOf(sNonClientMetrics),0)) To iResult // // Get LOGFONT for new font // ZeroType LOGFONT To sNewFont // ZeroType LOGFONT To sOldFont // Offset_Of_Field NONCLIENTMETRICS.lfMenuFont To iPos // Move (Mid(sNonClientMetrics,LOGFONT_Size,iPos)) To sNewFont // // Get the currently selected font for the menu // Move (SendMessage(Window_Handle(Self),WM_GETFONT,0,0)) To hOldFont // Move (GetObject(hOldFont,LOGFONT_Size,AddressOf(sOldFont))) To iResult // // Ignore Charset member // Put 0 To sOldFont At LOGFONT.lfCharSet // Put 0 To sNewFont At LOGFONT.lfCharSet // // Change font only if needed // If (sNewFont <> sOldFont) Begin // Move (CreateFontIndirect(AddressOf(sNewFont))) To hNewFont // If (hNewFont = 0) Error 103 (FormatMessage(GetLastError())) // Only on NT/XP // Move (SendMessage(Window_Handle(Self),WM_SETFONT,hNewFont,True)) To iResult // Delegate Send Private.Resize // End // If (sNewFont <> sOldFont) Begin //If (Private.pbMDIButtons(Self)) Procedure_Return (CDRF_NOTIFYITEMDRAW) If (Private.pbMDIButtons(Self)) Begin Send DrawMinimizeButton 0 Send DrawRestoreButton 0 Send DrawCloseButton 0 End // If (Private.pbMDIButtons(Self)) Begin Procedure_Return (CDRF_DODEFAULT) End // If (iStage = CDDS_PREPAINT) Begin End // If (iCode = NM_CUSTOMDRAW) Begin End_Procedure // Notify Procedure DrawMinimizeButton Integer iState Integer iResult iPos iLeft iTop iRight iBottom Integer iWidth iHeight String sRect Handle hDC // Get DC Move (GetWindowDC(Window_Handle(Parent(Self)))) To hDC // Get rect of complete toolbar ZeroType tRECT To sRect Get Private.IdToIndex (Parent(Self)) To iPos Move (SendMessage(Window_Handle(Parent(Self)),RB_GETRECT,iPos,AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.left To iLeft GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.bottom To iBottom // Calculate width and height of buttons Move (GetSystemMetrics(SM_CXSIZE) - 2) To iWidth Move (GetSystemMetrics(SM_CYSIZE) - 4) To iHeight // DC for rebar band is 11 pixels wider Move (iRight-11) To iRight ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 2 - iHeight) To sRect at tRECT.top Put (iRight - (iWidth * 3 + 2)) To sRect at tRECT.left Put (iRight - (iWidth * 2 + 2)) To sRect at tRECT.right Move (DrawFrameControl(hDC,AddressOf(sRect),DFC_CAPTION,DFCS_CAPTIONMIN iOr iState)) To iResult //If (iResult = 0) Error 103 (FormatMessage(GetLastError())) End_Procedure // DrawMinimizeButton Procedure DrawRestoreButton Integer iState Integer iResult iPos iLeft iTop iRight iBottom Integer iWidth iHeight String sRect Handle hDC // Get DC Move (GetWindowDC(Window_Handle(Parent(Self)))) To hDC // Get rect of complete band ZeroType tRECT To sRect Get Private.IdToIndex (Parent(Self)) To iPos Move (SendMessage(Window_Handle(Parent(Self)),RB_GETRECT,iPos,AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.left To iLeft GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.bottom To iBottom // Calculate width and height of buttons Move (GetSystemMetrics(SM_CXSIZE) - 2) To iWidth Move (GetSystemMetrics(SM_CYSIZE) - 4) To iHeight // DC for rebar band is 11 pixels wider Move (iRight-11) To iRight ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 2 - iHeight) To sRect at tRECT.top Put (iRight - (iWidth * 2 + 2)) To sRect at tRECT.left Put (iRight - (iWidth + 2)) To sRect at tRECT.right Move (DrawFrameControl(hDC,AddressOf(sRect),DFC_CAPTION,DFCS_CAPTIONRESTORE iOr iState)) To iResult //If (iResult = 0) Error 103 (FormatMessage(GetLastError())) End_Procedure // DrawRestoreButton Procedure DrawCloseButton Integer iState Integer iResult iPos iLeft iTop iRight iBottom Integer iWidth iHeight String sRect Handle hDC // Get DC Move (GetWindowDC(Window_Handle(Parent(Self)))) To hDC // Get rect of complete band ZeroType tRECT To sRect Get Private.IdToIndex (Parent(Self)) To iPos Move (SendMessage(Window_Handle(Parent(Self)),RB_GETRECT,iPos,AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.left To iLeft GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.bottom To iBottom // Calculate width and height of buttons Move (GetSystemMetrics(SM_CXSIZE) - 2) To iWidth Move (GetSystemMetrics(SM_CYSIZE) - 4) To iHeight // DC for rebar band is 11 pixels wider Move (iRight-11) To iRight ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 2 - iHeight) To sRect at tRECT.top Put (iRight - iWidth) To sRect at tRECT.left Put iRight To sRect at tRECT.right Move (DrawFrameControl(hDC,AddressOf(sRect),DFC_CAPTION,DFCS_CAPTIONCLOSE iOr iState)) To iResult //If (iResult = 0) Error 103 (FormatMessage(GetLastError())) End_Procedure // DrawCloseButton // Procedure : Destroy_Object // Purpose : Object destructor Procedure Destroy_Object Integer iResult Move (UnhookWindowsHookEx(piMsgHook(Self))) To iResult Move (UnhookWindowsHookEx(piWndHook(Self))) To iResult // Destroy the VDF part of the object Forward Send Destroy_Object End_Procedure // Destroy_Object // Procedure : Set HotItem // Purpose : Sets the hot item Procedure Set HotItem Integer iItem Handle hoStatusBar hoObject Integer iResult String sHelp Move (StatusBar_Id(Self)) To hoStatusBar Move (SendMessage(Window_Handle(Self),TB_SETHOTITEM,iItem,0)) To iResult If (hoStatusBar) Begin Send Initialize_Menu To hoStatusBar Move (ObjectFromIndex(phoButtons(Self),iItem)) To hoObject If (hoObject) Begin Get psStatusHelp Of hoObject To sHelp If (sHelp <> "" And (Not(pbEnabled(hoObject)))) Move (sHelp * psShadowStatusHelp(hoObject)) To sHelp Send Show_Status_Help To hoStatusBar sHelp End // If (hoObject) Begin End // If (hoStatusBar) Begin End_Procedure // Set HotItem // Procedure : Add_Focus // Purpose : Installs a windows hook Procedure Add_Focus Integer iBase Returns Integer Handle hDLL hMessageHook hThread iVoid Handle hMsgProc hWndProc hMsgHook hWndHook Integer iResult Forward Get Msg_Add_Focus iBase To iResult // remove the TBSTYLE_EX_DRAWDDARROWS style. //Send Windows_Message TB_SETEXTENDEDSTYLE 0 0 // get thread id Move (GetCurrentThreadId()) To hThread // load 'callback' dll Move (LoadLibrary("callback.dll")) To hDLL // Get function pointers Move (GetMsgProcHandle(Window_Handle(Self),piMsgMsg(Self))) To hMsgProc Move (GetWndProcHandle(Window_Handle(Self),piWndMsg(Self))) To hWndProc // Install windows hooks Move (SetWindowsHookEx(WH_GETMESSAGE,hMsgProc,hDLL,hThread)) To hMsgHook //Move (SetWindowsHookEx(WH_SYSMSGFILTER,hMsgProc,hDLL,hThread)) To hMsgHook //Move (SetWindowsHookEx(WH_MSGFILTER,hMsgProc,hDLL,hThread)) To hMsgHook Move (SetWindowsHookEx(WH_CALLWNDPROCRET,hWndProc,hDLL,hThread)) To hWndHook // Set hook handles Move (SetMsgProcHandle(hMsgHook)) To iVoid Move (SetWndProcHandle(hWndHook)) To iVoid Set piMsgHook To hMsgHook Set piWndHook To hWndHook Procedure_Return iResult End_Procedure // Add_Focus Procedure DoTrackPopup Integer iButton Send TrackPopup iButton End_Procedure // DoTrackPopup // Procedure : MenuSelect // Purpose : Handles WM_MENUSELECT Procedure MenuSelect Integer wParam Integer lParam Returns Integer Handle hSubMenu Integer iItem If (Private.TrackingState(Self) > 0) Begin Move (Low(wParam)) To iItem Move (GetSubMenu(lParam,iItem)) To hSubMenu Set Private.ProcessRightArrow To (hSubMenu = 0) Set Private.ProcessLeftArrow To (lParam = Private.MenuTracking(Self)) End // If (Private.TrackingState(Self) > 0) Begin Procedure_Return False End_Procedure // MenuSelect // Procedure : LeftArrow // Purpose : Handles VK_LEFT key Procedure LeftArrow Integer iItem iButtons Move (SendMessage(Window_Handle(Self),TB_BUTTONCOUNT,0,0)) To iButtons Move (SendMessage(Window_Handle(Self),TB_GETHOTITEM,0,0)) To iItem If (iItem = 0) Set HotItem To (iButtons - 1) Else Set HotItem To (iItem - 1) End_Procedure // LeftArrow // Procedure : RightArrow // Purpose : Handles VK_RIGHT key Procedure RightArrow Integer iItem iButtons Move (SendMessage(Window_Handle(Self),TB_BUTTONCOUNT,0,0)) To iButtons Move (SendMessage(Window_Handle(Self),TB_GETHOTITEM,0,0)) To iItem If (iItem = (iButtons - 1)) Set HotItem To 0 Else Set HotItem To (iItem + 1) End_Procedure // RightArrow // Procedure : ToggleTrackMode // Purpose : Toggles tracking state between TRACK_BUTTON and TRACK_NONE Procedure ToggleTrackMode If (Private.TrackingState(Self) = TRACK_NONE) Send SetTrackingState TRACK_BUTTON 0 Else If (Private.TrackingState(Self) = TRACK_BUTTON) Send SetTrackingState TRACK_NONE -1 End_Procedure // ToggleTrackMode // Procedure : SetTrackingState // Purpose : This procedure is called when the tracking state changes Procedure SetTrackingState Integer iState Integer iButton Integer iResult If (iState <> Private.TrackingState(Self)) Begin If (iState = TRACK_POPUP) Begin Set Private.EscapePressed To False Set Private.ProcessRightArrow To True Set Private.ProcessLeftArrow To True Set Private.PopupTracking To iButton End // If (iState = TRACK_POPUP) Begin End // If (iState <> Private.TrackingState(Self)) Begin Set Private.TrackingState To iState If (iState = TRACK_NONE) Begin Set HotItem To -1 If (StatusBar_Id(Self)) Send Exit_Menu To (StatusBar_Id(Self)) End // If (iState = TRACK_NONE) Begin Else Set HotItem To iButton End_Procedure // SetTrackingState // Function : HitTest // Purpose : Tests if a point is located on one of the menu buttons Function HitTest Integer iX Integer iY Returns Integer Integer iResult iItem String sPoint sRect // Fill point structure ZeroType POINT To sPoint Put iX To sPoint At POINT.x Put iY To sPoint At POINT.y // Get item Move (ScreenToClient(Window_Handle(Self),AddressOf(sPoint))) To iResult Move (SendMessage(Window_Handle(Self),TB_HITTEST,0,AddressOf(sPoint))) To iItem // Get rect of toolbar window ZeroType RECT To sRect Move (GetClientRect(Window_Handle(Self),AddressOf(sRect))) To iResult // Is the point inside the toolbar window Move (PtInRect(AddressOf(sRect),BytesTodWord(sPoint,1),BytesTodWord(sPoint,5))) To iResult Function_Return (If(Not(iResult),-1,iItem)) End_Function // HitTest // Function : MDIHitTest // Purpose : Tests if a point is located on one of the MDI buttons Function MDIHitTest Integer iX Integer iY Returns Integer Integer iResult iWidth iHeight iPos Integer iLeft iTop iRight iBottom String sPoint sRect // Fill point structure ZeroType POINT To sPoint Put iX To sPoint at POINT.x Put iY To sPoint at POINT.y // Get button Move (ScreenToClient(Window_Handle(Parent(Self)),AddressOf(sPoint))) To iResult // Get rect of toolbar window ZeroType tRECT To sRect Get Private.IdToIndex (Parent(Self)) To iPos Move (SendMessage(Window_Handle(Parent(Self)),RB_GETRECT,iPos,AddressOf(sRect))) To iResult GetBuff From sRect at tRECT.left To iLeft GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.right To iRight GetBuff From sRect at tRECT.bottom To iBottom // Calculate width and height of buttons Move (GetSystemMetrics(SM_CXSIZE) - 2) To iWidth Move (GetSystemMetrics(SM_CYSIZE) - 4) To iHeight // DC for toolbar is 9 pixels wider Move (iRight-11) To iRight // Windows uses an extra pixel on each side which counts in the hit-test // Check close button ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 4 - iHeight) To sRect at tRECT.top Put (iRight - iWidth - 2) To sRect at tRECT.left Put iRight To sRect at tRECT.right Move (PtInRect(AddressOf(sRect),BytesTodWord(sPoint,1),BytesTodWord(sPoint,5))) To iResult If (iResult <> 0) Function_Return SC_CLOSE // Check restore button ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 4 - iHeight) To sRect at tRECT.top Put (iRight - (iWidth * 2 + 4)) To sRect at tRECT.left Put (iRight - (iWidth + 2)) To sRect at tRECT.right Move (PtInRect(AddressOf(sRect),BytesTodWord(sPoint,1),BytesTodWord(sPoint,5))) To iResult If (iResult <> 0) Function_Return SC_RESTORE // Check minimize button ZeroType tRECT To sRect Put (iBottom - 2) To sRect at tRECT.bottom Put (iBottom - 4 - iHeight) To sRect at tRECT.top Put (iRight - (iWidth * 3 + 4)) To sRect at tRECT.left Put (iRight - (iWidth * 2 + 2)) To sRect at tRECT.right Move (PtInRect(AddressOf(sRect),BytesTodWord(sPoint,1),BytesTodWord(sPoint,5))) To iResult If (iResult <> 0) Function_Return SC_MINIMIZE Function_Return False End_Function // MDIHitTest // Procedure : CancelMenuAndTrackNew // Purpose : Called when the menu must be cancelled Procedure CancelMenuAndTrackNew Integer iButton Integer iObject iMenu iResult Handle hMenu If (iButton <> Private.PopupTracking(Self)) Begin Move (ObjectFromIndex(phoButtons(Self),Private.PopupTracking(Self))) To iObject Get phoMenu Of iObject To iMenu Move (PostMessage(Window_Handle(iMenu),WM_CANCELMODE,0,0)) To iResult Set Private.NewPopup To iButton End // If (iButton <> Private.PopupTracking(Self)) Begin End_Procedure // CancelMenuAndTrackNew // Procedure : TrackPopup // Purpose : Called when the menu is in tracking state (hot-tracking) Procedure TrackPopup Integer iButton Integer iResult iX iY iObject iChild Integer iHeight iWidth iItemX iItemY Integer iScreenX iScreenY iItems iCount iItem Handle hToolbar hMenu String sRect sStruct While (iButton >= 0) // Assume no new popup menu to track Set Private.NewPopup To -1 // Get object id from button id Move (ObjectFromIndex(phoButtons(Self),iButton)) To iObject // Make button depressed Move (SendMessage(Window_Handle(Self),TB_PRESSBUTTON,iObject,True)) To iResult Move (UpdateWindow(Window_Handle(Self))) To iResult // Set tracking state Send SetTrackingState TRACK_POPUP iButton // Get menu Move (phoMenu(iObject)) To iChild Get Private.phMenu Of iChild To hMenu // Determine position of the menu ZeroType tRECT To sRect Move (SendMessage(Window_Handle(Self),TB_GETRECT,iObject,AddressOf(sRect))) To iResult Move (MapWindowPoints(Window_Handle(Self),0,AddressOf(sRect),2)) To iResult GetBuff From sRect At tRECT.left To iX GetBuff From sRect At tRECT.bottom To iY // Does menu fit on screen ZeroType MEASUREITEMSTRUCT To sStruct Move 0 To iHeight Move 0 To iWidth Get ItemCount Of iChild To iItems For iCount From 0 To (iItems-1) Move (ObjectFromIndex(iChild,iCount)) To iItem Put iItem To sStruct at MEASUREITEMSTRUCT.itemData Put ODT_MENU To sStruct at MEASUREITEMSTRUCT.CtlType Send MeasureItem To iChild 0 (AddressOf(sStruct)) GetBuff From sStruct at MEASUREITEMSTRUCT.itemHeight To iItemY GetBuff From sStruct at MEASUREITEMSTRUCT.itemWidth To iItemX Move (iHeight+iItemY) To iHeight If (iItemX > iWidth) Move iItemX To iWidth Loop Move (iHeight+(GetSystemMetrics(SM_CYBORDER)*2)) To iHeight Move (iWidth+(GetSystemMetrics(SM_CXBORDER)*2)) To iWidth // Get screen resolution Move (GetSystemMetrics(SM_CXSCREEN)) To iScreenX Move (GetSystemMetrics(SM_CYSCREEN)) To iScreenY // Check horizontal and vertical position If (iX+iWidth + 4 + 20 > iScreenX) Move (iScreenX - iWidth - 4 - 20) To iX If (iY+iHeight + 4 > iScreenY) Begin GetBuff From sRect At tRECT.top To iY Move (iY-iHeight - 4) To iY End // If (iY+iHeight+4 > iScreenY) Begin // Track menu Set Private.MenuTracking To hMenu Set Private.MenuIdTracking To iChild //Send OnActivate To iChild Move (TrackPopupMenuEx(hMenu,(TPM_LEFTALIGN iOr TPM_TOPALIGN iOr TPM_LEFTBUTTON iOr TPM_HORIZONTAL),iX,iY,Window_Handle(iChild),0)) To iResult If (iResult = 0) Error 103 (FormatMessage(GetLastError())) //Send OnDeactivate To iChild Set Private.MenuIdTracking To 0 Set Private.MenuTracking To 0 // Make button un-pressed Move (SendMessage(Window_Handle(Self),TB_PRESSBUTTON,iObject,False)) To iResult Move (UpdateWindow(Window_Handle(Self))) To iResult // Force repaint // Check for escape If (Private.EscapePressed(Self)) Send SetTrackingState TRACK_BUTTON iButton Else If (Private.NewPopup(Self) = -1) Send SetTrackingState TRACK_NONE iButton Else Set Private.TrackingState To TRACK_NONE Move (Private.NewPopup(Self)) To iButton End // While (iButton > = 0) End_Procedure // TrackPopup // Procedure : OnWndHook // Purpose : Handles windows hook messages Procedure OnWndHook Integer wParam Integer lParam Returns Integer Integer iResult iParam1 iMessage iObject Handle hWindow String sMsg ZeroType CWPRETSTRUCT To sMsg Move (CopyMemory(AddressOf(sMsg),lParam,CWPRETSTRUCT_Size)) To iResult GetBuff From sMsg at CWPRETSTRUCT.hwnd To hWindow GetBuff From sMsg at CWPRETSTRUCT.message To iMessage GetBuff From sMsg at CWPRETSTRUCT.wParam To iParam1 If (iMessage = WM_WINDOWPOSCHANGING) Begin Set Private.pbRowAdded To False Move (InvalidateRect(Window_Handle(Self),0,True)) To iResult End // If (iMessage = WM_WINDOWPOSCHANGING) Begin If (iMessage = WM_SIZE) Begin If (iParam1 = SIZE_MAXIMIZED) Begin Set Private.pbMDIButtons To True Set Private.phMDIDialog To hWindow End // If (iParam1 = SIZE_MAXIMIZED) Begin If (iParam1 = SIZE_RESTORED) Set Private.pbMDIButtons To False If (iParam1 = SIZE_MINIMIZED) Set Private.pbMDIButtons To False Send Resize Move (InvalidateRect(Window_Handle(Parent(Self)),0,True)) To iResult If (Private.pbMDIButtons(Self)) Begin Send DrawMinimizeButton 0 Send DrawRestoreButton 0 Send DrawCloseButton 0 End // If (Private.pbMDIButtons(Self)) Begin End // If (iMessage = WM_SIZE) Begin If (iMessage = WM_MDIDESTROY) Begin // Check if there are any activate MDI dialogs // TODO, check if this code is needed Move 0 To iResult Get Next_MDI_Dialog Of (Client_Id(Self)) True To iObject While iObject If (Active_State(iObject)) Move 1 To iResult Get Next_MDI_Dialog Of (Client_Id(Self)) False To iObject Loop // While iObject If (iResult = 0) Set Private.pbMDIButtons To False Send Resize Move (InvalidateRect(Window_Handle(Self),0,True)) To iResult End // If (iMessage = WM_MDIDESTROY) Begin If (iMessage = WM_MOUSEMOVE) //ShowLn hWindow End_Procedure // OnWndHook // Procedure : OnMsgHook // Purpose : Handles windows hook messages Procedure OnMsgHook Integer wParam Integer lParam Returns Integer Integer iResult iMessage iParam1 iParam2 iMode iItems iItem iX iY iButton Integer iObject iMenu Handle hWindow hDC hMenu hObject String sMsg sRect sPoint sWindowInfo Integer iLeft iTop iRight iBottom Move 0 To iButton // Get the message ZeroType MSG To sMsg Move (CopyMemory(AddressOf(sMsg),lParam,MSG_Size)) To iResult GetBuff From sMsg At MSG.hwnd To hWindow GetBuff From sMsg At MSG.message To iMessage GetBuff From sMsg At MSG.wParam To iParam1 GetBuff From sMsg At MSG.lParam To iParam2 Move (Private.TrackingState(Self)) To iMode Case Begin Case (iMessage = WM_SYSKEYDOWN) Case Begin Case (iParam1 = VK_MENU) // Send WM_CANCELMODE to cancel any active menu //Move (SendMessage(Window_Handle(Self),0,0)) To iResult If (StatusBar_Id(Self)) Send Exit_Menu To (StatusBar_Id(Self)) Move (EndMenu()) To iResult // User pressed ALT key while menu is active, return to TRACK_NONE If (iMode = TRACK_POPUP) Begin Set Private.EscapePressed To True Send CancelMenuAndTrackNew -1 End // If (iMode = TRACK_POPUP) Begin // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult Case Break Case (iParam1 = VK_F10) If ((GetKeyState(VK_SHIFT) iAnd |CI$8000) = False And (GetKeyState(VK_CONTROL) iAnd |CI$8000) = False) Begin // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If ((GetKeyState(VK_SHIFT) iAnd |CI$8000) = False And (GetKeyState(VK_CONTROL) iAnd |CI$8000) = False) Begin Case Break Case End Case Break Case (iMessage = WM_SYSKEYUP) Case Begin Case (iParam1 = VK_MENU) If (Private.TrackingState(Self) <> TRACK_POPUP) Send ToggleTrackMode // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult Case Break Case (iParam1 = VK_F10) If ((GetKeyState(VK_SHIFT) iAnd |CI$8000) = False And (GetKeyState(VK_CONTROL) iAnd |CI$8000) = False) Begin If (Private.TrackingState(Self) <> TRACK_POPUP) Send ToggleTrackMode // User pressed F10 while menu is active, cancel menu and return to button tracking If (iMode = TRACK_POPUP) Send CancelMenuAndTrackNew (-1) // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If ((GetKeyState(VK_SHIFT) iAnd |CI$8000) = False And (GetKeyState(VK_CONTROL) iAnd |CI$8000) = False) Begin Case Break Case End Case Break Case (iMessage = WM_KEYDOWN) Move (SendMessage(Window_Handle(Self),TB_BUTTONCOUNT,0,0)) To iItems Case Begin Case (iParam1 = VK_LEFT) If (iMode = TRACK_BUTTON) Begin Send LeftArrow // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If (iMode = TRACK_BUTTON) Begin Else If (iMode = TRACK_POPUP And Private.ProcessLeftArrow(Self)) Begin If (Private.PopupTracking(Self) = 0) Send CancelMenuAndTrackNew (iItems-1) Else Send CancelMenuAndTrackNew (Private.PopupTracking(Self)-1) End // Else If (iMode = TRACK_POPUP And Private.ProcessLeftArrow(Self)) Begin Case Break Case (iParam1 = VK_RIGHT) If (iMode = TRACK_BUTTON) Begin Send RightArrow // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If (iMode = TRACK_BUTTON) Begin Else If (iMode = TRACK_POPUP And Private.ProcessRightArrow(Self)) Begin If (Private.PopupTracking(Self) = (iItems - 1)) Send CancelMenuAndTrackNew 0 Else Send CancelMenuAndTrackNew (Private.PopupTracking(Self) + 1) End // Else If (iMode = TRACK_POPUP And Private.ProcessRightArrow(Self)) Begin Case Break Case (iParam1 = VK_UP) If (iMode = TRACK_BUTTON) Begin Move (SendMessage(Window_Handle(Self),TB_GETHOTITEM,0,0)) To iItem Send TrackPopup iItem // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If (iMode = TRACK_BUTTON) Begin Case Break Case (iParam1 = VK_DOWN) If (iMode = TRACK_BUTTON) Begin Move (SendMessage(Window_Handle(Self),TB_GETHOTITEM,0,0)) To iItem Send TrackPopup iItem // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If (iMode = TRACK_BUTTON) Begin Case Break Case (iParam1 = VK_ESCAPE) If (iMode = TRACK_BUTTON) Begin Send ToggleTrackMode // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult End // If (iMode = TRACK_BUTTON) Begin Else If (iMode = TRACK_POPUP) Set Private.EscapePressed To True Case Break Case End Case Break Case (iMessage = WM_SYSCHAR) Move (SendMessage(Window_Handle(Self),TB_MAPACCELERATOR,iParam1,AddressOf(iButton))) To iResult If (iButton <> 0) Begin Move (IndexFromObject(phoButtons(Self),iButton)) To iButton // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult Send TrackPopup iButton End // If (iButton <> 0) Begin Case Break Case (iMessage = WM_CHAR) If (iMode <> TRACK_BUTTON) Procedure_Return False Move (SendMessage(Window_Handle(Self),TB_MAPACCELERATOR,iParam1,AddressOf(iButton))) To iResult If (iButton <> 0) Begin Move (IndexFromObject(phoButtons(Self),iButton)) To iButton // Remove message from queue Put 0 To sMsg At MSG.message Move (CopyMemory(lParam,AddressOf(sMsg),MSG_Size)) To iResult Send TrackPopup iButton End // If (iButton <> 0) Begin Case Break Case (iMessage = WM_MOUSEMOVE) GetBuff From sMsg at MSG.pt.x To iX GetBuff From sMsg at MSG.pt.y To iY // Handle MDI buttons If (iMode = TRACK_NONE And Private.pbMDIButtons(Self) And Private.piPushedButton(Self)) Begin Get MDIHitTest iX iY To iButton Move (GetWindowDC(Window_Handle(Self))) To hDC If (iButton = 0) Begin If (Private.piPushedButton(Self) = SC_MINIMIZE) Send DrawMinimizeButton 0 If (Private.piPushedButton(Self) = SC_RESTORE) Send DrawRestoreButton 0 If (Private.piPushedButton(Self) = SC_CLOSE) Send DrawCloseButton 0 End // If (iButton = 0) Begin If (Private.piPushedButton(Self) <> iButton) Begin If (Private.piPushedButton(Self) = SC_MINIMIZE) Send DrawMinimizeButton 0 If (Private.piPushedButton(Self) = SC_RESTORE) Send DrawRestoreButton 0 If (Private.piPushedButton(Self) = SC_CLOSE) Send DrawCloseButton 0 End // If (Private.piPushedButton(Self) <> iButton) Begin If (Private.piPushedButton(Self) = iButton) Begin If (Private.piPushedButton(Self) = SC_MINIMIZE) Send DrawMinimizeButton DFCS_PUSHED If (Private.piPushedButton(Self) = SC_RESTORE) Send DrawRestoreButton DFCS_PUSHED If (Private.piPushedButton(Self) = SC_CLOSE) Send DrawCloseButton DFCS_PUSHED End // If (Private.piPushedButton(Self) = iButton) Begin End // If (iMode = TRACK_NONE And Private.pbMDIButtons(Self) And Private.piPushedButton(Self)) Begin // Handle menu buttons If (iMode = TRACK_POPUP) Begin // Which object is cursor on Move (WindowFromPoint(iX,iY)) To hObject Get_Object_From_Window hObject To iObject If (iObject = Self) Begin // Is this a valid button Get HitTest iX iY To iButton Move (SendMessage(Window_Handle(Self),TB_BUTTONCOUNT,0,0)) To iItems If (iButton >= 0 And iButton < iItems) Begin If (iX <> Private.MouseX(Self) Or iY <> Private.MouseY(Self)) Begin If (iButton <> Private.PopupTracking(Self)) Send CancelMenuAndTrackNew iButton Set Private.MouseX To iX Set Private.MouseY To iY End // If (iX <> Private.MouseX(Self) Or iY <> Private.MouseY(Self)) Begin End // If (iButton >= 0 And iButton < iItems) Begin End // If (iObject = Self) Begin End // If (iMode = TRACK_POPUP) Begin Case Break // Handle MDI button click Case (iMessage = WM_LBUTTONUP) If (iMode <> TRACK_NONE) Procedure_Return If (Private.pbMDIButtons(Self) = (False)) Procedure_Return If (Private.piPushedButton(Self) = 0) Procedure_Return // Where was the mouse GetBuff From sMsg at MSG.pt.x To iX GetBuff From sMsg at MSG.pt.y To iY // Which button was under mouse cursor Get MDIHitTest iX iY To iButton If (Private.piPushedButton(Self) = iButton) Begin Move (GetWindowDC(Window_Handle(Self))) To hDC If (iButton = SC_MINIMIZE) Begin Send DrawMinimizeButton 0 Move (SendMessage(Private.phMDIDialog(Self),WM_SYSCOMMAND,SC_MINIMIZE,0)) To iResult End // If (iButton = SC_MINIMIZE) Begin If (iButton = SC_RESTORE) Begin Send DrawRestoreButton 0 Move (SendMessage(Private.phMDIDialog(Self),WM_SYSCOMMAND,SC_RESTORE,0)) To iResult End // If (iButton = SC_RESTORE) Begin If (iButton = SC_CLOSE) Begin Send DrawCloseButton 0 Move (SendMessage(Private.phMDIDialog(Self),WM_SYSCOMMAND,SC_CLOSE,0)) To iResult End // If (iButton = SC_CLOSE) Begin End // If (Private.piPushedButton(Self) = iButton) Begin // Reset all MDI properties //Set Private.pbMDIButtons To False // Don't display MDI buttons Set Private.piPushedButton To 0 //Set Private.phMDIDialog To 0 // Invalidate window to make MDI buttons go away Move (InvalidateRect(Window_Handle(Self),0,True)) To iResult Case Break Case (iMessage = WM_LBUTTONDOWN) GetBuff From sMsg At MSG.pt.x To iX GetBuff From sMsg At MSG.pt.y To iY // Handle MDI buttons If (iMode = TRACK_NONE And Private.pbMDIButtons(Self)) Begin // Check for virtual keys If (iParam1 = MK_LBUTTON) Begin Get MDIHitTest iX iY To iButton If (iButton) Begin Move (GetWindowDC(hWindow)) To hDC If (iButton = SC_MINIMIZE) Send DrawMinimizeButton DFCS_PUSHED If (iButton = SC_RESTORE) Send DrawRestoreButton DFCS_PUSHED If (iButton = SC_CLOSE) Send DrawCloseButton DFCS_PUSHED Set Private.piPushedButton To iButton End // If (iButton) Begin End // If (iParam1 = 0) Begin End // If (iMode = TRACK_NONE) Begin // Handle menu buttons If (iMode <> TRACK_NONE) Begin // is this a valid button Get HitTest iX iY To iButton Move (SendMessage(Window_Handle(Self),TB_BUTTONCOUNT,0,0)) To iItems If (iButton >= 0 And iButton < iItems) Begin If (iButton = Private.PopupTracking(Self)) Send CancelMenuAndTrackNew -1 End // If (iButton >= 0 And iButton < iItems) Begin Else If (iMode = TRACK_BUTTON) Send SetTrackingState TRACK_NONE -1 End // If (iMode <> TRACK_NONE) Begin Case Break Case End Procedure_Return False End_Procedure // OnMsgHook End_Class // cMenu