//TH-Header //***************************************************************************************** // Copyright (c) 2003 Bernhard Ponemayr // All rights reserved. // // $FileName : C:\VDF7\Projects\hammer\Pkg\cFolderTabs.pkg // $ProjectName : The Hammer Entwicklung // $Author : Bernhard Ponemayr // $Created : 08.03.2003 01:27 // // Contents: Contains a class for Folder Tabs just like the // Worksheet selector in M$ Excel // //***************************************************************************************** //TH-RevisionStart // 08.03.2003 01:28 Inital Revision BP APBP // 16.01.2004 21:12 By SVN: Source clean up and adjustments Ad //TH-RevisionEnd Use cWindowsEx.h // A helper Class needed to create the scroll-buttons on left/right side of the // control. It is a standard DF-Button with a real and working focus_mode pointer_only // Additionally this class can use standard (OEM) bitmaps that are delivered from windows Class cTabScrollButton Is a Button Procedure Construct_Object Property Integer piBitmapHandle Public 0 Property Integer piOemBitmap Public 0 Property Integer piCaptureHwnd Public 0 Property Integer piMessage Public 0 Forward Send Construct_Object Set focus_mode To nonfocusable End_Procedure Procedure OnClick Local Integer iMsg Get piMessage To iMsg Send iMsg End_Procedure Procedure mouse_down Integer iPara0 Integer iPara1 Local Integer iRet iMsg iObj Set piCaptureHwnd To (GetCaptureEf()) Move (SetCapture(window_handle(Self))) To iRet Set select_state To True Send OnClick End_Procedure Procedure mouse_up Integer iPara0 Integer iPara1 Local Integer iRet Move (SetCapture(piCaptureHwnd(Self))) To iRet Set piCaptureHwnd To 0 Set select_state To False End_Procedure Procedure mouse_click Integer iPara0 Integer iPara1 End_Procedure Procedure page Integer iState Local Integer iRet Local Handle hBitmap hWnd Forward Send page iState If ( (iState) And (Not(BuildingObjectID)) And ( (piBitmapHandle(Self)) Eq 0) ) Begin Move (FindWindowExEf(window_handle(Self),0,0,0)) To hWnd Move (GetWindowLong(hWnd,(GWL_STYLE))) To iRet Move (SetWindowLong(hWnd,GWL_STYLE,(iRet Ior $80))) To iRet Move (LoadImageEf(0,(piOemBitmap(Self)),IMAGE_BITMAP,0,0,64)) To hBitmap Set piBitmapHandle To hBitmap Move (SendMessage(hWnd,244,1342177408,True)) To iRet Move (SendMessage(hWnd,247,IMAGE_BITMAP,hBitmap)) To iRet End End_Procedure Procedure destroy_object Local Integer hBitmap Move (piBitmapHandle(Self)) To hBitmap Forward Send destroy_object Move (DeleteObject(hBitmap)) To hBitmap End_Procedure End_Class // A extended Array class that can store binary data correctly // VDF can handle real binary data's (containing many character(0) ) in // local strings. this array can store and retrieve such values correctly Class cBinaryDataStore Is a Array Procedure Set binary_value Integer iItem String sVal Local String sValSet Local Integer iCou For iCou From 1 To (length(sVal)) Move (sValSet + (pad(Ascii(Mid(sVal,1,iCou)),3))) To sValSet Loop Set value Item iItem To sValSet End_Procedure Function binary_value Integer iItem Returns String Local Integer iPos Local String sVal sValRet Get value Item iItem To sVal Move 1 To iPos While (iPos Lt (length(sVal)) ) Move (sValRet + (Character(Mid(sVal,3,iPos)))) To sValRet Calc (iPos + 3) To iPos End Function_Return sValRet End_Function End_Class // The cFolderTabs control itself Class cWinFolderTabs Is a DFControl Register_Procedure WMMSG_Paint Integer wParam Integer lParam Register_Procedure WMMSG_Erasebkgnd Integer wParam Integer lParam Register_Procedure WMMSG_LButtonDown Integer wParam Integer lParam Register_Procedure WMMSG_MouseMove Integer wParam Integer lParam Register_Procedure WMMSG_MouseLeave Integer wParam Integer lParam Register_Procedure WMMSG_MouseHover Integer wParam Integer lParam Register_Procedure WMMSG_MouseWheel Integer wParam Integer lParam Register_Procedure WMMSG_Notify Integer wParam Integer lParam // Notifications that can be used. Procedure OnPaint End_Procedure Procedure OnMouseMove Integer iKeys Integer iXPos Integer iYPos End_Procedure Procedure OnMouseLeave End_Procedure Procedure OnItemChanging Integer iNewItem Integer iOldItem End_Procedure Procedure OnItemChanged Integer iNewItem Integer iOldItem End_Procedure Procedure Construct_Object Set external_class_name "cFolderTabs" To "#32768" Forward Send Construct_Object Set external_message WM_PAINT To WMMSG_Paint Set External_Message WM_ERASEBKGND To WMMSG_Erasebkgnd Set external_message WM_LBUTTONDOWN To WMMSG_LButtonDown Set External_Message WM_MOUSEMOVE To WMMSG_MouseMove Set External_Message WM_MOUSELEAVE To WMMSG_MouseLeave Set External_Message WM_MOUSEHOVER To WMMSG_Mousehover Set External_Message WM_MOUSEWHEEL To WMMSG_MouseWheel Set external_message WM_NOTIFY To WMMSG_Notify Property Integer piTopState Public False Property Integer piSelHeightInc Public 0 Property Integer piFirstVisibleItem Public 0 Property Integer piSelectedItem Public 0 Property Integer piMouseTracking Public False Property Integer poButtonLeft Public 0 Property Integer poButtonRight Public 0 Property Integer phToolTip Public 0 Property Integer piIsToolTipVisible Public False Property Integer piCurrentHotItem Public -1 Property Integer piTabsColor Public clWhite Property Integer piSelectedItemColor Public 0 Property Integer piHotItemTextColor Public (GetSysColor(COLOR_HOTLIGHT)) Property Integer piItemTextColor Public (GetSysColor(COLOR_WINDOWTEXT)) Property Integer piBackgroundColor Public 0 Property Integer autosize_height_state Public False Property Integer piShowNumbersForFirst Public False Object oTrapezoids Is an cBinaryDataStore End_Object Object oRegions Is a Array End_Object Object oItems Is an Array End_Object Object oRects Is an cBinaryDataStore End_Object Object oMessages Is an Array End_Object Object oColors Is an Array End_Object Object oTextColors Is an Array End_Object Object oToolTips Is an Array End_Object Object oItemShadowed Is an Array End_Object Object oAuxValues Is an Array End_Object Set focus_mode To nonfocusable End_Procedure // Size the height of the control to the selected settings and system fonts Procedure AutoSizeHeight Local Handle hDc hFont hOldFont Local String sPoint sHeightText Local Pointer pPoint pHeightText Local Integer iRet iX iY Move (GetDC(0)) To hDc Move (GetStockObject(DEFAULT_GUI_FONT)) To hFont Move (SelectObject(hDc,hFont)) To hOldFont ZeroType tPoint To sPoint GetAddress Of sPoint To pPoint Move ("TextWgyf" + Character(0)) To sHeightText GetAddress Of sHeightText To pHeightText Move (GetTextExtentPoint32Ef(hDc,pHeightText,(length(sHeightText)),pPoint)) To iRet GetBuff From sPoint At tPoint.y To iY Move (iY +5 + (piSelHeightInc(Self)) ) To iY Set GuiSize To iY (low(guisize(Self))) Move (SelectObject(hDc,hOldFont)) To iRet Move (ReleaseDc(0,hDc)) To iRet Send adjust_logicals End_Procedure // Autosize the height if wanted Procedure End_Construct_Object If (Autosize_height_state(Self)) Send AutoSizeHeight Forward Send End_Construct_Object End_Procedure // Delivers the GuiSize of a specified Button Function ButtonGuiSize Integer iItem Returns Integer Local Integer hRegion Local String sRect Local Pointer pRect Local Integer iRet iTop iLeft iBottom iRight iHeight iWidth Get value Of (oRegions(Self)) Item iItem To hRegion ZeroType tRect To sRect GetAddress Of sRect To pRect Move (GetRgnBoxEf(hRegion,pRect)) To iRet GetBuff From sRect At tRect.Top To iTop GetBuff From sRect At tRect.Left To iLeft GetBuff From sRect At tRect.Bottom To iBottom GetBuff From sRect At tRect.Right To iRight Move (iBottom - iTop) To iHeight Move (iRight - iLeft) To iWidth Function_Return (iWidth + (iHeight * 65536)) End_Function // Delivers the GuiLocation of a specified Button Function ButtonGuiLocation Integer iItem Returns Integer Local Integer hRegion Local String sRect Local Pointer pRect Local Integer iRet iTop iLeft iBottom iRight iHeight iWidth Get value Of (oRegions(Self)) Item iItem To hRegion ZeroType tRect To sRect GetAddress Of sRect To pRect Move (GetRgnBoxEf(hRegion,pRect)) To iRet GetBuff From sRect At tRect.Top To iTop GetBuff From sRect At tRect.Left To iLeft GetBuff From sRect At tRect.Bottom To iBottom GetBuff From sRect At tRect.Right To iRight Function_Return (iLeft + (iTop * 65536)) End_Function // Delivers the Item-Number if there is a Item under pos iX/iY else -1 Function ItemAtPos Integer iX Integer iY Returns Integer Local Integer iCou Local Handle hRegion For iCou From 0 To ( (item_count(oRegions(Self)))-1) Get value Of (oRegions(Self)) Item iCou To hRegion If hRegion Begin If (PtInRegionEf(hRegion,iX,iY)) Function_Return iCou End Loop Function_Return -1 End_Function Procedure WMMSG_MouseWheel Integer wParam Integer lParam End_Procedure Procedure WMMSG_MouseHover Integer wParam Integer lParam End_Procedure Procedure WMMSG_MouseLeave Integer wParam Integer lParam Set piMouseTracking To False Set HotItem To -1 Send OnMouseLeave End_Procedure Procedure WMMSG_MouseMove Integer wParam Integer lParam Integer iRet iColor iItem String sMouse Pointer pMouse // Bug fix. From time to time cursor remains as per Horizontal Splitter view. Move (SetCursor(LoadCursor(0,IDC_ARROW))) To iRet If (Not(piMouseTracking(Self))) Begin ZeroType cfTRACKMOUSEEVENT To sMouse Put cfTRACKMOUSEEVENT_SIZE To sMouse At cfTRACKMOUSEEVENT.cbSize Put (TME_HOVER Ior TME_LEAVE) To sMouse At cfTRACKMOUSEEVENT.dwFlags Put (Window_Handle(Self)) To sMouse At cfTRACKMOUSEEVENT.hwndTrack Put 500 To sMouse At cfTRACKMOUSEEVENT.dwHoverTime GetAddress Of sMouse To pMouse Move (TrackMouseEventEf(pMouse)) To iRet Set piMouseTracking To True End Get ItemAtPos (low(lParam)) (hi(lParam)) To iItem Set HotItem To iItem // Here // Send RefreshToolTip Send OnMouseMove wParam (low(lParam)) (hi(lParam)) End_Procedure // Set's the HotState of a specified item to true/false Procedure SetHotState Integer iItem Integer iState Local String sRect sItemText Local Pointer pRect pItemText Local Integer iRet iColor Local Handle hDc hFont hOldFont If ( (item_shadow_state(Self,iItem)) Or (object_shadow_state(Self)) ) Procedure_Return Get binary_value Of (oRects(Self)) iItem To sRect GetAddress Of sRect To pRect Move (InflateRectEf(pRect,((8+2)*-1),0)) To iRet Get value Of (oItems(Self)) Item iItem To sItemText If ( (piShowNumbersForFirst(Self)) And (iItem<10) ) Begin If iItem Eq 9 Move ("1&0 " + sItemText) To sItemText Else Move ( "&" + (String(iItem+1)) + " " + sItemText) To sItemText End Move (sItemText + (Character(0)) ) To sItemText GetAddress Of sItemText To pItemText Move (OemToAnsi(pItemText,pItemText)) To iRet Move (GetDC(window_handle(Self))) To hDc Move (GetStockObject(DEFAULT_GUI_FONT)) To hFont Move (SelectObject(hDc,hFont)) To hOldFont If (iState) Move (SetTextColor(hDc,(piHotItemTextColor(Self)))) To iRet Else Begin Get ItemTextColor Item iItem To iColor If (Not(iColor)) Move (piItemTextColor(Self)) To iColor Move (SetTextColor(hDc,iColor)) To iRet End If iItem Ne (piSelectedItem(Self)) Begin Get ItemColor Item iItem To iColor If (Not(iColor)) Get piTabsColor To iColor If (iColor<0) Move (GetSysColor(iColor Iand $000000FF)) To iColor Move (SetBkColorEf(hDc,iColor)) To iRet End Else Begin Move (piSelectedItemColor(Self)) To iColor If iColor Eq 0 Begin Get Color Of (Parent(Self)) To iColor If (iColor<0) Move (GetSysColor(iColor Iand $000000FF)) To iColor End Move (SetBkColorEf(hDc,iColor)) To iRet End Move (DrawText(hDc,pItemText,((length(sItemText))-1),pRect,(DT_CENTER Ior DT_VCENTER Ior DT_SINGLELINE))) To iRet Move (SelectObject(hDc,hOldFont)) To iRet Move (ReleaseDc(window_handle(Self),hDc)) To iRet End_Procedure // Sets the current HotItem (deselects current hot-item if necessary) Procedure Set HotItem Integer iItem If (piCurrentHotItem(Self)) Eq iItem Procedure_Return If (piCurrentHotItem(Self)) Ne -1 Send SetHotState (piCurrentHotItem(Self)) False Set piCurrentHotItem To iItem If iItem Eq -1 Begin Send HideToolTip Procedure_Return End Send SetHotState iItem True Send RefreshToolTip End_Procedure // Create a point array (string of points added togeger :-) // that defines the trapezoid used FOR painting Function GetTrapezoid String sRect Returns String Local String sRet sPoint Local Integer iTop iLeft iBottom iRight GetBuff From sRect At tRect.top To iTop GetBuff From sRect At tRect.Left To iLeft GetBuff From sRect At tRect.Bottom To iBottom GetBuff From sRect At tRect.Right To iRight ZeroString 32 To sRet If (piTopState(Self)) Begin ZeroType tPoint To sPoint Put iLeft To sPoint At tPoint.x Put iBottom To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,1)) To sRet ZeroType tPoint To sPoint Put (iLeft + 7) To sPoint At tPoint.x Put iTop To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 1)+1))) To sRet ZeroType tPoint To sPoint Put (iRight - 7 -1) To sPoint At tPoint.x Put iTop To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 2)+1))) To sRet ZeroType tPoint To sPoint Put (iRight-1) To sPoint At tPoint.x Put iBottom To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 3)+1))) To sRet End Else Begin ZeroType tPoint To sPoint Put iLeft To sPoint At tPoint.x Put iTop To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,1)) To sRet ZeroType tPoint To sPoint Put (iLeft + 7) To sPoint At tPoint.x Put iBottom To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 1)+1))) To sRet ZeroType tPoint To sPoint Put (iRight - 7 -1) To sPoint At tPoint.x Put iBottom To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 2)+1))) To sRet ZeroType tPoint To sPoint Put (iRight-1) To sPoint At tPoint.x Put iTop To sPoint At tPoint.y Move (Overstrike(sPoint,sRet,((tPoint_Size * 3)+1))) To sRet End Function_Return sRet End_Function // Moves a Trapezoid location specified by iRight iDown. Procedure OffsetTrapezoid Integer iItem Integer iRight Integer iDown Local String sTrap sPoint Local Integer iIndex iX iY Get binary_value Of (oTrapezoids(Self)) iItem To sTrap For iIndex From 0 To 3 Move (Mid(sTrap,tPoint_size,((iIndex*tPoint_size)+1))) To sPoint GetBuff From sPoint At tPoint.x To iX GetBuff From sPoint At tPoint.y To iY Calc (iX + iRight) To iX Calc (iY + iDown) To iY Put iX To sPoint At tPoint.x Put iY To sPoint At tPoint.y Move (Overstrike(sPoint,sTrap,((tPoint_Size * iIndex)+1))) To sTrap Loop Set binary_value Of (oTrapezoids(Self)) iItem To sTrap End_Procedure // Delivers the x-Position of a point in my Point-Array Function XFromPointArray String sArray Integer iIndex Returns String Local Integer iRet Move (Mid(sArray,tPoint_size,((iIndex*tPoint_size)+1))) To sArray GetBuff From sArray At tPoint.x To iRet Function_Return iRet End_Function // Delivers the y-Position of a point in my Point-Array Function YFromPointArray String sArray Integer iIndex Returns String Local Integer iRet Move (Mid(sArray,tPoint_size,((iIndex*tPoint_size)+1))) To sArray GetBuff From sArray At tPoint.y To iRet Function_Return iRet End_Function // Shift the position of all rects, regions and trapezoids by the // specified values. Procedure ScrollDatas Integer iRight Integer iDown Local Integer iCou iRet Local Handle hRgn Local String sRect Local Pointer pRect For iCou From 0 To ( (item_count(oItems(Self))) -1) Get value Of (oRegions(Self)) Item iCou To hRgn If (hRgn) Move (OffsetRgnEf(hRgn,iRight,0)) To iRet Get binary_value Of (oRects(Self)) iCou To sRect If (Trim(sRect)) Ne "" Begin GetAddress Of sRect To pRect Move (OffsetRectEf(pRect,iRight,0)) To iRet Set binary_value Of (oRects(Self)) iCou To sRect End Send OffsetTrapezoid iCou iRight 0 Loop End_Procedure // Creates all Regions needed to paint the visible Buttons Function CreateRegions Handle hDc Integer iStartOffset Returns Integer Local Integer iCou iRet iX iY iCurPos iHeight Local Handle hFont hOldFont hRgn Local String sText sPoint sRect sTrap Local Pointer pText pPoint pRect pTrap For iCou From 0 To ( (item_count(oRegions(Self))) -1) Get value Of (oRegions(Self)) Item iCou To hRgn If hRgn Move (DeleteObject(hRgn)) To iRet Loop Send delete_data To (oRegions(Self)) Move (hi(GuiSize(Self))) To iHeight Move iStartOffset To iCurPos Move (GetStockObject(DEFAULT_GUI_FONT)) To hFont Move (SelectObject(hDc,hFont)) To hOldFont For iCou From (piFirstVisibleItem(Self)) To ( (item_count(oItems(Self))) -1) Get value Of (oItems(Self)) Item iCou To sText If ( (piShowNumbersForFirst(Self)) And (iCou<10) ) Begin If iCou Eq 9 Move ("1&0 " + sText) To sText Else Move ( "&" + (String(iCou+1)) + " " + sText) To sText End Move (sText + (Character(0)) ) To sText GetAddress Of sText To pText Move (OemToAnsi(pText,pText)) To iRet Move (cString(sText)) To sText ZeroType tPoint To sPoint GetAddress Of sPoint To pPoint Move (GetTextExtentPoint32Ef(hDc,pText,(length(sText)),pPoint)) To iRet GetBuff From sPoint At tPoint.x To iX GetBuff From sPoint At tPoint.y To iY If (piTopState(Self)) Begin ZeroType tRect To sRect GetAddress Of sRect To pRect If iCou Eq (piSelectedItem(Self)) Put (iHeight - iY-4 - (piSelHeightInc(Self)) ) To sRect At tRect.Top Else Put (iHeight - iY-4) To sRect At tRect.Top Put iCurPos To sRect At tRect.Left Put iHeight To sRect At tRect.Bottom Put (iCurPos + iX + 20) To sRect At tRect.Right Move (iCurPos+iX+20-8) To iCurPos End Else Begin ZeroType tRect To sRect GetAddress Of sRect To pRect Put 0 To sRect At tRect.Top Put iCurPos To sRect At tRect.Left If iCou Eq (piSelectedItem(Self)) Put (iY +4 + (piSelHeightInc(Self)) ) To sRect At tRect.Bottom Else Put (iY +4) To sRect At tRect.Bottom Put (iCurPos + iX + 20) To sRect At tRect.Right Move (iCurPos+iX+20-8) To iCurPos End Get GetTrapezoid sRect To sTrap Set binary_value Of (oTrapezoids(Self)) iCou To sTrap Set binary_value Of (oRects(Self)) iCou To sRect GetAddress Of sTrap To pTrap Move (CreatePolygonRgnEf(pTrap,4,1)) To hRgn Set value Of (oRegions(Self)) Item iCou To hRgn Loop Move (SelectObject(hDc,hOldFont)) To hOldFont Function_Return iCurPos End_Function Procedure DrawTopLine Handle hDc Local Integer iRet Local Handle hOldPen hPen Move (movetoexef(hDc,0,0,0)) To iRet Move (GetStockObject(BLACK_PEN)) To hPen Move (SelectObject(hDc,hPen)) To hOldPen Move (LineTo(hDc,(low(GuiSize(Self))),0)) To iRet Move (SelectObject(hDc,hOldPen)) To iRet End_Procedure // Draws a single Button Function DrawButton Handle hDC Integer iItem Returns Integer Local Handle hPen hBrush hRgn hShadowPen hColor hOldPen hFont hOldFont hOldBrush Local String sPaintStruct sTrap sPoint sRect sItemText Local Pointer pPaintStruct pTrap pPoint pRect pItemText Local Integer iRet iX iY iReturnVal iSize iColor iSelected If iItem Eq (piSelectedItem(Self)) Move 1 To iSelected If (Not(iSelected)) Begin Get ItemColor Item iItem To iColor If (Not(iColor)) Get piTabsColor To iColor If (iColor<0) Move (GetSysColor(iColor Iand $000000FF)) To iColor Move (CreateSolidBrush(iColor)) To hBrush Move (SetBkColorEf(hDc,iColor)) To iRet End Else Begin Move (piSelectedItemColor(Self)) To iColor If iColor Eq 0 Begin Get Color Of (Parent(Self)) To iColor If (iColor<0) Move (GetSysColor(iColor Iand $000000FF)) To iColor End Move (CreateSolidBrush(iColor)) To hBrush Move (SetBkColorEf(hDc,iColor)) To iRet End Move (SelectObject(hDC,hBrush)) To hOldBrush Get value Of (oRegions(Self)) Item iItem To hRgn Move (FillRgnEf(hDc,hRgn,hBrush)) To iRet Get binary_value Of (oTrapezoids(Self)) iItem To sTrap GetAddress Of sTrap To pTrap Move (GetStockObject(BLACK_PEN)) To hPen Move (GetSysColor(COLOR_BTNSHADOW)) To hColor Move (SelectObject(hDc,hPen)) To hOldPen Move (XFromPointArray(Self,sTrap,3)) To iReturnVal If (Not(iSelected)) Begin If (piTopState(Self)) Begin Move (XFromPointArray(Self,sTrap,3)) To iX Move (YFromPointArray(Self,sTrap,3)) To iY Move (movetoexef(hDc,iX,(iY-1),0)) To iRet Move (XFromPointArray(Self,sTrap,0)) To iX Move (YFromPointArray(Self,sTrap,0)) To iY Move (LineTo(hDc,iX,(iY-1))) To iRet End Else Begin Move (XFromPointArray(Self,sTrap,3)) To iX Move (YFromPointArray(Self,sTrap,3)) To iY Move (MoveToExEf(hDc,iX,iY,0)) To iRet Move (XFromPointArray(Self,sTrap,0)) To iX Move (YFromPointArray(Self,sTrap,0)) To iY Move (LineTo(hDc,iX,iY)) To iRet End End Else Begin Move (GetSysColor(COLOR_3DHILIGHT)) To hColor Move (CreatePen(PS_SOLID,1,hColor)) To hShadowPen Move (XFromPointArray(Self,sTrap,0)) To iX Move (YFromPointArray(Self,sTrap,0)) To iY If (piTopState(Self)) Move (MoveToExEf(hDc,(iX+1),iY,0)) To iRet Else Move (MoveToExEf(hDc,(iX+1),iY,0)) To iRet Move (XFromPointArray(Self,sTrap,1)) To iX Move (YFromPointArray(Self,sTrap,1)) To iY Move (SelectObject(hDc,hShadowPen)) To iRet If (piTopState(Self)) Begin Move (LineTo(hDc,(iX+1),iY)) To iRet Move (MoveToExEf(hDc,(iX+1),(iY+1),0)) To iRet End Else Begin Move (LineTo(hDc,(iX+1),iY)) To iRet Move (MoveToExEf(hDc,(iX+1),(iY-1),0)) To iRet End Move (SelectObject(hDc,hPen)) To iRet Move (DeleteObject(hShadowPen)) To iRet Move (GetSysColor(COLOR_3DSHADOW)) To hColor Move (CreatePen(PS_SOLID,1,hColor)) To hShadowPen Move (SelectObject(hDc,hShadowPen)) To iRet Move (XFromPointArray(Self,sTrap,2)) To iX Move (YFromPointArray(Self,sTrap,2)) To iY Move (SelectObject(hDc,hShadowPen)) To iRet If (piTopState(Self)) Begin Move (LineTo(hDc,iX,(iY+1))) To iRet Move (MoveToExEf(hDc,(iX-1),iY,0)) To iRet End Else Begin Move (LineTo(hDc,iX,(iY-1))) To iRet Move (MoveToExEf(hDc,(iX-1),iY,0)) To iRet End Move (XFromPointArray(Self,sTrap,3)) To iX Move (YFromPointArray(Self,sTrap,3)) To iY If (piTopState(Self)) Move (LineTo(hDc,(iX-1),iY)) To iRet Else Move (LineTo(hDc,(iX-1),iY)) To iRet Move (SelectObject(hDc,hPen)) To iRet Move (DeleteObject(hShadowPen)) To iRet End Move (SelectObject(hDc,hPen)) To iRet Move (XFromPointArray(Self,sTrap,0)) To iX Move (YFromPointArray(Self,sTrap,0)) To iY Move (MoveToExEf(hDc,iX,iY,0)) To iRet Move (PolylineToEf(hDc,pTrap,4)) To iRet Move (GetStockObject(DEFAULT_GUI_FONT)) To hFont Move (SelectObject(hDc,hFont)) To hOldFont Move (SelectObject(hDc,hOldPen)) To iRet Get binary_value Of (oRects(Self)) iItem To sRect GetAddress Of sRect To pRect Move (InflateRectEf(pRect,((8+2)*-1),0)) To iRet Get value Of (oItems(Self)) Item iItem To sItemText If ( (piShowNumbersForFirst(Self)) And (iItem<10) ) Begin If iItem Eq 9 Move ("1&0 " + sItemText) To sItemText Else Move ( "&" + (String(iItem+1)) + " " + sItemText) To sItemText End Move (sItemText + (Character(0)) ) To sItemText GetAddress Of sItemText To pItemText Move (OemToAnsi(pItemText,pItemText)) To iRet If ( (object_shadow_state(Self)) Or (item_shadow_state(Self,iItem)) ) Move (SetTextColor(hDc,(GetSysColor(COLOR_GRAYTEXT)))) To iRet Else Begin If iItem Eq (piCurrentHotItem(Self)) Move (SetTextColor(hDc,(piHotItemTextColor(Self)))) To iRet Else Begin Get ItemTextColor Item iItem To iColor If (Not(iColor)) Move (piItemTextColor(Self)) To iColor Move (SetTextColor(hDc,iColor)) To iRet End End Move (DrawText(hDc,pItemText,((length(sItemText))-1),pRect,(DT_CENTER Ior DT_VCENTER Ior DT_SINGLELINE))) To iRet Move (SelectObject(hDc,hOldFont)) To iRet Move (SelectObject(hDc,hOldBrush)) To iRet Move (DeleteObject(hBrush)) To iRet If (iReturnVal Gt (low(GuiSize(Self))) ) Function_Return False Else Function_Return True End_Function // Paint a background Procedure PaintBackground Handle hDc Local Handle hBrush hPen Local Integer iVoid iSize iColor iTop Get piTopState To iTop Get guiSize To iSize Get piBackgroundColor To iColor If iColor Eq 0 Get color Of (parent(Self)) To iColor If (iColor<0) Move (GetSysColor(iColor Iand $000000FF)) To iColor Move (GetStockObject(BLACK_PEN)) To hPen If (Not(hBrush)) Move (CreateSolidBrush(iColor)) To hBrush Move (SelectObject(hDC, hPen)) To iVoid Move (SelectObject(hDC, hBrush)) To iVoid If (iTop) Move (Rectangle(hDC, -2, -1, Low(iSize)+4, Hi(iSize) )) To iVoid Else Move (Rectangle(hDC, -2, 0, Low(iSize)+3, Hi(iSize)+2 )) To iVoid Move (DeleteObject(hBrush)) To iVoid End_Procedure Procedure WMMSG_Erasebkgnd Integer wParam Integer lParam Procedure_Return 1 End_Procedure Procedure WMMSG_Paint Integer wParam Integer lParam Local String sPaintStruct sText sClientRect Local Pointer pPaintStruct pClientRect Local Handle hDc hRegion hMemDC hMemBitmap hBitmapOld hWindowDC Local Integer iRet iSelectedPos iCou iPos iSelectedVisible iWidth iStartOffset iX iY iTop iLeft iBottom iRight ZeroType tPAINTSTRUCT To sPaintStruct GetAddress Of sPaintStruct To pPaintStruct Move (BeginPaint(window_handle(Self), pPaintStruct)) To hDC ZeroType tRect To sClientRect GetAddress Of sClientRect To pClientRect Move (GetClientRect(window_handle(Self),pClientRect)) To iRet GetBuff From sClientRect At tRect.Top To iTop GetBuff From sClientRect At tRect.Left To iLeft GetBuff From sClientRect At tRect.Bottom To iBottom GetBuff From sClientRect At tRect.Right To iRight Move (CreateCompatibleDCEf(hDC)) To hMemDC Move (CreateCompatibleBitmapEf(hDC,(iRight-iLeft),(iBottom-iTop))) To hMemBitmap Move (SelectObject(hMemDC,hMemBitmap)) To hBitmapOld Move hDC To hWindowDc Move hMemDC To hDc If (piFirstVisibleItem(Self)) Ne 0 Move 12 To iStartOffset Get CreateRegions hDc iStartOffset To iWidth If (piFirstVisibleItem(Self)) Ne 0 Begin Set GuiSize Of (poButtonLeft(Self)) To 12 12 Move (hi(ButtonGuiSize(Self,(piFirstVisibleItem(Self))))) To iY Calc ((iY -10) /2) To iY Calc (iY + (hi(GuiLocation(Self)))) To iY Set GuiLocation Of (poButtonLeft(Self)) To iY (low(GuiLocation(Self))) Set visible_state Of (poButtonLeft(Self)) To True End Else Set visible_state Of (poButtonLeft(Self)) To False If iWidth Gt (low(GuiSize(Self))) Begin Set GuiSize Of (poButtonRight(Self)) To 12 12 Move (hi(ButtonGuiSize(Self,(piFirstVisibleItem(Self))))) To iY Calc ((iY -10) /2) To iY Calc (iY + (hi(GuiLocation(Self)))) To iY Set GuiLocation Of (poButtonRight(Self)) To iY ( (low(GuiLocation(Self))) + (low(GuiSize(Self))) - (low(GuiSize(poButtonRight(Self)))) ) Set visible_state Of (poButtonRight(Self)) To True End Else Set visible_state Of (poButtonRight(Self)) To False Send PaintBackground hDc Move 0 To iPos For iCou From (piFirstVisibleItem(Self)) To ( (item_count(oItems(Self))) -1) If iCou Ne (piSelectedItem(Self)) Begin Get DrawButton hDc iCou To iRet If (Not(iRet)) Move ( (item_count(oItems(Self))) -1) To iCou End Else Move 1 To iSelectedVisible Loop If iSelectedVisible Get DrawButton hDc (piSelectedItem(Self)) To iRet Move (BitBltEf(hWindowDC,iLeft,iTop,(iRight-iLeft),(iBottom-iTop),hMemDC,0,0,SRCCOPY)) To iRet Move (SelectObject(hMemDC,hBitmapOld)) To iRet Move (DeleteObject(hMemBitmap)) To iRet Move (DeleteDCEf(hMemDc)) To iRet Move (EndPaint(window_handle(Self), pPaintStruct)) To iRet If (visible_state(poButtonLeft(Self))) Send rotate_up To (poButtonLeft(Self)) If (visible_state(poButtonRight(Self))) Send rotate_up To (poButtonRight(Self)) Send OnPaint End_Procedure // The following are needed for ToolTips Procedure CreateToolTipWindow Local Handle hWnd Local String sClass Local Pointer pClass Move ("tooltips_class32" + (Character(0))) To sClass GetAddress Of sClass To pClass Move (CreateWindowExEf(0,pClass,0,TTS_ALWAYSTIP,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,(window_handle(desktop)),0)) To hWnd Set phToolTip To hWnd End_Procedure Procedure Set ToolTipActive Integer iState Local Integer iRet Move (SendMessage(phToolTip(Self),TTM_ACTIVATE,iState,0)) To iRet End_Procedure Procedure AddWindowToToolTip Local Integer iRet Local String sToolInfo Local Pointer pToolInfo Local Handle hWnd Get window_handle To hWnd ZeroType tTOOLINFO To sToolInfo GetAddress Of sToolInfo To pToolInfo Put tTOOLINFO_SIZE To sToolInfo At tTOOLINFO.cbSize Put (TTF_SUBCLASS Ior TTF_IDISHWND) To sToolInfo At tTOOLINFO.uFlags Put hWnd To sToolInfo At tTOOLINFO.hwnd Put hWnd To sToolInfo At tTOOLINFO.uID Put -1 To sToolInfo At tTOOLINFO.lpszText Move (SendMessage(phToolTip(Self),TTM_ADDTOOL,0,pToolInfo)) To iRet End_Procedure Procedure HideToolTip Local Integer iRet If (Not(piIsToolTipVisible(Self))) Procedure_Return Move (SendMessage(phToolTip(Self),TTM_POP,0,0)) To iRet End_Procedure Procedure RefreshToolTip Local Integer iRet iRemoveTip Local String sTipText If (Not(piIsToolTipVisible(Self))) Procedure_Return If (piCurrentHotItem(Self)) Eq -1 Move 1 To iRemoveTip Get value Of (oToolTips(Self)) Item (piCurrentHotItem(Self)) To sTipText If (Trim(sTipText)) Eq "" Move 1 To iRemoveTip If iRemoveTip Begin Send HideToolTip Procedure_Return End Move (sendmessage(phToolTip(Self),TTM_UPDATE,0,0)) To iRet End_Procedure Procedure WMMSG_Notify Integer wParam Integer lParam Local String sNmHdr sNmTTDispInfo sTipText Local Pointer pNmHdr pNmTTDispInfo pTipText Local Integer iRet iCode ZeroType tNmHdr To sNmHdr GetAddress Of sNmHdr To pNmHdr Move (CopyMemory(pNmHdr, lParam, tNmHdr_size)) To iRet GetBuff From sNmHdr At tNmHdr.code To iCode If iCode Eq TTN_GETDISPINFO Begin If (piCurrentHotItem(Self)) Eq -1 Procedure_Return 0 Get value Of (oToolTips(Self)) Item (piCurrentHotItem(Self)) To sTipText If (Trim(sTipText)) Eq "" Procedure_Return 0 ZeroType tNmTTDispInfo To sNmTTDispInfo GetAddress Of sNmTTDispInfo To pNmTTDispInfo Move (CopyMemory(pNmTTDispInfo, lParam, tNmTTDispInfo_size)) To iRet Move (sTipText + (Character(0))) To sTipText GetAddress Of sTipText To pTipText Move (OemToAnsi(pTipText,pTipText)) To iRet If (length(sTipText)) Gt 80 Put pTipText To sNmTTDispInfo At tNmTTDispInfo.lpszText Else put_string sTipText To sNmTTDispInfo At tNmTTDispInfo.szText Put (window_handle(Self)) To sNmTTDispInfo At tNmTTDispInfo.hdr.hwndFrom Put (window_handle(Self)) To sNmTTDispInfo At tNmTTDispInfo.hdr.idFrom Put TTF_IDISHWND To sNmTTDispInfo At tNmTTDispInfo.uFlags Move (CopyMemory(lParam,pNmTTDispInfo, tNmTTDispInfo_size)) To iRet Procedure_Return 1 End If iCode Eq TTN_SHOW Begin Set piIsToolTipVisible To True Procedure_Return 1 End If iCode Eq TTN_POP Begin Set piIsToolTipVisible To False Procedure_Return 1 End End_Procedure // Create left/right button and tooltip if needed Procedure page Integer iState Local Integer iRet Forward Send page iState If iState Begin If (Not(poButtonLeft(Self))) Begin Object oButtonLeft Is a cTabScrollButton Set Guisize To 12 12 Set piOemBitmap To 32750 Set piMessage To ScrollLeft Set poButtonLeft To (Self) End_Object Send page_object To (poButtonLeft(Self)) True End If (Not(poButtonRight(Self))) Begin Object oButtonRight Is a cTabScrollButton Set Guisize To 12 12 Set piOemBitmap To 32751 Set piMessage To ScrollRight Set poButtonRight To (Self) End_Object Send page_object To (poButtonRight(Self)) True End If (Not(phToolTip(Self))) Begin Send CreateToolTipWindow Set ToolTipActive To True Send AddWindowToToolTip End End End_Procedure Procedure destroy_object Local Integer iRet If (phToolTip(Self)) Begin Move (DestroyWindowEf(phToolTip(Self))) To iRet Set phToolTip To 0 End Forward Send destroy_object End_Procedure Procedure RedrawMySelf Local Integer iRet Send HideToolTip Move (RedrawWindowEf(Window_Handle(Self),0,0,(RDW_INVALIDATE Ior RDW_NOERASE))) To iRet End_Procedure Procedure WMMSG_LButtonDown Integer wParam Integer lParam Local Integer iCou iPrevious iRet iLoc iSize Local Handle hRegion Local String sRect Local Pointer pRect Move (piSelectedItem(Self)) To iPrevious For iCou From 0 To ( (item_count(oRegions(Self)))-1) Get value Of (oRegions(Self)) Item iCou To hRegion If hRegion Begin If (PtInRegionEf(hRegion,(low(lParam)),(hi(lParam)) )) Begin If (item_shadow_state(Self,iCou)) Procedure_Return Send OnItemChanging iCou iPrevious If iCou Eq (piFirstVisibleItem(Self)) Begin If (piFirstVisibleItem(Self)) Ge 1 Set piFirstVisibleItem To ( (piFirstVisibleItem(Self)) - 1) End Else Begin Move (ButtonGuiLocation(Self,iCou)) To iLoc Move (ButtonGuiSize(Self,iCou)) To iSize If ( (low(iSize)) + (low(iLoc)) ) Gt (low(GuiSize(Self))) Begin Set piFirstVisibleItem To ( (piFirstVisibleItem(Self)) + 1) End End Set piSelectedItem To iCou Move (item_count(oRegions(Self))) To iCou End End Loop If (piSelectedItem(Self)<>iPrevious) Begin Send redrawmyself Send OnItemChanged (piSelectedItem(Self)) iPrevious Send OnClick (piSelectedItem(Self)) End Move (sendmessage(phToolTip(Self),TTM_UPDATE,0,0)) To iRet End_Procedure Procedure OnClick Integer iItem Integer iMsg iObj Get Value Of (oMessages(Self)) Item iItem To iMsg Get value Of (oAuxValues(Self)) Item iItem To iObj If (iMsg) Begin If iObj Send iMsg To iObj iItem Else Send iMsg iItem End End_Procedure Procedure Set Border_Style Integer iStyle Forward Set Border_Style To Border_None End_Procedure Function Item_Count Returns Integer Function_Return (Item_Count(oItems(Self))) End_Function Procedure Set Current_Item Integer iItem If ((iItem>=0)And(iItem=0)And(iItem=0)And(iItem0)) Begin Send Delete_Item To (oItems(Self)) iItem Send Delete_Item To (oMessages(Self)) iItem Send Delete_Item To (oColors(Self)) iItem Send Delete_Item To (oTextColors(Self)) iItem Send Delete_Item To (oItemShadowed(Self)) iItem Send delete_item To (oToolTips(Self)) iItem Send delete_item To (oAuxValues(Self)) iItem Send RedrawMySelf End End_Procedure Procedure Delete_Data Send Delete_data To (oItems(Self)) Send Delete_data To (oMessages(Self)) Send Delete_data To (oColors(Self)) Send Delete_data To (oTextColors(Self)) Send delete_data To (oItemShadowed(Self)) Send delete_data To (oToolTips(Self)) Send delete_data To (oAuxValues(Self)) Send RedrawMySelf End_Procedure Procedure Set HeightAddedToSelected Integer iHeight Set piSelHeightInc To iHeight End_Procedure Function HeightAddedToSelected Returns Integer Function_Return (piSelHeightInc(Self)) End_Function Procedure Set color Integer iColor Set piBackgroundColor To iColor End_Procedure Function Color Returns Integer Function_Return (piBackgroundColor(Self)) End_Function Procedure Set item_shadow_state Integer iItem Integer iState Set value Of (oItemShadowed(Self)) Item iItem To iState End_Procedure Function item_shadow_state Integer iItem Returns Integer Function_Return (value(oItemShadowed(Self),iItem)) End_Function Procedure Set aux_value Integer iItem Integer iValue Set value Of (oAuxValues(Self)) Item iItem To iValue End_Procedure Function Aux_value Integer iItem Returns Integer Function_Return (value(oAuxValues(Self),iItem)) End_Function End_Class