$OPTION EXPLICIT
DIM custBG AS QBITMAP
DIM custGrip AS QBITMAP
$IFNDEF __RQINC
$IFNDEF __RQINCTMP
$DEFINE __RQINCTMP
CONST False = 0
CONST True = 1
CONST clBtnFace = -2147483633
CONST clHilight = -2147483635
CONST clGrayText = -2147483631
CONST clBtnText = -2147483630
CONST clPurple = &HFF00FF
CONST pf15bit = 4
$ENDIF
$ENDIF
CONST rqNullChr_CBar = CHR$(0)
CONST DefPixelFormat_CBar = 4
$IFNDEF __QTBTNSHARED95
$DEFINE __QTBTNSHARED95
DECLARE FUNCTION GetDC_QTBtn LIB "user32" _
ALIAS "GetDC" _
(BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION ReleaseDC_QTBtn LIB "user32" _
ALIAS "ReleaseDC" ( _
BYVAL hwnd AS LONG, _
BYVAL hdc AS LONG) AS LONG
CONST SrcCopy_QTBtn = &HCC0020
DECLARE FUNCTION BitBlt_QTBtn LIB "gdi32" _
ALIAS "BitBlt" ( _
hDC AS INTEGER, _
nXDest AS INTEGER, nYDest AS INTEGER, _
nWidth AS INTEGER, nHeight AS INTEGER, _
hdcSrc AS INTEGER, _
nXSrc AS INTEGER, nYSrc AS INTEGER, _
dwRop AS INTEGER) AS INTEGER
DECLARE FUNCTION TransparentBlt_QTBtn LIB "msimg32" _
ALIAS "TransparentBlt" ( _
BYVAL hdcDest AS LONG, _
BYVAL nXOriginDest AS LONG, BYVAL nYOriginDest AS LONG, _
BYVAL nWidthDest AS LONG, BYVAL nHeightDest AS LONG, _
BYVAL hdcSrc AS LONG, _
BYVAL nXOriginSrc AS LONG, BYVAL nYOriginSrc AS LONG, _
BYVAL nWidthSrc AS LONG, BYVAL nHeightSrc AS LONG, _
BYVAL crTransparent AS LONG) AS LONG
$ENDIF
$IFNDEF __RQOBJDRAWING
$DEFINE __RQOBJDRAWING
DECLARE FUNCTION SetCapture_QTBtn LIB "user32" ALIAS "SetCapture" _
(BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION ReleaseCapture_QTBtn LIB "user32" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION GetCapture_QTBtn LIB "user32" ALIAS "GetCapture" () AS LONG
TYPE RECT_QTBtn
Left AS LONG
Top AS LONG
Right AS LONG
Bottom AS LONG
END TYPE
CONST DT_SINGLELINE_QTBtn AS LONG = &H20
CONST DT_CENTER_QTBtn = &H1
CONST DT_VCENTER_QTBtn AS LONG = &H4
DECLARE FUNCTION DrawText_QTBtn LIB "user32" ALIAS "DrawTextA" ( _
BYVAL hdc AS LONG, _
BYVAL lpStr AS STRING, _
BYVAL nCount AS LONG, _
lpRect AS RECT_QTBtn, _
BYVAL wFormat AS LONG) AS LONG
DECLARE FUNCTION SetBkMode_QTBtn LIB "gdi32" _
ALIAS "SetBkMode" ( _
BYVAL hdc AS LONG, _
BYVAL nBkMode AS LONG) AS LONG
DECLARE FUNCTION OpenThemeData_QTBtn LIB "uxtheme.dll" ALIAS "OpenThemeData" ( _
BYVAL hwnd AS LONG, _
BYVAL pszClassList AS LONG) AS LONG
DECLARE FUNCTION CloseThemeData_QTBtn LIB "uxtheme.dll" ALIAS "CloseThemeData" ( _
BYVAL hTheme AS LONG) AS LONG
DECLARE FUNCTION DrawThemeBackground_QTBtn LIB "uxtheme.dll" ALIAS "DrawThemeBackground" ( _
BYVAL hTheme AS LONG, _
BYVAL hdc AS LONG, _
BYVAL iPartID AS LONG, _
BYVAL iStateID AS LONG, _
pRect AS RECT_QTBtn, _
pClipRect AS RECT_QTBtn) AS LONG
CONST xpt_PushBtn = "Button"
CONST xpt_ToolBarBtn = "Toolbar"
CONST xpt_TabBtn = "Tab"
$ENDIF
CONST xpt_ReBar = "ReBar"
$IFNDEF __RQGETVERSION
$DEFINE __RQGETVERSION
DIM isXP_QTBtn AS INTEGER
isXP_QTBtn = False
TYPE OSVERSIONINFO_QTBtn
dwOSVersionInfoSize AS LONG
dwMajorVersion AS LONG
dwMinorVersion AS LONG
dwBuildNumber AS LONG
dwPlatformId AS LONG
szCSDVersion AS STRING *128
END TYPE
DECLARE FUNCTION GetVersionEx_QTBtn LIB "kernel32.dll" ALIAS "GetVersionExA" _
(BYVAL lpVersionInformation AS LONG) AS LONG
DIM rtn_QTBtn AS LONG
DIM OSV_QTBtn AS OSVERSIONINFO_QTBtn, Mem_QTBtn AS QMEMORYSTREAM
DIM PixelFormatFix_QTBtn AS INTEGER
PixelFormatFix_QTBtn = pf15bit
SUB GetVersion_QTBtn
OSV_QTBtn.dwOSVersionInfoSize = SIZEOF(OSV_QTBtn)
Mem_QTBtn.WriteUDT(OSV_QTBtn)
rtn_QTBtn = GetVersionEx_QTBtn(Mem_QTBtn.Pointer)
IF rtn_QTBtn <> False THEN
Mem_QTBtn.Position = False
Mem_QTBtn.ReadUDT(OSV_QTBtn)
IF OSV_QTBtn.dwPlatformId = True THEN
isXP_QTBtn = False
ELSEIF OSV_QTBtn.dwPlatformId = 2 THEN
IF OSV_QTBtn.dwMajorVersion = 5 THEN _
IF OSV_QTBtn.dwMinorVersion = True THEN _
isXP_QTBtn = True
END IF
END IF
Mem_QTBtn.CLOSE
END SUB
CALL GetVersion_QTBtn
$ENDIF
DIM maxNumBMPs_CBar AS INTEGER
maxNumBMPs_CBar = 5
CONST BDR_SUNKENOUTER_CBar = &H2
CONST BDR_RAISEDINNER_CBar = &H4
CONST BF_LEFT_CBar = &H1
CONST BF_TOP_CBar = &H2
CONST BF_RIGHT_CBar = &H4
CONST BF_BOTTOM_CBar = &H8
CONST BF_RECT_CBar = (BF_LEFT_CBar OR BF_TOP_CBar OR BF_RIGHT_CBar OR BF_BOTTOM_CBar)
CONST BF_FLAT_CBar = &H4000
DECLARE FUNCTION DrawEdge_CBar LIB "user32" ALIAS "DrawEdge" ( _
BYVAL hdc AS LONG, _
qrc AS RECT_QTBtn, _
BYVAL edge AS LONG, _
BYVAL grfFlags AS LONG) _
AS LONG
DECLARE FUNCTION SetRect_CBar LIB "user32" ALIAS "SetRect" ( _
lpRect AS RECT_QTBtn, _
BYVAL X1 AS LONG, BYVAL Y1 AS LONG, _
BYVAL X2 AS LONG, BYVAL Y2 AS LONG) _
AS LONG
SUB Fast_CBar( _
BtnType AS STRING, _
PartID AS INTEGER, _
StateID AS INTEGER, _
Me AS QBITMAP, _
CAPTION AS STRING, _
IcoWidth AS INTEGER, _
FontName AS INTEGER, _
wMenu AS INTEGER, _
Grouped AS INTEGER, _
Style AS INTEGER, _
DisableXPTheme AS INTEGER, _
Hwnd AS LONG)
DIM Dest AS QRECT, Source AS QRECT
DIM tR AS RECT_QTBtn
DIM fixTab AS INTEGER
fixTab = False
IF isXP_QTBtn AND DisableXPTheme = False THEN
IF BtnType = xpt_TabBtn THEN _
fixTab = True
IF BtnType = xpt_pushbtn OR BtnType = xpt_toolbarbtn OR BtnType = xpt_TabBtn THEN _
PartID = True
END IF
Me.FillRect(False, False, Me.Width, Me.Height, clBtnFace)
IF FontName <> "" THEN _
SWAP (Me.Font.Name, FontName)
IF isXP_QTBtn = False OR DisableXPTheme = True THEN
IF StateID > False THEN
IF Style THEN
Me.Rectangle( True, _
True, _
Me.Width, _
Me.Height, _
-2147483632)
Me.FillRect( 2, _
2, _
Me.Width -True, _
Me.Height -True, _
-2147483638)
ELSE
SetRect_CBar ( tR, _
True, _
True, _
Me.Width, _
Me.Height)
IF StateID = True THEN
DrawEdge_CBar (Me.Handle, tR, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
ELSE
DrawEdge_CBar (Me.Handle, tR, BDR_SUNKENOUTER_CBar, BF_RECT_CBar)
END IF
END IF
IF StateID = 2 OR StateID = 4 THEN
Me.FillRect( 2, _
2, _
Me.Width -True, _
Me.Height -True, _
-2147483628)
Me.Pixel(3, 3) = Me.Pixel(3, 3) -RGB(8, 11, 28)
Me.FillRect( 2, _
2, _
Me.Width -True, _
Me.Height -True, _
Me.Pixel(3, 3))
END IF
END IF
IF wMenu > False THEN
DIM bFont AS STRING
bFont = "Marlett"
IF Style THEN
Me.FillRect(Me.Width -11, _
2, _
Me.Width -True, _
Me.Height -True, _
IIF(StateID = False, clBtnFace, &HFFFFFF))
ELSE
IF StateID +True >= 3 AND wMenu < 2 THEN
SetRect_CBar ( tR, _
Me.Width -11, 2, _
Me.Width -11, Me.Height)
ELSE
SetRect_CBar ( tR, _
Me.Width -12, True, _
Me.Width -12, Me.Height)
END IF
DrawEdge_CBar (Me.Handle, tR, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
END IF
SWAP (Me.Font.Name, bFont)
tR.Left = Me.Width -11 +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
tR.Top = False +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
tR.Right = Me.Width +IIF(StateID +True >= 3 AND wMenu < 2, True, False)
tR.Bottom = Me.Height
SetBkMode_QTBtn Me.Handle, True
IF StateID = 3 THEN
Me.Font.COLOR = -2147483628
tR.Left = tR.Left +True
tR.Top = tR.Top +True
DrawText_QTBtn (Me.Handle, "6", True, _
tR, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
tR.Left = tR.Left -True
tR.Top = tR.Top -True
Me.Font.COLOR = clGrayText
END IF
DrawText_QTBtn (Me.Handle, "6", True, _
tR, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
SWAP (Me.Font.Name, bFont)
END IF
ELSE
DIM hTheme AS LONG
DIM rtButton AS STRING
rtButton = ""
DIM lR AS LONG
DIM m_hDC AS LONG
DIM m_lPartId AS LONG, m_lStateId AS LONG
DIM I AS INTEGER
FOR I = True TO LEN(BtnType)
rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr_CBar
NEXT I
rtButton = rtButton +rqNullChr_CBar
hTheme = OpenThemeData_QTBtn(Hwnd, VARPTR(rtButton))
IF hTheme <> False THEN
m_hDC = Me.Handle
DIM mLeft AS INTEGER
mLeft = False
IF wMenu > False THEN
m_lPartId = 3
mLeft = 11
ELSEIF PartID > True THEN
m_lPartId = PartID
ELSE
m_lPartId = True
END IF
m_lStateId = StateID +True
IF wMenu = 2 THEN _
m_lStateId --
tR.Left = False
tR.Top = True
tR.Right = Me.Width -mLeft
tR.Bottom = Me.Height
lR = DrawThemeBackground_QTBtn(hTheme, _
m_hDC, _
m_lPartId, _
m_lStateId, _
tR, tR)
IF wMenu > False THEN
m_lPartId = 4
IF wMenu = 2 THEN _
m_lStateId ++
tR.Left = Me.Width -11
tR.Top = True
tR.Right = Me.Width
tR.Bottom = Me.Height
lR = DrawThemeBackground_QTBtn(hTheme, _
m_hDC, _
m_lPartId, _
m_lStateId, _
tR, tR)
END IF
END IF
CloseThemeData_QTBtn hTheme
CloseThemeData_QTBtn hTheme
END IF
IF CAPTION <> "" THEN
IF IcoWidth > False THEN IcoWidth = IcoWidth +4
SetBkMode_QTBtn Me.Handle, True
tR.Left = False +IIF(StateID +True >= 3 AND wMenu < 2, True, False) +IcoWidth
tR.Top = False +IIF(StateID +True >= 3 AND wMenu < 2, 2, False) +fixTab
tR.Right = Me.Width +tR.Left -IcoWidth
tR.Bottom = Me.Height
IF StateID = 3 THEN
Me.Font.COLOR = -2147483628
tR.Left = tR.Left +True
tR.Top = tR.Top +True
DrawText_QTBtn (Me.Handle, CAPTION, LEN(CAPTION), _
tR, IIF(IcoWidth > False, False, DT_CENTER_QTBtn) OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
tR.Left = tR.Left -True
tR.Top = tR.Top -True
Me.Font.COLOR = clGrayText
END IF
DrawText_QTBtn (Me.Handle, CAPTION, LEN(CAPTION), _
tR, IIF(IcoWidth > False, False, DT_CENTER_QTBtn) OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
END IF
IF FontName <> "" THEN _
SWAP (Me.Font.Name, FontName)
IF PartID <> True THEN _
PartID = True
END SUB
SUB XPPart ( _
BtnType AS STRING, _
PartID AS INTEGER, _
Orientation AS INTEGER, _
DisableXPThemeBG AS INTEGER, _
COLOR, _
Me AS QBITMAP, _
hWnd AS LONG)
IF isXP_QTBtn THEN
IF DisableXPThemeBG OR PartID <> 6 THEN _
Me.FillRect(False, False, Me.Width, Me.Height, COLOR)
DIM hTheme AS LONG
DIM rtButton AS STRING
rtButton = ""
DIM I AS INTEGER
FOR I = True TO LEN(BtnType)
rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr_CBar
NEXT I
rtButton = rtButton +rqNullChr_CBar
hTheme = OpenThemeData_QTBtn(hWnd, VARPTR(rtButton))
IF hTheme <> False THEN
DIM lR AS LONG
DIM m_hDC AS LONG
DIM m_lPartId AS LONG, m_lStateId AS LONG
DIM tR AS RECT_QTBtn
m_hDC = Me.Handle
IF PartID > True THEN _
m_lPartId = PartID _
ELSE _
m_lPartId = True
m_lStateId = True
IF PartID =< 2 THEN
IF Orientation THEN _
SetRect_CBar (tR, True, False, Me.Width -True, 8) _
ELSE _
SetRect_CBar (tR, False, True, 5, Me.Height -True)
ELSE
SetRect_CBar (tR, False, False, Me.Width, Me.Height)
END IF
lR = DrawThemeBackground_QTBtn(hTheme, _
m_hDC, _
m_lPartId, _
m_lStateId, _
tR, tR)
END IF
CloseThemeData_QTBtn hTheme
CloseThemeData_QTBtn hTheme
END IF
END SUB
CONST AC_SRC_OVER_CBar = &H00
TYPE BLENDFUNCTION_CBar
BlendOp AS BYTE
BlendFlags AS BYTE
SourceConstantAlpha AS BYTE
AlphaFormat AS BYTE
END TYPE
DECLARE FUNCTION AlphaBlend_CBar LIB "msimg32" ALIAS "AlphaBlend" ( _
BYVAL hdcDest AS LONG, _
BYVAL xDest AS LONG, _
BYVAL yDest AS LONG, _
BYVAL WidthDest AS LONG, _
BYVAL HeightDest AS LONG, _
BYVAL hdcSrc AS LONG, _
BYVAL xSrc AS LONG, _
BYVAL ySrc AS LONG, _
BYVAL WidthSrc AS LONG, _
BYVAL HeightSrc AS LONG, _
ByRef Blendfunc AS BLENDFUNCTION_CBar) AS LONG
DECLARE SUB RtlMoveMemory_CBar LIB "kernel32.dll" ALIAS "RtlMoveMemory" ( _
byref Destination AS LONG, _
byref Source AS BLENDFUNCTION_CBar, _
Length AS LONG)
DIM BF_CBar AS BLENDFUNCTION_CBar, _
lBF_CBar AS LONG
DECLARE FUNCTION GetWindowRect_CBar LIB "user32" ALIAS "GetWindowRect" ( _
BYVAL hwnd AS LONG, _
ByRef lpRect AS RECT_QTBtn ) AS LONG
DECLARE FUNCTION PtInRect_CBar LIB "user32" ALIAS "PtInRect" ( _
ByRef lpRect AS RECT_QTBtn, _
BYVAL x AS LONG, BYVAL y AS LONG ) AS LONG
CONST TPM_LEFTBUTTON_CBar = &H0
CONST TPM_RIGHTBUTTON_CBar = &H2
CONST TPM_RETURNCMD_CBar AS LONG = &H100&
CONST TPM_NOANIMATION_CBar AS LONG = &H4000&
DECLARE FUNCTION TrackPopupMenuEx_CBar LIB "user32" ALIAS "TrackPopupMenuEx" ( _
BYVAL hMenu AS LONG, _
BYVAL wFlags AS LONG, _
BYVAL x AS LONG, BYVAL y AS LONG, _
BYVAL hWnd AS LONG, _
BYVAL lptpm AS LONG) AS LONG
CONST SWP_NOSIZE_CBar = &H1
CONST SWP_NOACTIVATE_CBar = &H10
CONST SWP_NOZORDER_CBar = &H4
DECLARE SUB SetWindowPos_CBar LIB "user32" ALIAS "SetWindowPos" ( _
BYVAL hWnd AS LONG, _
BYVAL hWndInsertAfter AS LONG, _
BYVAL X AS LONG, BYVAL Y AS LONG, _
BYVAL cx AS LONG, BYVAL cy AS LONG, _
BYVAL wFlags AS LONG)
CONST HTCAPTION_CBar = 2
CONST WM_NCLBUTTONDOWN_CBar = &HA1
DECLARE FUNCTION SendMessage_CBar LIB "user32" ALIAS "SendMessageA" ( _
BYVAL hwnd AS LONG, _
BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, _
lParam AS LONG) AS LONG
CONST VK_LBUTTON_CBar AS LONG = &H1
DECLARE FUNCTION GetAsyncKeyState_CBar LIB "user32" _
ALIAS "GetAsyncKeyState" ( _
BYVAL vKey AS LONG) _
AS INTEGER
DIM BMPCache AS QBITMAP
DIM mnuItemExceed(False) AS QMENUITEM
DIM CB_ItemCount AS INTEGER
CB_ItemCount = False
SUB RedimCBItems
REDIM mnuItemExceed(CB_ItemCount) AS QMENUITEM
END SUB
DECLARE SUB CBarOnMouseEnter_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, ItemIndex AS INTEGER, Me AS QPANEL)
DECLARE SUB CBarOnMouseLeave_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Me AS QPANEL)
DECLARE SUB CBarOnChange_EventTemplate (ItemIndex AS INTEGER, Me AS QPANEL)
TYPE QCoolBarXP EXTENDS QPANEL
PUBLIC:
ItemCount AS INTEGER
ItemsWidth AS INTEGER
Item(29) AS STRING
imgLA AS QIMAGELIST
PRIVATE:
DragTimer AS QTIMER
FreePanelL AS QPANEL
FreePanelM AS QPANEL
FreePanelR AS QPANEL
BtnCache AS QBITMAP
CanvasL AS QCANVAS
CanvasR AS QCANVAS
CanvasLMsg AS INTEGER
ImageL AS QIMAGE
ImageR AS QIMAGE
ImageLH AS QIMAGE
ImageRH AS QIMAGE
CoolBtnBMP AS QBITMAP
CoolBtnBMPE AS QBITMAP
ItemLeft(6) AS INTEGER
ItemWidth(6) AS INTEGER
ShowBtnCapt(6) AS INTEGER
ShowBtnCaptAll AS INTEGER
LastItemLeft AS INTEGER
LastItemTop AS INTEGER
ItemGroup(6) AS INTEGER
GroupAllowAllUp(6) AS INTEGER
ItemEnabled(6) AS INTEGER
ItemDown(6) AS INTEGER
wasHideGrip AS INTEGER
wasHideCaption AS INTEGER
GripWidth AS INTEGER
GripHeight AS INTEGER
CaptionWidth AS INTEGER
CaptionHeight AS INTEGER
isExceedWidth AS INTEGER
isExceedHeight AS INTEGER
isPaintReady AS INTEGER
ForceRePaint AS INTEGER
ForceEvalPos AS INTEGER
BMPCache2 AS QBITMAP
ItemPopupHnd(6) AS LONG
mnuExceed AS QPOPUPMENU
mnuItemExceedIndex(6) AS INTEGER
mnuItemCount AS INTEGER
ED_Count AS INTEGER
ED_Ctrl(6) AS LONG
ED_AfterIndex(6) AS INTEGER
ED_Left(6) AS INTEGER
ED_Width(6) AS INTEGER
ED_Height(6) AS INTEGER
CB_Count AS INTEGER
CB_Ctrl(6) AS LONG
CB_AfterIndex(6) AS INTEGER
CB_Left(6) AS INTEGER
CB_Width(6) AS INTEGER
CB_Height(6) AS INTEGER
PUBLIC:
DisableXPTheme AS INTEGER
DisableXPThemeBG AS INTEGER
DisableBG AS INTEGER
Style AS INTEGER
HideGrip AS INTEGER PROPERTY SET SetHideGrip
HideCaption AS INTEGER PROPERTY SET SetHideCaption
CAPTION AS STRING PROPERTY SET SetCaption
Orientation AS INTEGER PROPERTY SET SetOrientation
BorderStyle AS INTEGER PROPERTY SET SetBorderStyle
OnChange AS EVENT(CBarOnChange_EventTemplate)
WITH This
PRIVATE:
FUNCTION TextWidth(text AS STRING) AS INTEGER: Result = .BtnCache.TextWidth(text)
END FUNCTION
FUNCTION TextHeight(text AS STRING) AS INTEGER: Result = .BtnCache.TextHeight(text)
END FUNCTION
SUB pShowPopup (iPopup AS LONG, X AS INTEGER, Y AS INTEGER)
DIM sMenu AS LONG
DIM sStyle AS LONG
sStyle = TPM_RETURNCMD_CBar
$IFNDEF __RQGETVERSION2
sStyle = sStyle OR TPM_LEFTBUTTON_CBar OR TPM_RIGHTBUTTON_CBar
$ELSE
sStyle = sStyle OR TPM_LEFTBUTTON_CBar OR TPM_RIGHTBUTTON_CBar OR TPM_NOANIMATION_CBar
$ENDIF
sMenu = TrackPopupMenuEx_CBar( _
.ItemPopupHnd(iPopup), _
sStyle, _
X, Y, _
This.Handle, 0&)
END SUB
SUB EvalBtnPos
IF ((.wasHideGrip <> .HideGrip) OR (.wasHideCaption <> .HideCaption) OR .ForceEvalPos) AND _
.ItemCount > False THEN
.ItemLeft(False) = False
.ItemWidth(False) = False
DIM I AS INTEGER
DIM SepBefore AS INTEGER
FOR I = False TO .ItemCount -True
IF .Item(I) = "-" THEN
.ItemWidth(I) = 5
SepBefore ++
ELSE
.ItemWidth(I) = .ItemsWidth
IF .imgLA.Count > False AND (I -SepBefore < .imgLA.Count) THEN
.ItemWidth(I) = .imgLA.Width +8 +_
IIF(.Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True), _
.TextWidth(.Item(I)) +4, _
False) +_
IIF(.ItemPopupHnd(I), 12, False)
END IF
END IF
NEXT I
SepBefore = False
IF .HideGrip = False THEN _
.ItemLeft(False) = .ItemLeft(False) +8
IF .HideCaption = False AND .CAPTION <> "" THEN _
.ItemLeft(False) = .ItemLeft(False) +.CaptionWidth +4
.wasHideGrip = .HideGrip
.wasHideCaption = .HideCaption
DIM J AS INTEGER
IF .ED_Count > False THEN
FOR J = False TO .ED_Count -True
IF .ED_AfterIndex(J) = -True THEN
.ED_Left(J) = .ItemLeft(False)
.ItemLeft(False) = .ItemLeft(False) +.ED_Width(J) +6
EXIT FOR
END IF
NEXT J
END IF
IF .CB_Count > False THEN
FOR J = False TO .CB_Count -True
IF .CB_AfterIndex(J) = -True THEN
.CB_Left(J) = .ItemLeft(False)
.ItemLeft(False) = .ItemLeft(False) +.CB_Width(J) +6
EXIT FOR
END IF
NEXT J
END IF
FOR I = False TO .ItemCount -True
.ItemLeft(I +True) = .ItemLeft(I) +.ItemWidth(I)
IF .ED_Count > False THEN
FOR J = False TO .ED_Count -True
IF .ED_AfterIndex(J) = I THEN
.ED_Left(J) = .ItemLeft(I +True)
.ItemLeft(I +True) = .ItemLeft(I +True) +.ED_Width(J) +6
SetWindowPos_CBar (.ED_Ctrl(J), False, _
.ED_Left(J), (.FreePanelL.Height -.ED_Height(J)) \2, _
False, False, _
SWP_NOACTIVATE_CBar OR SWP_NOSIZE_CBar OR SWP_NOZORDER_CBar)
EXIT FOR
END IF
NEXT J
END IF
IF .CB_Count > False THEN
FOR J = False TO .CB_Count -True
IF .CB_AfterIndex(J) = I THEN
.CB_Left(J) = .ItemLeft(I +True)
.ItemLeft(I +True) = .ItemLeft(I +True) +.CB_Width(J) +6
SetWindowPos_CBar (.CB_Ctrl(J), False, _
.CB_Left(J), (.FreePanelL.Height -.CB_Height(J)) \2, _
False, False, _
SWP_NOACTIVATE_CBar OR SWP_NOSIZE_CBar OR SWP_NOZORDER_CBar)
EXIT FOR
END IF
NEXT J
END IF
NEXT I
END IF
IF .Orientation THEN
.LastItemLeft = False
.LastItemTop = .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
ELSE
.LastItemLeft = .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
.LastItemTop = False
END IF
END SUB
PUBLIC:
SUB RePaint
DIM I AS INTEGER, J AS INTEGER
DIM R AS RECT_QTBtn
IF .isPaintReady = True OR .ForceRePaint = True THEN
.isPaintReady = 2
IF .Orientation THEN
.LastItemLeft = False
.LastItemTop = .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
ELSE
.LastItemLeft = .ItemLeft(.ItemCount -True) +(.ItemWidth(.ItemCount -True) \.66)
.LastItemTop = False
END IF
IF .Orientation THEN
.BMPCache2.Width = .FreePanelL.Width
.BMPCache2.Height = .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True)
ELSE
.BMPCache2.Width = .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True)
.BMPCache2.Height = .FreePanelL.Height
END IF
DIM sepBefore AS INTEGER
sepBefore = False
IF isXP_QTBtn = False OR .DisableXPTheme = True THEN _
.BMPCache2.FillRect (False, False, .BMPCache2.Width, .BMPCache2.Height, This.COLOR)
IF .HideGrip = False THEN
IF isXP_QTBtn AND .DisableXPTheme = False THEN
XPPart ( xpt_ReBar, True, _
This.Orientation, _
True, _
This.COLOR, _
This.BMPCache2, This.Handle)
ELSEIF .DisableBG = False AND custGrip.Empty = False THEN
DIM oldGripH AS INTEGER
custGrip.TransparentColor = custGrip.Pixel(False, False)
custGrip.Transparent = True
.BMPCache2.Draw(False, 5, _
custGrip.BMP)
oldGripH = custGrip.Height
custGrip.Height = .BMPCache2.Height -custGrip.Height -10
.BMPCache2.Draw(False, oldGripH +5, _
custGrip.BMP)
custGrip.Height = oldGripH
ELSE
IF .Orientation THEN
IF .Style = False THEN
SetRect_CBar ( R, _
2, _
2, _
.BMPCache2.Width -3, _
5)
DrawEdge_CBar (.BMPCache2.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
ELSE
FOR I = 3 TO (.ClientWidth -5) STEP 3
.BMPCache2.Line ( I, 2, I, 4, -2147483632 )
NEXT I
END IF
ELSE
IF .Style = False THEN
SetRect_CBar ( R, _
2, _
2, _
5, _
.BMPCache2.Height -3)
DrawEdge_CBar (.BMPCache2.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
ELSE
FOR I = 3 TO (.ClientHeight -5) STEP 3
.BMPCache2.Line ( 2, I, 4, I, -2147483632 )
NEXT I
END IF
END IF
END IF
END IF
IF .HideCaption = False AND .CAPTION <> "" THEN
IF .Orientation THEN
.CaptionHeight = (.ClientWidth -.TextHeight(.CAPTION)) \2
DIM RotCapCache AS QBITMAP
RotCapCache.Height = .TextWidth(.CAPTION) +4
RotCapCache.Width = .TextWidth(.CAPTION) +4
RotCapCache.FillRect (False, False, RotCapCache.Height, RotCapCache.Width, This.COLOR)
RotCapCache.TextOut (False, False, .CAPTION, .Font.COLOR, -True)
RotCapCache.Rotate (25, 25, 90)
RotCapCache.Width = .TextHeight(.CAPTION) +4
RotCapCache.TransparentColor = RotCapCache.Pixel(False, False)
RotCapCache.Transparent = True
This.BMPCache2.Draw ((.ClientWidth -RotCapCache.Width) \2, 8, RotCapCache.BMP)
ELSE
.CaptionHeight = (.ClientHeight -.TextHeight(.CAPTION)) \2
.BMPCache2.TextOut (.GripWidth +2, .CaptionHeight, .CAPTION, .Font.COLOR, -True)
END IF
END IF
IF .ItemCount > False THEN
DIM imgLBK AS QBITMAP
FOR I = False TO .ItemCount -True
IF .Item(I) <> "-" THEN
.CoolBtnBMP.Width = .ItemWidth(I)
.CoolBtnBMP.Height = .ItemsWidth
IF .imgLA.Count > False AND (I -SepBefore) < .imgLA.Count THEN _
imgLBK.BMP = .imgLA.GetBMP(I -sepBefore)
.CoolBtnBMP.Font.COLOR = IIF (.ItemEnabled(I), This.Font.COLOR, clGrayText)
Fast_CBar( xpt_ToolBarBtn, _
True, _
IIF(.ItemDown(I), 4, IIF(.ItemEnabled(I), False, 3)), _
This.CoolBtnBMP, _
IIF(.Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True), _
.Item(I), ""), _
IIF(.imgLA.Count > False AND (I -SepBefore) < .imgLA.Count, imgLBK.Width +2, False), _
This.CoolBtnBMP.Font.Name, _
IIF(.ItemPopupHnd(I), True, False), _
False, _
.Style, _
.DisableXPTheme, _
This.Handle)
IF .imgLA.Count > False AND (I -sepBefore) < .imgLA.Count THEN
DIM decal AS INTEGER
decal = IIF(.ItemDown(I), True, False)
imgLBK.BMP = .imgLA.GetBMP(I -sepBefore)
imgLBK.TransparentColor = imgLBK.Pixel(False, False)
imgLBK.Transparent = True
IF .ItemEnabled(I) = False THEN
DIM alBMP AS QBITMAP
alBMP.Width = imgLBK.Width
alBMP.Height = imgLBK.Width
alBMP.FillRect (False, False, imgLBK.Width, imgLBK.Height, This.COLOR)
BF_CBar.BlendOp = AC_SRC_OVER_CBar
BF_CBar.BlendFlags = False
BF_CBar.SourceConstantAlpha = 84
BF_CBar.AlphaFormat = False
RtlMoveMemory_CBar lBF_CBar, BF_CBar, 4
AlphaBlend_CBar (alBMP.Handle, _
False, False, _
imgLBK.Width, imgLBK.Height, _
imgLBK.handle, _
False, False, _
imgLBK.Width, imgLBK.Height, _
lBF_CBar)
imgLBK.BMP = alBMP.BMP
imgLBK.TransparentColor = imgLBK.Pixel(False, False)
imgLBK.Transparent = True
END IF
IF .Orientation = False AND (.ShowBtnCapt(I) = True OR .ShowBtnCaptAll = True) THEN
.CoolBtnBMP.Draw ( 4 +decal, _
((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
imgLBK.BMP)
ELSE
.CoolBtnBMP.Draw ( ((This.CoolBtnBMP.Width -imgLBK.Width) \2) +decal, _
((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
imgLBK.BMP)
END IF
END IF
.BMPCache2.Draw (IIF(.Orientation, False, .ItemLeft(I)), _
IIF(.Orientation, .ItemLeft(I), False), _
.CoolBtnBMP.BMP)
ELSE
IF .Orientation THEN
SetRect_CBar ( R, _
False +IIF(.BevelWidth = False, 2, False), _
.ItemLeft(I) +True, _
This.FreePanelL.Width -3, _
.ItemLeft(I) +IIF(.Style < 2 OR isXP_QTBtn = False, 3, 2))
ELSE
SetRect_CBar ( R, _
.ItemLeft(I) +True, _
2, _
.ItemLeft(I) +IIF(.Style < 2 OR isXP_QTBtn = False, 3, 2), _
This.FreePanelL.Height -3)
END IF
DrawEdge_CBar (.BMPCache2.Handle, R, BDR_SUNKENOUTER_CBar, BF_RECT_CBar)
sepBefore ++
END IF
NEXT I
END IF
END IF
END SUB
PRIVATE:
SUB CanvasPaint (Me AS QCANVAS)
STATIC fixHotUp AS INTEGER
IF .isPaintReady = False THEN _
.isPaintReady = True
IF .CanvasL.Width = 2 THEN
fixHotUp = True
ELSEIF fixHotUp = True THEN
fixHotUp = False
ELSE
.ImageLH.Visible = False
fixHotUp = False
END IF
BMPCache.Width = This.ClientWidth
BMPCache.Height = This.ClientHeight
IF .DisableXPThemeBG = False THEN
XPPart (xpt_ReBar, 6, _
False, _
True, _
This.COLOR, _
BMPCache, This.Handle)
ELSEIF custBG.Empty OR .DisableBG = True THEN
BMPCache.FillRect ( _
False, False, _
BMPCache.Width, BMPCache.Height, _
This.COLOR)
ELSE
DIM sR AS QRECT
sR.Left = False
sR.Top = False
sR.Right = BMPCache.Width
sR.Bottom = BMPCache.Height
BMPCache.StretchDraw ( _
sR, _
custBG.BMP)
END IF
IF .BorderStyle THEN
DIM R AS RECT_QTBtn
SetRect_CBar ( R, _
False, _
False, _
BMPCache.Width, _
BMPCache.Height)
DrawEdge_CBar (BMPCache.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
END IF
IF .Orientation = False THEN
IF .FreePanelR.Visible = False AND .Width < .LastItemLeft THEN
.FreePanelR.Height = .FreePanelL.Height
.FreePanelR.Visible = True
.isExceedWidth = 12
ELSEIF .FreePanelR.Visible = True AND .Width > .LastItemLeft THEN
.FreePanelR.Visible = False
.isExceedWidth = False
.isExceedHeight = False
END IF
ELSEIF .Orientation THEN
IF .FreePanelR.Visible = False AND .Height < .LastItemTop THEN
.FreePanelR.Width = .FreePanelL.Width
.FreePanelR.Visible = True
.isExceedHeight = 12
ELSEIF .FreePanelR.Visible = True AND .Height > .LastItemTop THEN
.FreePanelR.Visible = False
.isExceedWidth = False
.isExceedHeight = False
END IF
END IF
IF .FreePanelR.Visible THEN
IF .Orientation THEN
IF .ClientHeight > 12 THEN _
.FreePanelR.Top = .ClientHeight -12
ELSE
IF .ClientWidth > 12 THEN _
.FreePanelR.Left = .ClientWidth -12
END IF
END IF
IF .Orientation THEN
.FreePanelL.Width = .ClientWidth -.isExceedWidth
ELSE
.FreePanelL.Width = .ClientWidth -.isExceedWidth -2
END IF
.FreePanelL.Height = .ClientHeight -.isExceedHeight
IF .FreePanelL.Width <> False AND .FreePanelL.Height <> False THEN
.BtnCache.Width = This.FreePanelL.Width
.BtnCache.Height = This.FreePanelL.Height
.ImageL.BMP = This.BtnCache.BMP
BitBlt_QTBtn ( Me.Handle, _
False, False, _
Me.Width, Me.Height, _
BMPCache.Handle, _
False, False, _
SrcCopy_QTBtn)
IF .Orientation THEN
BitBlt_QTBtn ( This.ImageL.Handle, _
False, False, _
This.ImageL.Width, This.ImageL.Height, _
BMPCache.Handle, _
False, True, _
SrcCopy_QTBtn)
ELSE
BitBlt_QTBtn ( This.ImageL.Handle, _
False, False, _
This.ImageL.Width, This.ImageL.Height, _
BMPCache.Handle, _
True, False, _
SrcCopy_QTBtn)
END IF
IF .isPaintReady < 2 THEN _
CALL This.RePaint
IF .isPaintReady = 2 THEN
IF .DisableXPThemeBG = False OR custBG.Empty = False THEN
TransparentBlt_QTBtn ( .ImageL.Handle, _
False, False, _
.BMPCache2.Width, .BMPCache2.Height, _
.BMPCache2.Handle, _
False, False, _
.BMPCache2.Width, .BMPCache2.Height, _
.BMPCache2.Pixel(False, False))
ELSE
BitBlt_QTBtn ( .ImageL.Handle, _
False, False, _
.BMPCache2.Width, .BMPCache2.Height, _
.BMPCache2.Handle, _
False, False, _
SrcCopy_QTBtn)
END IF
END IF
.BtnCache.BMP = 0&
END IF
IF .FreePanelR.Visible THEN
.CoolBtnBMPE.Width = This.FreePanelR.Width
.CoolBtnBMPE.Height = This.FreePanelR.Height
Fast_CBar( xpt_ToolBarBtn, _
IIF(.Orientation, 5, 4), _
False, _
This.CoolBtnBMPE, _
"", _
False, _
"", _
False, _
False, _
.Style, _
.DisableXPTheme, _
This.Handle)
.CoolBtnBMPE.TextOut(((12 -.CoolBtnBMPE.TextWidth("»")) \2) +True, _
-6, _
"»", _
.Font.COLOR, _
-True)
IF .Orientation THEN
BitBlt_QTBtn ( This.ImageR.Handle, _
False, False, _
This.FreePanelR.Width, This.FreePanelR.Height, _
BMPCache.Handle, _
False, This.FreePanelR.Top, _
SrcCopy_QTBtn)
ELSE
BitBlt_QTBtn ( This.ImageR.Handle, _
False, False, _
This.FreePanelR.Width, This.FreePanelR.Height, _
BMPCache.Handle, _
This.FreePanelR.Left, False, _
SrcCopy_QTBtn)
END IF
TransparentBlt_QTBtn ( .ImageR.Handle, _
False, False, _
.ImageR.Width, .ImageR.Height, _
.CoolBtnBMPE.Handle, _
False, False, _
.CoolBtnBMPE.Width, .CoolBtnBMPE.Height, _
.CoolBtnBMPE.Pixel(False, False))
END IF
IF .BorderStyle THEN
IF .Orientation THEN
SetRect_CBar ( R, _
False, _
-True, _
.Width, _
.Height)
ELSE
SetRect_CBar ( R, _
-True, _
False, _
.Width, _
.ImageL.Height)
END IF
DrawEdge_CBar (.ImageL.Handle, R, BDR_RAISEDINNER_CBar, BF_RECT_CBar)
END IF
.BtnCache.Width = True
.BtnCache.Height = True
END SUB
SUB mnuItem_Click(Me AS QMENUITEM)
IF Me.CAPTION <> "-" THEN
IF .ItemGroup(Me.Tag) <> False THEN
.ItemDown(Me.Tag) = IIF(.ItemDown(Me.Tag), False, True)
.isPaintReady = False
This.CanvasPaint (This.CanvasL)
END IF
CALLFUNC(This.OnChange, Me.Tag, This)
END IF
END SUB
PUBLIC:
SUBI AddItems (...)
IF PARAMSTRCOUNT > False THEN
DIM I AS INTEGER
.ItemCount = .ItemCount +PARAMSTRCOUNT
IF .ItemsWidth = False THEN
IF .Orientation THEN
.ItemsWidth = .FreePanelL.Width -2
ELSE: .ItemsWidth = .FreePanelL.Height -2
END IF
END IF
REDIM .ItemLeft(.ItemCount -True) AS INTEGER
REDIM .ItemWidth(.ItemCount -True) AS INTEGER
REDIM .ShowBtnCapt(.ItemCount -True) AS INTEGER
REDIM .ItemGroup(.ItemCount -True) AS INTEGER
REDIM .ItemEnabled(.ItemCount -True) AS INTEGER
REDIM .ItemDown(.ItemCount -True) AS INTEGER
REDIM .ItemPopupHnd(.ItemCount -True) AS LONG
REDIM .mnuItemExceedIndex(.ItemCount -True) AS INTEGER
.ItemLeft(False) = False
.ItemWidth(False) = False
FOR I = True TO PARAMSTRCOUNT
.mnuItemExceedIndex(I -True) = CB_ItemCount
mnuItemExceed(CB_ItemCount).CAPTION = IIF(PARAMSTR$(I) = "", "...", PARAMSTR$(I))
mnuItemExceed(CB_ItemCount).Tag = I -True
mnuItemExceed(CB_ItemCount).OnClick = This.mnuItem_Click
.mnuExceed.AddItems (mnuItemExceed(CB_ItemCount))
.Item(I -True) = PARAMSTR$(I)
.ItemGroup(I -True) = False
.ItemEnabled(I -True) = True
.ItemDown(I -True) = False
.ItemPopupHnd(I -True) = False
.ShowBtnCapt(I -True) = IIF(.ShowBtnCaptAll, True, False)
IF PARAMSTR$(I) = "-" THEN
.ItemWidth(I -True) = 5
ELSE
.ItemWidth(I -True) = .ItemsWidth +_
IIF(.Orientation = False AND .ShowBtnCapt(I -True), _
.TextWidth(PARAMSTR$(I)) +3, _
False)
END IF
CB_ItemCount ++
CALL RedimCBItems
NEXT I
IF .HideGrip = False THEN _
.ItemLeft(False) = .ItemLeft(False) +8
IF .HideCaption = False AND .CAPTION <> "" THEN _
.ItemLeft(False) = .ItemLeft(False) +.CaptionWidth +4
I = False
FOR I = False TO .ItemCount -True
.ItemLeft(I +True) = .ItemLeft(I) +.ItemWidth(I)
NEXT I
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END IF
END SUBI
SUB AsignPopupToItem (Me AS QPOPUPMENU, iIndex AS INTEGER)
IF .ItemCount = False THEN _
EXIT SUB
IF .Item(iIndex) <> "-" THEN
.ItemPopupHnd(iIndex) = Me.Handle
ELSE
SHOWMESSAGE "Avertissement: vous tentez d'asigner un menu popup " +CHR$(10) +_
" à un item..."
END IF
.ForceEvalPos = True
CALL This.EvalBtnPos
.ForceEvalPos = False
IF .isPaintReady = 2 THEN
.ForceRePaint = True
CALL This.RePaint
.ForceRePaint = False
END IF
END SUB
SUB InsertED_Ctrl (iAfter AS INTEGER, Me AS QEDIT)
IF .Orientation = True THEN
SHOWMESSAGE "Orientation = True n'est pas supporté !"
EXIT SUB
END IF
REDIM .ED_Ctrl(.ED_Count) AS LONG
REDIM .ED_AfterIndex(.ED_Count) AS INTEGER
REDIM .ED_Left(.ED_Count) AS INTEGER
REDIM .ED_Width(.ED_Count) AS INTEGER
REDIM .ED_Height(.ED_Count) AS INTEGER
.ED_Count ++
Me.Visible = False
Me.PARENT = This.FreePanelL
.ED_Ctrl(.ED_Count -True) = Me.Handle
.ED_Width(.ED_Count -True) = Me.Width
.ED_Height(.ED_Count -True) = Me.Height
.ED_AfterIndex(.ED_Count -True) = iAfter
.ForceEvalPos = True
CALL This.EvalBtnPos
.ForceEvalPos = False
IF iAfter = -True OR (iAfter > -True AND iAfter < (.ItemCount -True)) THEN
Me.Left = .ED_Left(.ED_Count -True)
ELSE
Me.Left = .ItemLeft(.ItemCount -True) +6
END IF
Me.Top = (This.FreePanelL.Height -Me.Height) \2
Me.PARENT = This.FreePanelL
Me.Visible = True
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUB
SUB InsertCB_Ctrl (iAfter AS INTEGER, Me AS QCOMBOBOX)
IF .Orientation = True THEN
SHOWMESSAGE "Orientation = True n'est pas supporté !"
EXIT SUB
END IF
REDIM .CB_Ctrl(.CB_Count) AS LONG
REDIM .CB_AfterIndex(.ED_Count) AS INTEGER
REDIM .CB_Left(.CB_Count) AS INTEGER
REDIM .CB_Width(.CB_Count) AS INTEGER
REDIM .CB_Height(.CB_Count) AS INTEGER
.CB_Count ++
.CB_Ctrl(.CB_Count -True) = Me.Handle
.CB_Width(.CB_Count -True) = Me.Width
.CB_Height(.CB_Count -True) = Me.Height
.CB_AfterIndex(.CB_Count -True) = iAfter
CALL This.EvalBtnPos
IF iAfter = -True OR (iAfter > -True AND iAfter < (.ItemCount -True)) THEN
Me.Left = .CB_Left(.ED_Count -True)
ELSE
Me.Left = .ItemLeft(.ItemCount -True) +6
END IF
Me.Top = (This.FreePanelL.Height -Me.Height) \2
Me.PARENT = This.FreePanelL
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUB
SUBI ItemsGroup (...)
DIM I AS INTEGER
DIM modSepState AS INTEGER
modSepState = False
DIM Index AS INTEGER
Index = IIF(PARAMVAL(True) <= False, False, PARAMVAL(True))
IF PARAMVALCOUNT = True THEN
FOR I = False TO .ItemCount -True
IF .Item(I) <> "-" THEN
.ItemGroup(I) = Index
.GroupAllowAllUp(Index) = True
END IF
NEXT I
ELSEIF PARAMVALCOUNT > True THEN
FOR I = 2 TO PARAMVALCOUNT
IF .Item(PARAMVAL(I)) <> "-" THEN
.ItemGroup(PARAMVAL(I)) = Index
.GroupAllowAllUp(Index) = True
ELSE
modSepState ++
END IF
NEXT I
ELSE
SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
END IF
IF modSepState THEN _
SHOWMESSAGE "Avertissement: vous tentez de redéfinir le " +CHR$(10) +_
" groupe d'un séparateur..."
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUBI
SUBI DefineGroupAllowAllUp (...)
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUBI
SUBI ItemsDown (...)
DIM I AS INTEGER
DIM modSepState AS INTEGER
modSepState = False
DIM Index AS INTEGER
Index = IIF(PARAMVAL(True) <> False, True, False)
IF PARAMVALCOUNT = True THEN
FOR I = False TO .ItemCount -True
IF .Item(I) <> "-" AND .ItemGroup(I) > False THEN _
.ItemDown(I) = Index
NEXT I
ELSEIF PARAMVALCOUNT > True THEN
FOR I = 2 TO PARAMVALCOUNT
IF .Item(PARAMVAL(I)) <> "-" THEN
IF .ItemGroup(PARAMVAL(I)) > False THEN _
.ItemDown(PARAMVAL(I)) = Index
ELSE
modSepState ++
END IF
NEXT I
ELSE
SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
END IF
IF modSepState THEN _
SHOWMESSAGE "Avertissement: vous tentez de modifier l'état " +CHR$(10) +_
" enfoncé d'un séparateur..."
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUBI
SUBI ItemsEnabled (...)
DIM I AS INTEGER
DIM modSepState AS INTEGER
modSepState = False
IF PARAMVALCOUNT = True THEN
FOR I = False TO .ItemCount -True
IF .Item(I) <> "-" THEN _
.ItemEnabled(I) = PARAMVAL(True)
NEXT I
ELSEIF PARAMVALCOUNT > True THEN
FOR I = 2 TO PARAMVALCOUNT
IF .Item(PARAMVAL(I)) <> "-" THEN
.ItemEnabled(PARAMVAL(I)) = PARAMVAL(True)
ELSE
modSepState ++
END IF
NEXT I
ELSE
SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
END IF
IF modSepState THEN _
SHOWMESSAGE "Avertissement: vous tentez de modifier l'état " +CHR$(10) +_
" enfoncé d'un séparateur..."
IF .isPaintReady = 2 THEN _
CALL This.RePaint
END SUBI
PRIVATE:
EVENT CanvasL.OnPaint
.CanvasLMsg = True
This.CanvasPaint (This.CanvasL)
END EVENT
EVENT CanvasR.OnPaint
DIM R AS RECT_QTBtn
GetWindowRect_CBar (This.Handle, R)
IF .CanvasLMsg = False OR R.Left < False THEN
.CanvasLMsg = False
This.CanvasPaint (This.CanvasL)
END IF
IF .Orientation THEN
BitBlt_QTBtn ( .CanvasR.Handle, _
False, False, _
.CanvasR.Width, .CanvasR.Height, _
BMPCache.Handle, _
False, .FreePanelM.Top, _
SrcCopy_QTBtn)
ELSE
BitBlt_QTBtn ( .CanvasR.Handle, _
False, False, _
.CanvasR.Width, .CanvasR.Height, _
BMPCache.Handle, _
.FreePanelM.Left, False, _
SrcCopy_QTBtn)
END IF
END EVENT
EVENT ImageL.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
SetCapture_QTBtn This.Handle
END EVENT
EVENT ImageR.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
SetCapture_QTBtn This.Handle
END EVENT
EVENT ImageLH.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
SetCapture_QTBtn This.Handle
END EVENT
EVENT ImageRH.OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
SetCapture_QTBtn This.Handle
END EVENT
SUB DrawHotItemState (iIndex AS INTEGER, iState AS INTEGER, iMenuDown AS INTEGER)
DIM SepBefore AS INTEGER
sepBefore = False
.ImageLH.Visible = False
IF iIndex = -True THEN
Fast_CBar( xpt_ToolBarBtn, _
IIF(.Orientation, 5, 4), _
iState, _
This.CoolBtnBMPE, _
"", _
False, _
"", _
False, _
False, _
.Style, _
.DisableXPTheme, _
This.Handle)
.CoolBtnBMPE.TextOut(((12 -.CoolBtnBMPE.TextWidth("»")) \2) +True, _
-6, _
"»", _
.Font.COLOR, _
-True)
.ImageRH.BMP = .CoolBtnBMPE.BMP
.ImageRH.Visible = True
ELSEIF .ItemEnabled(iIndex) THEN
DIM I AS INTEGER
FOR I = False TO iIndex
IF .Item(I) <> "-" THEN
ELSE
sepBefore ++
END IF
NEXT I
DIM imgLBK AS QBITMAP
.CoolBtnBMP.Width = .ItemWidth(iIndex)
.CoolBtnBMP.Height = .ItemsWidth
IF .imgLA.Count > False AND (iIndex -SepBefore) < .imgLA.Count THEN _
imgLBK.BMP = .imgLA.GetBMP(iIndex -sepBefore)
.CoolBtnBMP.Font.COLOR = IIF (.ItemEnabled(I), This.Font.COLOR, clGrayText)
Fast_CBar( xpt_ToolBarBtn, _
True, _
IIF(.ItemDown(iIndex) AND iState = True, 5, iState), _
This.CoolBtnBMP, _
IIF(.Orientation = False AND (.ShowBtnCapt(iIndex) = True OR .ShowBtnCaptAll = True), _
This.Item(iIndex), ""), _
IIF(.imgLA.Count > False AND (iIndex -SepBefore) < .imgLA.Count, imgLBK.Width +2, False), _
This.CoolBtnBMP.Font.Name, _
IIF(.ItemPopupHnd(iIndex), True +iMenuDown, False), _
False, _
.Style, _
.DisableXPTheme, _
This.Handle)
DIM decal AS INTEGER
decal = False
IF (iState = 2 AND iMenuDown = False) OR .ItemDown(iIndex) THEN _
decal = True
IF .imgLA.Count > False AND (iIndex -sepBefore) < .imgLA.Count THEN
imgLBK.BMP = .imgLA.GetBMP(iIndex -sepBefore)
imgLBK.TransparentColor = imgLBK.Pixel(False, False)
imgLBK.Transparent = True
IF .Orientation = False AND (.ShowBtnCapt(iIndex) = True OR .ShowBtnCaptAll = True) THEN
.CoolBtnBMP.Draw( 4 +decal, _
((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
imgLBK.BMP)
ELSE
.CoolBtnBMP.Draw( ((This.CoolBtnBMP.Width -imgLBK.Width) \2) +decal, _
((This.CoolBtnBMP.Height -imgLBK.Height) \2) +decal, _
imgLBK.BMP)
END IF
END IF
IF .Orientation THEN
.ImageLH.Left = False
.ImageLH.Top = .ItemLeft(iIndex)
ELSE
.ImageLH.Left = .ItemLeft(iIndex)
.ImageLH.Top = False
END IF
.CoolBtnBMP.TransparentColor = .CoolBtnBMP.Pixel(False, False)
.CoolBtnBMP.Transparent = True
.ImageLH.BMP = .CoolBtnBMP.BMP
.ImageLH.Transparent = True
.ImageLH.Visible = True
END IF
END SUB
EVENT OnMouseMove (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
DIM curBtn AS INTEGER
DIM ItemWidth AS INTEGER
DIM I AS INTEGER
DIM R AS RECT_QTBtn
STATIC firstAction AS INTEGER
STATIC wasBtn AS INTEGER
STATIC PosX AS INTEGER, PosY AS INTEGER
STATIC isHoverInsCtrl AS INTEGER
DIM sepBefore AS INTEGER
GetWindowRect_CBar (This.Handle, R)
IF (GetCapture_QTBtn() = This.Handle AND PtInRect_CBar (R, Screen.MOUSEX, Screen.MOUSEY) = False) OR _
isHoverInsCtrl = True THEN
ReleaseCapture_QTBtn
wasBtn = -True
isHoverInsCtrl = False
.ImageLH.Visible = False
.ImageRH.Visible = False
ELSEIF (GetCapture_QTBtn() <> This.Handle) AND _
(PosX <> X AND PosY <> Y) THEN
PosX = X
PosY = Y
SetCapture_QTBtn This.Handle
ELSEIF .FreePanelR.Visible AND .Orientation AND _
(Y => .ClientHeight -12 AND Y =< .ClientHeight) THEN
.DrawHotItemState (-True, True, False)
curBtn = -True
wasBtn = -True
ELSEIF .FreePanelR.Visible AND .Orientation = False AND _
(X => .ClientWidth -12 AND X =< .ClientWidth) THEN
.DrawHotItemState (-True, True, False)
curBtn = -True
wasBtn = -True
ELSE
.ImageRH.Visible = False
DIM J AS INTEGER
FOR I = False TO .ItemCount -True
IF .Orientation THEN
IF Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I) THEN
curBtn = I
IF .ED_Count > False THEN
FOR J = False TO .ED_Count -True
IF Y >= .ED_Left(J) AND Y <= .ED_Left(J) THEN
curBtn = -True
wasBtn = -True
isHoverInsCtrl = True
EXIT FOR
END IF
NEXT J
END IF
IF .CB_Count > False THEN
FOR J = False TO .CB_Count -True
IF Y >= .CB_Left(J) AND Y <= .CB_Left(J) THEN
curBtn = -True
wasBtn = -True
isHoverInsCtrl = True
EXIT FOR
END IF
NEXT J
END IF
EXIT FOR
ELSE
curBtn = -True
END IF
ELSE
IF X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I) THEN
curBtn = I
IF .ED_Count > False THEN
FOR J = False TO .ED_Count -True
IF X >= .ED_Left(J) AND X <= .ED_Left(J) THEN
curBtn = -True
wasBtn = -True
isHoverInsCtrl = True
EXIT FOR
END IF
NEXT J
END IF
IF .CB_Count > False THEN
FOR J = False TO .CB_Count -True
IF X >= .CB_Left(J) AND X <= .CB_Left(J) THEN
curBtn = -True
wasBtn = -True
isHoverInsCtrl = True
EXIT FOR
END IF
NEXT J
END IF
EXIT FOR
ELSE
curBtn = -True
END IF
END IF
NEXT I
IF (curBtn > -True AND curBtn < .ItemCount) THEN
IF firstAction = False OR (wasBtn <> curBtn OR wasBtn = -True) THEN
firstAction = True
IF .Orientation THEN
IF (Y > .ItemLeft(curBtn) OR Y < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
AND .Item(curBtn) <> "-" THEN
.DrawHotItemState (curBtn, True, False)
ELSE
.ImageLH.Visible = False
END IF
ELSE
IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
AND .Item(curBtn) <> "-" THEN
.DrawHotItemState (curBtn, True, False)
ELSE
.ImageLH.Visible = False
END IF
END IF
END IF
wasBtn = curBtn
ELSE
.ImageLH.Visible = False
IF .Orientation THEN
IF (Y > .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True) OR _
Y < .ItemLeft(False)) AND wasBtn <> -True THEN
wasBtn = -True
END IF
ELSE
IF (X > .ItemLeft(.ItemCount -True) +.ItemWidth(.ItemCount -True) OR _
X < .ItemLeft(False)) AND wasBtn <> -True THEN
wasBtn = -True
END IF
END IF
END IF
END IF
END EVENT
EVENT OnMouseDown (btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
IF btn = False THEN
IF .FreePanelR.Visible AND _
((.Orientation AND _
(Y => .ClientHeight -12 AND Y =< .ClientHeight)) OR _
(.Orientation = False AND _
(X => .ClientWidth -12 AND X =< .ClientWidth))) THEN
.DrawHotItemState (-True, 2, False)
.mnuExceed.Popup(Screen.MOUSEX +(.FreePanelR.Left -X), _
Screen.MOUSEY +(.ClientHeight -Y))
.ImageRH.Visible = False
ELSE
DIM I AS INTEGER
DIM curBtn AS INTEGER
DIM R AS RECT_QTBtn
FOR I = False TO .ItemCount -True
IF .Orientation = False AND (X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I)) THEN
curBtn = I
EXIT FOR
ELSEIF .Orientation AND (Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I)) THEN
curBtn = I
EXIT FOR
ELSE
curBtn = -True
END IF
NEXT I
IF curBtn > -True THEN
IF .ItemEnabled(curBtn) THEN
IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
AND .Item(curBtn) <> "-" THEN
IF .ItemPopupHnd(curBtn) THEN
IF X < .ItemLeft(curBtn) +.ItemWidth(curBtn) -11 THEN
.DrawHotItemState (curBtn, 2, False)
ELSE
.DrawHotItemState (curBtn, 2, True)
.pShowPopup(curBtn, _
Screen.MOUSEX +(.ItemLeft(curBtn) -X), _
Screen.MOUSEY +(This.Height -True -Y))
.ImageLH.Visible = False
END IF
ELSE
.DrawHotItemState (curBtn, 2, False)
END IF
END IF
END IF
ELSEIF .HideGrip = False THEN
IF .Orientation = False AND (X >= False AND X <= 7) AND _
.Width > 29 THEN
ReleaseCapture_QTBtn
.DragTimer.Interval = 50
.DragTimer.Enabled = True
SendMessage_CBar(This.Handle, WM_NCLBUTTONDOWN_CBar, HTCAPTION_CBar, False)
ELSEIF .Orientation AND (Y >= False AND Y <= 7) AND _
.Height > 29 THEN
ReleaseCapture_QTBtn
.DragTimer.Interval = 50
.DragTimer.Enabled = True
SendMessage_CBar(This.Handle, WM_NCLBUTTONDOWN_CBar, HTCAPTION_CBar, False)
END IF
END IF
END IF
END IF
END EVENT
EVENT OnMouseUp (btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
IF btn = False THEN
IF .FreePanelR.Visible AND _
((.Orientation AND _
(Y => .ClientHeight -12 AND Y =< .ClientHeight)) OR _
(.Orientation = False AND _
(X => .ClientWidth -12 AND X =< .ClientWidth))) THEN
.DrawHotItemState (-True, True, False)
ELSE
DIM I AS INTEGER
DIM curBtn AS INTEGER
DIM R AS RECT_QTBtn
FOR I = False TO .ItemCount -True
IF .Orientation = False AND (X >= .ItemLeft(I) AND X <= .ItemLeft(I) +.ItemWidth(I)) THEN
curBtn = I
EXIT FOR
ELSEIF .Orientation AND (Y >= .ItemLeft(I) AND Y <= .ItemLeft(I) +.ItemWidth(I)) THEN
curBtn = I
EXIT FOR
ELSE
curBtn = -True
END IF
NEXT I
IF curBtn > -True THEN
IF .ItemEnabled(curBtn) THEN
DIM oldX AS INTEGER, _
oldY AS INTEGER
oldX = Screen.MOUSEX
oldY = Screen.MOUSEY
IF (X > .ItemLeft(curBtn) OR X < .ItemLeft(curBtn) +.ItemWidth(curBtn)) _
AND .Item(curBtn) <> "-" THEN
IF .ItemGroup(curBtn) <> False THEN
.ItemDown(curBtn) = IIF(.ItemDown(curBtn), False, True)
.isPaintReady = False
This.CanvasPaint (This.CanvasL)
END IF
.DrawHotItemState (curBtn, True, False)
END IF
CALLFUNC(.OnChange, curBtn, This)
IF oldX <> Screen.MOUSEX AND oldY <> Screen.MOUSEY THEN _
.ImageLH.Visible = False
END IF
END IF
END IF
END IF
END EVENT
EVENT mnuExceed.OnPopup
IF .ItemCount THEN
DIM I AS INTEGER
FOR I = False TO .ItemCount -True
IF .Orientation THEN
IF .Height < (.ItemLeft(I) +(.ItemWidth(I) \.66)) THEN
mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True
ELSE
mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
END IF
ELSE
IF .Width < (.ItemLeft(I) +(.ItemWidth(I) \.66)) THEN
mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True
ELSE
mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
END IF
END IF
IF I = .ItemCount -True AND mnuItemExceed(This.mnuItemExceedIndex(I)).CAPTION = "-" THEN _
mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = False
NEXT I
$IFDEF _AMIB
DIM sepBefore AS INTEGER
sepBefore = False
FOR I = False TO .ItemCount -True
IF .Item(I) = "-" THEN
sepBefore ++
ELSE
IF mnuItemExceed(This.mnuItemExceedIndex(I)).Visible = True THEN
BMPMenu.Width = .imgLA.Width
BMPMenu.Height = .imgLA.Height
BMPMenu.BMP = .imgLA.GetBMP(I -sepBefore)
CreateMenuBitmap(This.mnuExceed, _
mnuItemExceed(This.mnuItemExceedIndex(I)).Command, _
False, _
BMPMenu)
END IF
END IF
NEXT I
$ENDIF
END IF
END EVENT
EVENT DragTimer.OnTimer
IF GetAsyncKeyState_CBar(VK_LBUTTON_CBar) = False THEN
.Align = .Align
.DragTimer.Enabled = False
END IF
END EVENT
PUBLIC:
PROPERTY SET SetHideGrip(nState AS INTEGER)
.HideGrip = nState
IF .ItemCount > False THEN
CALL This.EvalBtnPos
IF .isPaintReady > False THEN
.ForceRePaint = True
CALL This.RePaint
.ForceRePaint = False
END IF
END IF
END PROPERTY
PROPERTY SET SetHideCaption(nState AS INTEGER)
.HideCaption = nState
IF .ItemCount > False THEN
CALL This.EvalBtnPos
IF .isPaintReady > False THEN
.ForceRePaint = True
CALL This.RePaint
.ForceRePaint = False
END IF
END IF
END PROPERTY
PROPERTY SET SetCaption(nCaption AS STRING)
Super.CAPTION = ""
.CAPTION = nCaption
.CaptionWidth = .TextWidth (nCaption) +4
.CaptionHeight = .TextHeight (nCaption)
IF .ItemCount > False THEN
.ForceEvalPos = True
CALL This.EvalBtnPos
.ForceEvalPos = False
IF .isPaintReady > False THEN
.ForceRePaint = True
CALL This.RePaint
.ForceRePaint = False
END IF
END IF
END PROPERTY
PROPERTY SET SetOrientation(orientation AS INTEGER)
.Orientation = orientation
IF .Orientation THEN
.FreePanelL.Align = True
.FreePanelR.Align = 2
.FreePanelR.Left = False
.FreePanelR.Height = 12
.FreePanelR.Width = .FreePanelL.Width
.isExceedWidth = False
.isExceedHeight = False
.FreePanelM.Align = 2
ELSE
.FreePanelL.Align = 3
.FreePanelR.Align = 4
.FreePanelR.Top = False
.FreePanelR.Height = .FreePanelL.Height
.FreePanelR.Width = 12
.isExceedWidth = False
.isExceedHeight = False
.FreePanelM.Align = 4
END IF
.CanvasL.Align = IIF(.Orientation, True, 3)
.GripWidth = IIF(.Orientation, 8, 5)
.CoolBtnBMPE.Width = This.FreePanelR.Width
.CoolBtnBMPE.Height = This.FreePanelR.Height
END PROPERTY
PROPERTY SET SetBorderStyle(bs AS INTEGER)
.BorderStyle = bs
Super.BorderStyle = 0
END PROPERTY
SUBI ItemsCaptionVisible (...)
DIM I AS INTEGER
DIM modSepState AS INTEGER
modSepState = False
IF PARAMVALCOUNT = True AND (PARAMVAL(True) = False OR PARAMVAL(True) = True) THEN
.ShowBtnCaptAll = True
FOR I = False TO .ItemCount -True
IF .Item(I) <> "-" THEN _
.ShowBtnCapt(I) = PARAMVAL(True)
NEXT I
ELSEIF PARAMVALCOUNT > True THEN
FOR I = 2 TO PARAMVALCOUNT
IF .Item(PARAMVAL(I)) <> "-" THEN
.ShowBtnCapt(PARAMVAL(I)) = PARAMVAL(True)
ELSE
modSepState ++
END IF
NEXT I
ELSE
SHOWMESSAGE "Erreur: paramètre(s) manquant(s) ou incorrect(s)"
END IF
IF modSepState THEN _
SHOWMESSAGE "Avertissement: vous tentez de modifier " +CHR$(10) +_
" un séparateur..."
IF .ItemCount > False THEN
.ForceEvalPos = True
CALL This.EvalBtnPos
.ForceEvalPos = False
END IF
IF .isPaintReady > False THEN
.ForceRePaint = True
CALL This.RePaint
.ForceRePaint = False
END IF
END SUBI
CONSTRUCTOR
BevelWidth = False
BorderStyle = True
FreePanelL.Align = 3
FreePanelL.BevelWidth = False
FreePanelL.PARENT = This
FreePanelM.Align = 4
FreePanelM.Width = 1
FreePanelM.BevelWidth = False
FreePanelM.PARENT = This
FreePanelR.Align = 4
FreePanelR.Width = 12
FreePanelR.BevelWidth = False
FreePanelR.PARENT = This
CanvasL.Align = 3
CanvasL.Width = True
CanvasL.Height = True
CanvasL.PARENT = This
CanvasR.Align = 5
CanvasR.Width = True
CanvasR.Height = True
CanvasR.PARENT = This.FreePanelM
ImageL.Align = 5
ImageL.PARENT = This.FreePanelL
ImageR.Align = 5
ImageR.PARENT = This.FreePanelR
ImageLH.Visible = False
ImageLH.PARENT = This.FreePanelL
ImageRH.Align = 5
ImageRH.Visible = False
ImageRH.PARENT = This.FreePanelR
CoolBtnBMPE.Font.Name = "MS Sans Serif"
CoolBtnBMPE.Font.Bold = True
CoolBtnBMPE.Font.Size = 12
ItemsWidth = 39
GripWidth = 5
DragTimer.Enabled = False
OnChange = CBarOnChange_EventTemplate
CanvasLMsg = False
END CONSTRUCTOR
END WITH
END TYPE
|
|