$OPTION EXPLICIT
$IFNDEF __RQINC
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
CONST rqNullChr = CHR$(0)
CONST rqSL = CHR$(10)
CONST DefPixelFormat = 4
DIM AllQTBtnsHandle AS QSTRINGLIST, AllQTBtnsGrouped AS QSTRINGLIST
DIM AllQTBtnsRequester AS LONG, AllQTBtnsRequesterParent AS LONG
AllQTBtnsRequester = False
AllQTBtnsRequesterParent = False
DIM QTBtnOptimize AS INTEGER
QTBtnOptimize = False
DIM QTBtnBMP AS QBITMAP
QTBtnBMP.BMPHandle = btn_BMP
CONST WM_LBUTTONUP_QTBtn = &H202
CONST WM_MOUSELAST_QTBtn = &H209
DECLARE FUNCTION SendMessage_QTBtn LIB "user32" ALIAS "SendMessageA" ( _
BYVAL hwnd AS LONG, _
BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, _
lParam AS LONG) AS LONG
DECLARE FUNCTION IsWindowEnabled_QTBtn LIB "user32" ALIAS "IsWindowEnabled" _
(BYVAL hwnd AS LONG) AS LONG
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
DECLARE FUNCTION GetNextDlgTabItem_QTBtn LIB "user32" ALIAS "GetNextDlgTabItem" ( _
BYVAL hDlg AS LONG, _
BYVAL hCtl AS LONG, BYVAL bPrevious AS LONG) AS LONG
DECLARE FUNCTION SetFocus_QTBtn LIB "user32" ALIAS "SetFocus" _
(BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION GetParent_QTBtn LIB "user32" ALIAS "GetParent" _
(BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION GetFocus_QTBtn LIB "user32" ALIAS "GetFocus" () AS LONG
SUB NextDlg_QTBtn(NextPrevTab AS LONG)
DIM hwnd5 AS LONG, hwnd6 AS LONG
ReleaseCapture_QTBtn
hwnd6 = GetFocus_QTBtn()
hwnd5 = GetNextDlgTabItem_QTBtn(GetParent_QTBtn(hwnd6),hwnd6, NextPrevTab)
CALL SetFocus_QTBtn(hwnd5)
END SUB
$IFNDEF __RQOBJDRAWING
$DEFINE __RQOBJDRAWING
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
DECLARE FUNCTION GetSystemMetrics LIB "user32" ALIAS "GetSystemMetrics" _
(BYVAL nIndex AS LONG) AS LONG
CONST RGN_AND = 1
CONST RGN_OR = 2
CONST RGN_XOR = 3
CONST RGN_DIFF = 4
DECLARE FUNCTION CreateRectRgn_QTBtn LIB "gdi32" ALIAS "CreateRectRgn" ( _
BYVAL X1 AS LONG, _
BYVAL Y1 AS LONG, _
BYVAL X2 AS LONG, _
BYVAL Y2 AS LONG) AS LONG
DECLARE FUNCTION SetWindowRgn_QTBtn LIB "user32" ALIAS "SetWindowRgn" ( _
BYVAL hWnd AS LONG, _
BYVAL hRgn AS LONG, _
BYVAL bRedraw AS INTEGER) AS LONG
DECLARE FUNCTION DeleteObject_QTBtn LIB "gdi32" ALIAS "DeleteObject" ( _
BYVAL hObject AS LONG) AS LONG
SUB HideBevelTrick_QTBtn(Sender AS QBUTTON, BevelWidth AS INTEGER)
DIM rectRgn AS LONG
rectRgn = CreateRectRgn_QTBtn( BevelWidth, _
BevelWidth, _
Sender.Width -BevelWidth, _
Sender.Height -BevelWidth )
DeleteObject_QTBtn SetWindowRgn_QTBtn( Sender.Handle, rectRgn, True )
DeleteObject_QTBtn rectRgn
END SUB
$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 maxnumbmp_QTBtn AS INTEGER
maxnumbmp_QTBtn = 4
DECLARE SUB BMPStretch_Property( _
XPThemeEnabled AS INTEGER, _
XPThemeWasEnabled AS INTEGER, _
BtnType AS STRING, _
BtnTypeWas AS STRING, _
HideBevelSize AS INTEGER, _
Sender AS QBUTTON)
SUB FixKind_QTBtn (oldvalue AS INTEGER, Sender AS QBUTTON)
Sender.NumBMPs = oldvalue
END SUB
DIM RequestRelease AS INTEGER
DECLARE SUB OnMouseEnterLeave_EventTemplate (X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Sender AS QBUTTON)
SUB SetIndex_QTBtn (Index AS INTEGER, Hwnd AS LONG)
AllQTBtnsHandle.AddItems STR$(Hwnd)
AllQTBtnsGrouped.AddItems STR$(Index)
END SUB
SUB QTButton_KeyDown (Key AS WORD, Shift AS INTEGER)
IF RequestRelease = False THEN
SELECT CASE Key
CASE 40, 39, 9: CALL NextDlg_QTBtn(True)
CASE 38, 37: CALL NextDlg_QTBtn(False)
CASE ELSE
END SELECT
END IF
RequestRelease = True
END SUB
DIM rWidth AS INTEGER, _
rHeight AS INTEGER
rWidth = 75
rHeight = 25
TYPE QTButton EXTENDS QBUTTON
WITH This
PRIVATE:
cRect AS RECT_QTBtn
Dest AS QRECT
Source AS QRECT
BMPBtnClean AS QBITMAP
BMPBtn AS QBITMAP
BMPtmp AS QBITMAP
PUBLIC:
ICOBMP AS QBITMAP
PRIVATE:
PropID AS INTEGER
BtnNeedDraw AS INTEGER
ActAsToolBar AS INTEGER
PrevFocus AS LONG
HideBevelSize AS INTEGER
XPThemeBtnTypeWas AS STRING
XPThemeWasEnabled AS INTEGER
PUBLIC:
XPThemeBtnType AS STRING PROPERTY SET SetXPThemeBtnType
XPThemeEnabled AS INTEGER PROPERTY SET SetXPThemeEnabled
Align AS INTEGER PROPERTY SET SetAlign
CAPTION AS STRING PROPERTY SET SetCaption
Enabled AS INTEGER PROPERTY SET SetEnabled
Down AS INTEGER PROPERTY SET SetDown
GroupIndex AS INTEGER PROPERTY SET SetGroupIndex
Kind AS INTEGER PROPERTY SET SetKind
Layout AS INTEGER PROPERTY SET SetLayout
Spacing AS INTEGER PROPERTY SET SetSpacing
Height AS INTEGER PROPERTY SET SetHeight
Width AS INTEGER PROPERTY SET SetWidth
NumBMPs AS INTEGER PROPERTY SET SetNumBMPs
NumICOBMPs AS INTEGER PROPERTY SET SetNumICOBMPs
FlickeringTrick AS INTEGER PROPERTY SET SetNewBtnRegion
HideFocusRect AS INTEGER PROPERTY SET SetHideFocusRect
OnMouseLeave AS EVENT(OnMouseEnterLeave_EventTemplate)
OnMouseEnter AS EVENT(OnMouseEnterLeave_EventTemplate)
FUNCTION TextWidth(text AS STRING) AS INTEGER: Result = .BMPBtn.TextWidth(text)
END FUNCTION
FUNCTION TextHeight(text AS STRING) AS INTEGER: Result = .BMPBtn.TextHeight(text)
END FUNCTION
PRIVATE:
SUB FixBtnSize
IF .Align <> False THEN EXIT SUB
DIM height AS INTEGER, width AS INTEGER
height = super.height: width = super.width
.height = height: .width = width
END SUB
SUB DrawCaption: DIM I AS INTEGER
.propID = False
DIM COLOR AS INTEGER, left AS INTEGER, top AS INTEGER
DIM capwidth AS INTEGER
.BMPBtn.Font.Name = .Font.Name
.BMPBtn.Font.Size = .Font.Size
.BMPBtn.Font.COLOR = .Font.COLOR
.BMPBtn.Font.Bold = .Font.Bold
.BMPBtn.Font.Italic = .Font.Italic
.BMPBtn.Font.Underline = .Font.Underline
COLOR = IIF(super.enabled = 1, .font.COLOR, -2147483631)
capwidth = (.Width -( .TextWidth( FIELD$( .CAPTION, rqSL, True) ) )) \2
IF .ICOBMP.Empty = False THEN
.ICOBMP.PixelFormat = PixelFormatFix_QTBtn
.ICOBMP.Transparent = 1
END IF
DIM startFrom AS INTEGER, endTo AS INTEGER
IF .Enabled = True THEN
startFrom = False
endTo = .NumBMPs -True
ELSE
startFrom = True
endTo = True
END IF
DIM LineCount AS INTEGER
DIM Down AS INTEGER
IF .CAPTION <> "" THEN
FOR I = startFrom TO endTo STEP 2
IF I = False AND .Down = True THEN _
Down = True _
ELSE Down = False
.cRect.Left = (I *(.Width +3)) +True +Down
.cRect.Top = True + Down
.cRect.Right = .Width +.cRect.Left
.cRect.Bottom = .Height +True
IF .ICOBMP.Empty = False THEN
SELECT CASE .Layout
CASE True
.cRect.Left = .cRect.Left -((.ICOBMP.Width \.NumICOBMPs) _
+.Spacing) +Down
CASE 2
.cRect.Top = .cRect.Top +((.ICOBMP.Height +.TextHeight(.CAPTION)) \2) _
+.Spacing +Down
CASE 3
.cRect.Top = .cRect.Top -((.ICOBMP.Height +.TextHeight(.CAPTION)) \2) _
+.Spacing +Down
CASE ELSE
.cRect.Left = .cRect.Left +(.ICOBMP.Width \.NumICOBMPs) _
+.Spacing +Down
END SELECT
END IF
LineCount = TALLY(.CAPTION, rqSL) +TALLY(.CAPTION, "\n") +True
.BMPBtn.Font.COLOR = COLOR
SetBkMode_QTBtn This.BMPBtn.Handle, True
IF LineCount > True THEN
.cRect.Top = .cRect.Top +(((.Height -3 -True) -(.TextHeight(.CAPTION) *(LineCount -True))) /3)
DrawText_QTBtn (This.BMPBtn.Handle, This.CAPTION, LEN(This.CAPTION), _
This.cRect, DT_CENTER_QTBtn)
ELSE
DrawText_QTBtn (This.BMPBtn.Handle, This.CAPTION, LEN(This.CAPTION), _
This.cRect, DT_CENTER_QTBtn OR DT_SINGLELINE_QTBtn OR DT_VCENTER_QTBtn)
END IF
NEXT I
END IF
IF .ICOBMP.Empty = False THEN
DIM ICOtmp AS QBITMAP
ICOtmp.Width = .ICOBMP.Width \.NumICOBMPs
ICOtmp.Height = .ICOBMP.Height
WITH Dest: .Left = False: .Right = ICOtmp.Width
.Top = False: .Bottom = ICOtmp.Height
END WITH
FOR I = startFrom TO endTo STEP 2
left = IIF(.Layout > True, .Width \2, capwidth)
left = left +(I *(.Width +3)) +True _
+IIF(.Layout < 2 AND .CAPTION <> "", _
IIF(.Layout = False, -((.ICOBMP.Width \.NumICOBMPs) +.Spacing) \2, _
(.ICOBMP.Width \.NumICOBMPs) \2), _
-(.ICOBMP.Width \.NumICOBMPs) \2 -True)
top = ((.Height +3) -.ICOBMP.Height) \2
SELECT CASE .Layout
CASE 2
top = top -((.TextHeight(.CAPTION) +.Spacing) \2) +Down
CASE 3
top = top +((.TextHeight(.CAPTION) +.Spacing) \2) +Down
CASE ELSE
END SELECT
WITH Source: .Left = I *(This.ICOBMP.Width \This.NumICOBMPs)
.Right = .Left +(This.ICOBMP.Width \This.NumICOBMPs)
.Top = False: .Bottom = ICOtmp.Height
END WITH
ICOtmp.CopyRect(This.Dest, This.ICOBMP, This.Source)
ICOtmp.Transparent = True
.BMPBtn.Draw ( left, _
top, _
ICOtmp.BMP)
NEXT I
END IF
.BMP = .BMPBtn.BMP
END SUB
PUBLIC:
SUB ReDraw
DIM FastDraw AS INTEGER
FastDraw = False
IF .BtnNeedDraw = False AND (_
.propID = 2 OR _
.propID = 4 OR _
.propID = 5 OR _
.propID = 8 OR _
.propID = 9 OR _
.propID = 10 OR _
.propID = 11 OR _
.propID = 13 OR _
.propID = 14) THEN
.BMPBtn.BMP = .BMPBtnClean.BMP
FastDraw = True
END IF
.BtnNeedDraw = False
.propID = False
rWidth = Super.Width
rHeight = Super.Height
IF .Width = False OR .Height = False THEN .FixBtnSize
STATIC checkICO AS INTEGER
IF checkICO = False AND .kind = False THEN
.ICOBMP.BMP = .BMP
checkICO = True
END IF
IF .NumBMPs > maxnumbmp_QTBtn THEN .NumBMPs = maxnumbmp_QTBtn
IF FastDraw = False THEN
BMPStretch_Property(This.XPThemeEnabled, This.XPThemeWasEnabled, _
This.XPThemeBtnType, This.XPThemeBtnTypeWas, _
This.HideBevelSize, _
This)
.BMPBtn.BMP = .BMP
.BMPBtnClean.BMP = .BMPBtn.BMP
.BMPBtn.PixelFormat = DefPixelFormat
.BMPBtn.TransparentColor = .BMPBtn.Pixel(True, True)
END IF
.BMPBtn.PixelFormat = DefPixelFormat
.BMPBtn.TransparentColor = .BMPBtn.Pixel(True, True)
IF .CAPTION = "" THEN
Super.Layout = 0
ELSE: .BMPBtn.Height = .BMPBtn.Height +.TextHeight(.CAPTION) +2
Super.Layout = 3
END IF
.BMPtmp.Height = .BMPBtn.Height
IF FastDraw = False THEN _
.BMPBtnClean.Height = .BMPBtn.Height
.DrawCaption
IF .NumBMPs >= maxnumbmp_QTBtn THEN
WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
WITH Source: .Left = False: .Right = This.Dest.Right
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
.BMPtmp.Width = .Dest.Right: .BMPtmp.Height = .BMPBtn.Height
.BMPtmp.CopyRect(This.Dest, This.BMPBtn, This.Source)
END IF
END SUB
PRIVATE:
SUB DrawDownUp
IF .BtnNeedDraw THEN .ReDraw
IF .NumBMPs >= 3 THEN
WITH Dest: .Left = This.Down: .Right = .Left +(This.BMPBtn.Width -True) \This.NumBMPs
.Top = This.Down: .Bottom = .Top +This.BMPBtn.Height
END WITH
IF .Down = True THEN
WITH Source: .Left = (This.Dest.Right -True) *2
.Right = .Left +This.Dest.Right -True
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
.BMPBtn.CopyRect(This.Dest, This.BMPBtn, This.Source)
ELSE
.BMPBtn.StretchDraw(This.Dest, This.BMPtmp.BMP)
END IF
.BMP = .BMPBtn.BMP
.DrawCaption
END IF
END SUB
SUB ReleaseHotTrack
ReleaseCapture_QTBtn
.Font.COLOR = clBtnText
IF .NumBMPs => maxnumbmp_QTBtn AND .Down = False THEN
WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
.BMPBtn.StretchDraw(This.Dest, This.BMPtmp.BMP)
END IF
.DrawCaption
END SUB
PUBLIC:
EVENT OnMouseUp(btn AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
.ReleaseHotTrack
IF .GroupIndex > False THEN
IF AllQTBtnsRequester = False AND btn = False THEN
STATIC currHwnd AS LONG
DIM I AS INTEGER
AllQTBtnsRequester = .Handle
IF AllQTBtnsRequesterParent = False THEN _
AllQTBtnsRequesterParent = GetParent_QTBtn(This.Handle)
FOR I = False TO AllQTBtnsHandle.ItemCount -True
IF VAL(AllQTBtnsGrouped.Item(I)) = .GroupIndex AND _
GetParent_QTBtn(VAL(AllQTBtnsHandle.Item(I))) = AllQTBtnsRequesterParent THEN
currHwnd = VAL(AllQTBtnsHandle.Item(I))
IF IsWindowEnabled_QTBtn(currHwnd) = True THEN
IF currHwnd <> .Handle THEN
$TYPECHECK Off
CALL SendMessage_QTBtn(currHwnd, WM_LBUTTONUP_QTBtn, False, BYVAL 0&)
CALL SendMessage_QTBtn(currHwnd, WM_MOUSELAST_QTBtn, False, BYVAL 0&)
$TYPECHECK ON
ELSEIF currHwnd = .Handle THEN
.Down = True
END IF
END IF
END IF
NEXT I
IF .ActAsToolBar = False THEN _
SetFocus_QTBtn(.Handle)
currHwnd = False
AllQTBtnsRequester = False
AllQTBtnsRequesterParent = False
.DrawDownUp
ELSEIF (AllQTBtnsRequester <> False AND AllQTBtnsRequester <> .Handle) AND _
GetParent_QTBtn(This.Handle) = AllQTBtnsRequesterParent THEN
IF VAL(AllQTBtnsGrouped.Item(AllQTBtnsHandle.IndexOf(STR$(AllQTBtnsRequester)))) = .GroupIndex AND _
.Down = True THEN
.Down = False
.DrawDownUp
END IF
END IF
END IF
END EVENT
PRIVATE:
EVENT OnMouseMove(X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
STATIC PosX AS INTEGER, PosY AS INTEGER
IF .ActAsToolBar = True AND GetFocus_QTBtn() <> .Handle THEN _
.PrevFocus = GetFocus_QTBtn()
WITH Dest: .Left = False: .Right = (This.BMPBtn.Width -True) \This.NumBMPs
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
IF (X < False) OR (Y < False) OR _
(X > .Width) OR (Y > .Height) THEN
.ReleaseHotTrack
CALLFUNC(.OnMouseLeave, X, Y, Shift, This)
ELSEIF (GetCapture_QTBtn() <> .Handle) AND (RequestRelease = False _
AND PosX <> X AND PosY <> Y) THEN
PosX = X
PosY = Y
SetCapture_QTBtn .Handle
.Font.COLOR = clHilight
IF .NumBMPs => maxnumbmp_QTBtn AND .Down = False THEN
WITH Source: .Left = This.Dest.Right *(This.NumBMPs -True)
.Right = .Left +This.Dest.Right
.Top = False: .Bottom = This.BMPBtn.Height
END WITH
.BMPBtn.CopyRect(This.Dest, This.BMPBtn, This.Source)
END IF
.DrawCaption
CALLFUNC(.OnMouseEnter, X, Y, Shift, This)
ELSEIF RequestRelease = True THEN
.ReleaseHotTrack
END IF
IF (PosX <> X AND PosY <> Y) THEN RequestRelease = False
END EVENT
PUBLIC:
PROPERTY SET SetLayout (lplayout AS INTEGER)
.Layout = lplayout
.propID = 14
IF .BtnNeedDraw THEN
.ReDraw
ELSE
.DrawCaption
END IF
END PROPERTY
PROPERTY SET SetSpacing (lpspacing AS INTEGER)
.Spacing = lpspacing
.propID = 9
IF .BtnNeedDraw THEN
.ReDraw
ELSE
.DrawCaption
END IF
END PROPERTY
PROPERTY SET SetCaption (lpcaption AS STRING)
.CAPTION = lpCaption
.CAPTION = REPLACESUBSTR$(.CAPTION, "\n", rqSL)
Super.CAPTION = lpcaption -CHR$(10) -CHR$(13) -"\n"
.propID = 2
.ReDraw
END PROPERTY
PROPERTY SET SetEnabled (lpenabled AS INTEGER)
Super.Enabled = lpenabled: .Enabled = lpenabled
.propID = 4
IF .BtnNeedDraw THEN
.ReDraw
ELSE
.DrawCaption
END IF
END PROPERTY
PROPERTY SET SetHeight (lpheight AS INTEGER)
.Height = lpheight: Super.Height = lpheight
.propID = 6
.ReDraw
END PROPERTY
PROPERTY SET SetWidth (lpwidth AS INTEGER)
.Width = lpwidth: Super.Width = lpwidth
.propID = 7
.ReDraw
END PROPERTY
PROPERTY SET SetNumBMPs (lpnumbmps AS INTEGER)
.NumBMPs = lpnumbmps: Super.NumBMPs = lpnumbmps
.propID = 12
.ReDraw
END PROPERTY
PROPERTY SET SetNumICOBMPs (lpnumicobmps AS INTEGER)
.NumICOBMPs = lpnumicobmps
.propID = 13
IF .BtnNeedDraw = False THEN
.ReDraw
ELSE
.DrawCaption
END IF
END PROPERTY
PROPERTY SET SetKind (lpkind AS INTEGER)
DIM numbmps AS INTEGER
numbmps = .NumBMPs
IF lpKind > False THEN
.Kind = lpkind: Super.Kind = lpkind
.NumICOBMPs = 2
.ICOBMP.BMP = .BMP
END IF
CALL FixKind_QTBtn (numbmps, This)
.propID = 8
.ReDraw
END PROPERTY
PROPERTY SET SetGroupIndex (lpIndex AS INTEGER)
.GroupIndex = lpIndex
CALL SetIndex_QTBtn(lpIndex, .Handle)
END PROPERTY
PROPERTY SET SetDown (lpDown AS INTEGER)
.Down = lpDown
.propID = 3
.DrawDownUp
END PROPERTY
PROPERTY SET SetXPThemeEnabled(lpEnabled AS INTEGER)
.XPThemeEnabled = lpEnabled
.propID = 15
IF .XPThemeEnabled <> .XPThemeWasEnabled THEN _
.ReDraw
.XPThemeWasEnabled = lpEnabled
END PROPERTY
PROPERTY SET SetXPThemeBtnType(lpBtnType AS STRING)
.XPThemeBtnType = lpBtnType
.propID = 16
IF (.XPThemeBtnType <> .XPThemeBtnTypeWas) AND _
.XPThemeEnabled = True THEN _
.ReDraw
.XPThemeBtnTypeWas = lpBtnType
END PROPERTY
PROPERTY SET SetNewBtnRegion(lpnewregion AS INTEGER)
.FlickeringTrick = lpnewregion
IF .FlickeringTrick > False THEN
HideBevelTrick_QTBtn(This, 2)
.HideBevelSize = 2
END IF
END PROPERTY
PROPERTY SET SetHideFocusRect(lpnewregion AS INTEGER)
.HideFocusRect = lpnewregion
IF .HideFocusRect > False THEN
HideBevelTrick_QTBtn(This, 5)
.HideBevelSize = 5
END IF
END PROPERTY
CONSTRUCTOR
BtnNeedDraw = True
XPThemeEnabled = True
XPThemeWasEnabled = True
XPThemeBtnType = xpt_PushBtn
XPThemeBtnTypeWas = xpt_PushBtn
BMPtmp.PixelFormat = DefPixelFormat
BMPBtn.PixelFormat = DefPixelFormat
Spacing = maxnumbmp_QTBtn
Enabled = True
NumBMPs = True
NumICOBMPs = True
Layout = False
Down = False
OnKeyDown = QTButton_KeyDown
END CONSTRUCTOR
END WITH
END TYPE
DIM DrawCount AS INTEGER
SUB BMPStretch_Property
DIM Dest AS QRECT, Source AS QRECT
DIM Bitmap1 AS QBITMAP, _
XPBitmap1 AS QBITMAP
DIM XPBtnType AS STRING
DIM Width1 AS INTEGER, Height1 AS INTEGER
DIM Width2 AS INTEGER, Height2 AS INTEGER
DIM btnCount AS INTEGER
btnCount = Sender.NumBMPs
IF btnCount > maxnumbmp_QTBtn THEN
btnCount = maxnumbmp_QTBtn
sender.numbmps = btncount
END IF
Width1 = ((Sender.Width +3) *btnCount) +True
Height1 = Sender.Height +3
DOEVENTS
IF QTBtnOptimize <> True OR _
(XPThemeEnabled <> XPThemeWasEnabled) OR _
((BtnType <> BtnTypeWas) AND XPThemeEnabled = True) OR _
((XPBtnType <> BtnType) AND XPThemeEnabled = True) OR _
((rWidth > False OR rHeight > False) AND _
(Bitmap1.Width <> Width1 AND Bitmap1.Height <> Height1 AND _
Width2 <> Bitmap1.Width AND Height2 <> Bitmap1.Width)) THEN
DrawCount ++
WITH Bitmap1
.Width = Width1
.Height = Height1
.FillRect(False, False, .Width, .Height, clBtnFace)
END WITH
WITH XPBitmap1
.Width = Width1
.Height = Height1
.FillRect(False, False, .Width, .Height, clBtnFace)
END WITH
Width1 = Sender.Width *btnCount
Height1 = Sender.Height
IF XPThemeEnabled = False OR isXP_QTBtn = False THEN
DIM J AS INTEGER, I AS INTEGER
FOR J = False TO btnCount -True
WITH Dest
.Left = ((Width1 \btnCount) *J) +3 +(True *(J +True)) +(J *2) -IIF(J = 2, True, False)
.Top = maxnumbmp_QTBtn -IIF(J=2, True, False)
.Right = .Left +(Width1 \btnCount) -6
.Bottom = Height1 -2 -IIF(J = 2, True, False)
END WITH
WITH Source: .Left = ((QTBtnBMP.Width \btnCount) *J) +3: .Top = 3: _
.Right = .Left +(QTBtnBMP.Width \btnCount) -6
.Bottom = QTBtnBMP.Height -3
END WITH
Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
FOR I = False TO 3
WITH Dest
.Left = ((Width1 \btnCount) *J) _
+IIF(I = False OR I = 2, False, (Width1 \btnCount) -3) +(True *(J +True)) +(J *2) _
-IIF(J = 2, True, False)
.Top = IIF(I<2, True, Height1 -2) -IIF(J = 2, True, False)
.Right = .Left +3
.Bottom = .Top +3
END WITH
WITH Source
.Left = ((QTBtnBMP.Width \btnCount) *J) _
+IIF(I = False OR I = 2, False, (QTBtnBMP.Width \btnCount) -3)
.Top = IIF(I < 2, False, QTBtnBMP.Height -3)
.Right = .Left +3
.Bottom = .Top +3
END WITH
Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
NEXT I
FOR I = False TO True
WITH Dest
.Left = ((Width1 \btnCount) *J) +3 +(True *(J +True)) +(J *2) -IIF(J = 2, True, False)
.Top = IIF(I = False, True, Height1 -2) -IIF(J = 2, True, False)
.Right = .Left +(Width1 \btnCount) -6
.Bottom = .Top +3
END WITH
WITH Source
.Left = (QTBtnBMP.Width \btnCount) *J +3
.Top = IIF(I = False, False, QTBtnBMP.Height -3)
.Right = .Left +(QTBtnBMP.Width \btnCount) -6
.Bottom = .Top +3
END WITH
Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
NEXT I
FOR I = False TO True
WITH Dest
.Left = ((Width1 \btnCount) *J) _
+IIF(I = False, False, (Width1 \btnCount) -3) +(True *(J +True)) +(J *2) _
-IIF(J = 2, True, False)
.Top = maxnumbmp_QTBtn -IIF(J = 2, True, False)
.Right = .Left +3
.Bottom = Height1 -2 -IIF(J = 2, True, False)
END WITH
WITH Source
.Left = ((QTBtnBMP.Width \btnCount) *J) +IIF(I = False, False, (QTBtnBMP.Width \btnCount) -3)
.Top = 3
.Right = .Left +3
.Bottom = QTBtnBMP.Height -3
END WITH
Bitmap1.CopyRect(Dest, QTBtnBMP, Source)
NEXT I
NEXT J
Bitmap1.PixelFormat = DefPixelFormat
ELSE
DIM hTheme AS LONG
DIM rtButton AS STRING
rtButton = ""
FOR I = True TO LEN(BtnType)
rtButton = rtButton +MID$(BtnType, I, True) +rqNullChr
NEXT I
rtButton = rtButton +rqNullChr
DIM fixTab AS INTEGER
fixTab = False
IF BtnType = xpt_TabBtn THEN _
fixTab = True
hTheme = OpenThemeData_QTBtn(Sender.Handle, VARPTR(rtButton))
IF hTheme = False THEN _
hTheme = OpenThemeData_QTBtn(Sender.Handle, 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 = XPBitmap1.Handle
m_lPartId = True
FOR I = False TO 2 STEP 2
m_lStateId = I +True
tR.Left = ((I *(Sender.Width +3)) +IIF(I <> 2, True, False)) +HideBevelSize
tR.Top = True -IIF(I <> 2, False, True) +HideBevelSize
tR.Right = (tR.Left +Sender.Width) -(HideBevelSize *2)
tR.Bottom = (Sender.Height +True -IIF(I <> 2, False, True) +fixTab) -HideBevelSize
lR = DrawThemeBackground_QTBtn(hTheme, _
m_hDC, _
m_lPartId, _
m_lStateId, _
tR, tR)
NEXT I
FOR I = True TO 3 STEP 2
m_lStateId = I +True
tR.Left = (((I +IIF(I = True, 2, -2)) *(Sender.Width +3)) +True) +HideBevelSize
tR.Top = True +HideBevelSize
tR.Right = (tR.Left +Sender.Width) -(HideBevelSize *2)
tR.Bottom = Sender.Height +True +fixTab -HideBevelSize
lR = DrawThemeBackground_QTBtn(hTheme, _
m_hDC, _
m_lPartId, _
m_lStateId, _
tR, tR)
NEXT I
END IF
CloseThemeData_QTBtn hTheme
CloseThemeData_QTBtn hTheme
XPBitmap1.PixelFormat = DefPixelFormat
END IF
END IF
Width2 = ((Sender.Width +3) *btnCount) +True
Height2 = Sender.Height +3
XPBtnType = BtnType
IF XPThemeEnabled = False OR isXP_QTBtn = False THEN
Sender.BMP = Bitmap1.BMP
ELSE
Sender.BMP = XPBitmap1.BMP
END IF
END SUB
|
|