//TH-Header //***************************************************************************************** // Copyright (c) 2001 Michael Kurz // All rights reserved. // If you want to use this source in your applications contact: // // $FileName : cRealToolBar.pkg // $ProjectName : Mixed Stuff. // $Author : Michael Kurz // $Created : 10.11.2001 22:04 // // Contents: // A toolbar which allows to adjust the TextColor of the labels and the background color. // //***************************************************************************************** // Sample of Usage: This Toolbar is working completely like the standard cToolBar // and this sample only discuss' the additional features. // //Object oToolBar Is a cRealToolBar // Set piclrBtnHighlight To clWhite // BorderColor of the Button top and left // Set piclrBtnShadow To clBlack // BorderColor of the Button bottom and right // // Set piTextColor to clBlack // Color of the Text // Set piTextHighlightColor to clBlue // Hot color of the text (When the mouse is over a button) // Set piBkColor To clWhite // Backgroundcolor of the Button // Set psBkPatternBmp To "Pattern2.bmp" // If set the background of the button is painted with a brush // // which is using this bitmap. // // Set Typeface to "Times New Roman" // Font of the Text in the toolbar // Set FontHeight To 15 // Size of the textfont // ... //End_Object //TH-RevisionStart // 10.11.2001 22:05 Created Mk SERVER // 12.11.2001 12:52 Hottrack color support added Mk SERVER //TH-RevisionEnd Use cToolbar.pkg Use mPointer.pkg Use tWinStructs.pkg //Use PopupMenu.pkg //Class cButtonsList Is a cPopUpMenu // Procedure Construct_Object // Forward Send Construct_Object // Property Integer Selected_Item Public (-1) // Set psLabel To "Buttons List" // End_Procedure // // Procedure DoAction Integer iNr // Set Selected_Item To iNr // Forward Send DoAction iNr // End_Procedure //End_Class #Replace CREALTOOLBAR_REGISTRY 'AppToolBar' #Replace CREALTOOLBAR_HOTCOLOR clBlue #IFNDEF GET_SETBKCOLOR External_Function SetBkColor "SetBkColor" Gdi32.dll Handle hdc Integer crColor Returns Integer #ENDIF #IFNDEF GET_FILLRECT External_Function FillRect "FillRect" User32.dll Handle hdc Pointer pRect Handle hBruch Returns Integer #ENDIF External_Function CreateBrushIndirect "CreateBrushIndirect" Gdi32.Dll Pointer pLogBrush Returns Integer #IFNDEF GET_CreateFontIndirect External_Function CreateFontIndirect "CreateFontIndirectA" Gdi32.Dll Pointer pLogFont Returns Integer #ENDIF External_Function GetDCOrgEx "GetDCOrgEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function GetViewportOrgEx "GetViewportOrgEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function GetWindowOrgEx "GetWindowOrgEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function GetCurrentPositionEx "GetCurrentPositionEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function GetViewportExtEx "GetViewportExtEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function GetGraphicsMode "GetGraphicsMode" Gdi32.dll Handle hDC Returns Integer #IFNDEF GET_GetMapMode External_Function GetMapMode "GetMapMode" Gdi32.dll Handle hDC Returns Integer #ENDIF External_Function GetBrushOrgEx "GetBrushOrgEx" Gdi32.dll Handle hDC Pointer pPoint Returns Integer External_Function SetBrushOrgEx "SetBrushOrgEx" Gdi32.Dll Handle hDC Integer iX Integer iY Pointer pPoint Returns Integer Function DFGetDCOrgEx Global Handle hDC Returns Integer Integer iRet iX iY tWinPoint wPoint // move (GetDCOrgEx(hDC,pPoint)) to iRet // Move (GetViewportOrgEx(hDC,pPoint)) to iRet // Move (GetWindowOrgEx(hDC,pPoint)) to iRet // move (GetCurrentPositionEx(hDC,pPoint)) to iRet // move (GetViewportExtEx(hDC,pPoint)) to iRet // move (GetViewportExtEx(hDC,pPoint)) to iRet // move (GetViewportExtEx(hDC,pPoint)) to iRet Move 0 to wPoint.x Move (GetBrushOrgEx(hDC,AddressOf(wPoint))) to iRet // Showln "Ret: " iRet Move wPoint.x to iX Move wPoint.y to iY // Showln "X: " iX " / " iY Function_Return (iX+(iY*65536)) End_Function // Brush Styles Define BS_SOLID For 0 Define BS_NULL For 1 Define BS_HOLLOW For BS_NULL Define BS_HATCHED For 2 Define BS_PATTERN For 3 Define BS_INDEXED For 4 Define BS_DIBPATTERN For 5 Define BS_DIBPATTERNPT For 6 Define BS_PATTERN8X8 For 7 Define BS_DIBPATTERN8X8 For 8 Define BS_MONOPATTERN For 9 // Hatch Styles Define HS_HORIZONTAL For 0 Define HS_VERTICAL For 1 Define HS_FDIAGONAL For 2 Define HS_BDIAGONAL For 3 Define HS_CROSS For 4 Define HS_DIAGCROSS For 5 Struct tLOGBRUSH Integer lbStyle // (UINT) DWord lbColor // (COLORREF) Integer lbHatch // (LONG) End_Struct // Creates a brush indirect. Function DFCreateBrushIndirect Global Integer iStyle Integer iColor Integer iHatch Returns Handle tLOGBRUSH LogBrush Move iStyle To LOGBRUSH.lbStyle Move iColor To LOGBRUSH.lbColor Move iHatch To LOGBRUSH.lbHatch Function_Return (CreateBrushIndirect(AddressOf(LOGBRUSH))) End_Function Struct tCOLORSCHEME Dword dwSize // (DWORD) Dword clrBtnHighlight // (COLORREF) Dword clrBtnShadow // (COLORREF) End_Struct Struct tNMTBCUSTOMDRAW tWinNmHdr hdr // (NMHDR) DWORD dwDrawStage // (DWORD) Handle hdc // (HDC) tWinRect rc Pointer dwItemSpec // (DWORD_PTR) Integer uItemState // (UINT) Integer lItemlParam // (LPARAM) Handle hbrMonoDither // (HBRUSH) Handle hbrLines // (HBRUSH) Handle hpenLines // (HPEN) DWord clrText // (COLORREF) DWord clrMark // (COLORREF) DWord clrTextHighlight // (COLORREF) DWord clrBtnFace // (COLORREF) DWord clrBtnHighlight // (COLORREF) DWord clrHighlightHotTrack // (COLORREF) tWinRect rcText // (RECT) Integer nStringBkMode // (int) Integer nHLStringBkMode // (int) End_Struct Struct tLOGFONT Integer lfHeight // (LONG) Integer lfWidth // (LONG) Integer lfEscapement // (LONG) Integer lfOrientation // (LONG) Integer lfWeight // (LONG) UChar lfItalic // (BYTE) UChar lfUnderline // (BYTE) UChar lfStrikeOut // (BYTE) UChar lfCharSet // (BYTE) UChar lfOutPrecision // (BYTE) UChar lfClipPrecision // (BYTE) UChar lfQuality // (BYTE) UChar lfPitchAndFamily // (BYTE) UChar[32] lfFaceName // (TCHAR) End_Struct // For creating a font with CreateFontIndirect Class CFontMixin Is a Mixin // Insert your Properties here. Procedure Define_CFontMixin // Font Properties... Property Integer plfHeight 0 Property Integer plfWidth 0 Property Integer plfEscapement 0 Property Integer plfOrientation 0 Property Integer plfWeight 0 Property Integer plfItalic 0 Property Integer plfUnderline 0 Property Integer plfStrikeOut 0 Property Integer plfCharSet 0 Property Integer plfOutPrecision 0 Property Integer plfClipPrecision 0 Property Integer plfQuality 0 Property Integer plfPitchAndFamily 0 Property String plfFaceName "" End_Procedure Function CreateTheFont Returns Handle Handle hFont tLOGFONT wLOGFONT Move (plfHeight (Self)) to wLOGFONT.lfHeight Move (plfWidth (Self)) to wLOGFONT.lfWidth Move (plfEscapement (Self)) to wLOGFONT.lfEscapement Move (plfOrientation (Self)) to wLOGFONT.lfOrientation Move (plfWeight (Self)) to wLOGFONT.lfWeight Move (plfItalic (Self)) to wLOGFONT.lfItalic Move (plfUnderline (Self)) to wLOGFONT.lfUnderline Move (plfStrikeOut (Self)) to wLOGFONT.lfStrikeOut Move (plfCharSet (Self)) to wLOGFONT.lfCharSet Move (plfOutPrecision (Self)) to wLOGFONT.lfOutPrecision Move (plfClipPrecision (Self)) to wLOGFONT.lfClipPrecision Move (plfQuality (Self)) to wLOGFONT.lfQuality Move (plfPitchAndFamily(Self)) to wLOGFONT.lfPitchAndFamily Move (StringToUCharArray(plfFaceName(Self))) to wLOGFONT.lfFaceName Move (CreateFontIndirect(AddressOf(wLOGFONT))) to hFont Function_Return hFont End_Function End_Class Define CDDS_PREPAINT For |CI$00000001 Define CDDS_POSTPAINT For |CI$00000002 Define CDDS_PREERASE For |CI$00000003 Define CDDS_POSTERASE For |CI$00000004 Define CDDS_ITEM For |CI$00010000 Define CDDS_ITEMPREPAINT For (CDDS_ITEM + CDDS_PREPAINT) Define CDDS_ITEMPOSTPAINT For (CDDS_ITEM + CDDS_POSTPAINT) Define CDDS_ITEMPREERASE For (CDDS_ITEM + CDDS_PREERASE) Define CDDS_ITEMPOSTERASE For (CDDS_ITEM + CDDS_POSTERASE) Define CDRF_DODEFAULT For |CI$00000000 Define CDRF_NEWFONT For |CI$00000002 Define CDRF_SKIPDEFAULT For |CI$00000004 Define CDRF_NOTIFYPOSTPAINT For |CI$00000010 Define CDRF_NOTIFYITEMDRAW For |CI$00000020 Define CDIS_SELECTED For |CI$0001 Define CDIS_GRAYED For |CI$0002 Define CDIS_DISABLED For |CI$0004 Define CDIS_CHECKED For |CI$0008 Define CDIS_FOCUS For |CI$0010 Define CDIS_DEFAULT For |CI$0020 Define CDIS_HOT For |CI$0040 Define CDIS_MARKED For |CI$0080 Define CDIS_INDETERMINATE For |CI$0100 Define CCM_SETCOLORSCHEME For (CCM_FIRST + 2) // lParam is color scheme Define CCM_GETCOLORSCHEME For (CCM_FIRST + 3) // fills in COLORSCHEME pointed Define CLR_NONE For |CI$FFFFFFFF Define CLR_DEFAULT For |CI$FF000000 Class cRealToolBarImageList Is a cImageList Procedure Construct_Object Forward Send Construct_Object Property Integer piImageListType ILC_COLORDDB Set piImageHeight To 16 Set piImageWidth To 16 End_Procedure Procedure DoCreate Integer cx cy dwFlags icInitial iGrowBy iColor Get piImageHeight To cy Get piImageWidth To cx Get piMaxImages To iGrowBy Get piImageListType To iColor Move (iColor+ILC_MASK) To dwFlags Set phImageList To (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy)) End_Procedure End_Class Class CRealToolBar Is a cToolBar Procedure Construct_Object Forward Send Construct_Object Property Integer piclrBtnHighlight CLR_DEFAULT Property Integer piclrBtnShadow CLR_DEFAULT Property Integer piBkColor CLR_DEFAULT Property Integer piBkBrushStyle BS_SOLID Property Integer piBkHatchStyle 0 Property String psBkPatternBmp "" Property Integer piTextColor CLR_DEFAULT Property Integer piTextHighlightColor CLR_DEFAULT // Property Handle phBackgroundBrush Public 0 Property String psToolBarName "ToolBar" Property Integer Loaded_State False End_Procedure Procedure Notify Longptr wParam Longptr lParam Integer iCode iRet iLeft iTop iRight iBottom iItemState iTextColor Handle hDC hBrush hBitmap hFont Integer iDrawStage String sBmp tWinRect wRect tWinNmHdr NmHdr tNMTBCUSTOMDRAW NMCUSTOMDRAWINFO Move 0 To NmHdr.hWndFrom Move (CopyMemory(AddressOf(NmHdr),lParam,SizeOfType(tWinNmHdr))) To iRet Move NMHDR.Code To iCode // Customdraw..._______________ If (iCode=NM_CUSTOMDRAW) Begin Move 0 To NMCUSTOMDRAWINFO.hdc Move (CopyMemory(AddressOf(NMCUSTOMDRAWINFO),lParam,SizeOfType(tNMTBCUSTOMDRAW))) To iRet Move NMCUSTOMDRAWINFO.dwDrawStage To iDrawStage Move NMCUSTOMDRAWINFO.uItemState To iItemState If (iDrawStage=CDDS_PREPAINT) Procedure_Return (CDRF_NOTIFYITEMDRAW) If (iDrawStage=CDDS_ITEMPREPAINT) Begin // Here we can change the colors and fonts and whatever. Move NMCUSTOMDRAWINFO.hdc To hDC // Showln "ItemState: " iItemState // Either take texcolor or hottextcolor Move (piTextColor(Self)) To iTextColor If (iItemState Iand CDIS_HOT) If (piTextHighlightColor(Self)) Ne CLR_DEFAULT Move (piTextHighlightColor(Self)) To iTextColor // Change the Textcolor of the ToolBar, but only if not default. If iTextColor Ne CLR_DEFAULT Begin Move iTextColor To NMCUSTOMDRAWINFO.clrText // Put CDIS_HOT to sNMCUSTOMDRAWINFO at tNMTBCUSTOMDRAW.uItemState Move (CopyMemory(lParam,AddressOf(NMCUSTOMDRAWINFO),SizeOfType(tNMTBCUSTOMDRAW))) To iRet End // Draw a Rect with the backgroundcolor, we want, but only if not default! Move (psBkPatternBmp(Self)) To sBmp Get_File_Path sBmp To sBmp // Create a RECT structure. Move NMCUSTOMDRAWINFO.rc.Left To iLeft Move NMCUSTOMDRAWINFO.rc.top To iTop Move NMCUSTOMDRAWINFO.rc.Right To iRight Move NMCUSTOMDRAWINFO.rc.bottom To iBottom // Showln "Graph: " (GetMapMode(hDC)) // Showln (Low(DFGetDCOrgEx(hDC))) " / " (Hi(DFGetDCOrgEx(hDC))) // Showln iLeft " / " iRight " / " iTop " / " iBottom // Showln (SetBrushOrgEx(hDC,0,0,0)) Move (SetBrushOrgEx(hDC,0,0,0)) To iRet // Needed becouse there is a little bug in ownerdraw which is changing this o Move (iLeft +2) to wRECT.Left Move (iTop +2) to wRECT.Top Move (iRight -2) to wRECT.Right Move (iBottom-2) to wRECT.Bottom If sBmp Ne "" Begin // Bitmap Pattern in the brush. Move (LoadImage(0, sBmp, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) To hBitmap Move (DFCreateBrushIndirect(BS_PATTERN,0,hBitmap)) To hBrush Move (FillRect(hDC,AddressOf(wRect),hBrush)) to iRet Move (DeleteObject(hBrush)) To iRet If hBitmap Gt 0 Move (DeleteObject(hBitmap)) To iRet End Else If ((piBkColor(Self)) Ne CLR_DEFAULT) Begin // SOLID Brush with background color Move (DFCreateBrushIndirect(piBkBrushStyle(Self),piBkColor(Self),piBkHatchStyle(Self))) To hBrush Move (FillRect(hDC,AddressOf(wRect),hBrush)) to iRet Move (DeleteObject(hBrush)) To iRet End End End Forward Send Notify wParam lParam End_Procedure // Sets the Properties within the WIndows ToolBar Procedure SetColorSchemeInt Integer iHighlightColor iShadowColor Integer iRet Handle hwnd tCOLORSCHEME COLORSCHEME Get piclrBtnHighlight To iHighlightColor Get piclrBtnShadow To iShadowColor Move (SizeOfType(tCOLORSCHEME)) To COLORSCHEME.dwSize Move iHighlightColor To COLORSCHEME.clrBtnHighlight Move iShadowColor To COLORSCHEME.clrBtnShadow Move (window_Handle(Self)) To hwnd Move (SendMessage(hwnd,TB_SETCOLORSCHEME,0,AddressOf(COLORSCHEME))) To iRet End_Procedure // Sets the properties and if already paged updates them inside the ToolBar. Procedure Set ColorScheme Integer iHighlightColor Integer iShadowColor Set piclrBtnHighlight To iHighlightColor Set piclrBtnShadow To iShadowColor If (Window_Handle(Self)) Send SetColorSchemeInt End_Procedure // Set the colors schema after the Window was created. Function mName String sObj Returns String Integer iPos String sName Move "" To sName If (sObj<>"") Begin While (Pos(".",sObj)<>0) Move (Pos(".",sObj)) To iPos Move (Left(sObj,iPos)) To sName Move (Replace(sName,sObj,"")) To sObj Loop Move sObj To sName End Function_Return sName End_Function Procedure Load_Registry Integer iHLC iLbl Integer icButton iButton hoButton iVisible iStyle String sName // Get Load_Options "HotTrack" To iHLC // If (iHLC) Set piTextHighlightColor To CREALTOOLBAR_HOTCOLOR // Else Set piTextHighlightColor To CLR_DEFAULT // Get Load_Options "ShowLabels" To iLbl // Set pbShowLabels To (Not(iLbl)) Get NumberOfButtons To icButton For iButton From 0 To (icButton -1) Get ObjectFromIndex Of (phoButtons(Self)) iButton To hoButton Get mName (name(hoButton)) To sName Get Load_Options sName To iVisible If (Not(iVisible)) Set pbVisible Of hoButton To True Else Set pbVisible Of hoButton To False Get peStyle Of hoButton To iStyle If (iStyle<>bsSeparator) Set pbEnabled Of hoButton To True Loop Set Loaded_State To True End_Procedure Procedure Paint Forward Send Paint If (NumberOfButtons(Self)) Begin If (Not(Loaded_State(Self))) Send Load_Registry End End_Procedure Procedure RefreshToolBar End_Procedure Procedure mName String sObj Get mName (Name(Self)) To sObj If (sObj<>"") Set psToolBarName To sObj End_Procedure Procedure Page Integer iFlag Forward Send Page iFlag Send SetColorSchemeInt Send mName End_Procedure Procedure Save_Options String sProfile String sData String sKey Get_Profile_String "WorkSpaces" "CurrentWorkspace" To sKey Set_Profile_String ("WorkSpaces\"+sKey+"\"+CREALTOOLBAR_REGISTRY+"\"+(psToolBarName(Self))) sProfile To sData End_Procedure Function Load_Options String sProfile Returns String String sKey sData Get_Profile_String "WorkSpaces" "CurrentWorkspace" To sKey Get_Profile_String ("WorkSpaces\"+sKey+"\"+CREALTOOLBAR_REGISTRY+"\"+(psToolBarName(Self))) sProfile To sData Function_Return sData End_Function // Procedure End_Construct_Object // Local Integer iHLC iLbl // Get Load_Options "HotTrack" To iHLC // If (iHLC) Set piTextHighlightColor To CREALTOOLBAR_HOTCOLOR // Else Set piTextHighlightColor To CLR_DEFAULT // Get Load_Options "ShowLabels" To iLbl // Set pbShowLabels To (Not(iLbl)) // Forward Send End_Construct_Object // End_Procedure End_Class