romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
comun/utile/hpdf/ReportOutput/ctl32_progressbar_old.vc2

1672 lines
43 KiB
Plaintext
Raw Permalink Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_progressbar_old.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS ctl32_progressbar AS control
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="lblControlNameH" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="tmrControlTimer" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblControlNameV" UniqueID="" Timestamp="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: backcolor_assign
*m: barcolor_assign
*m: bordercolor_assign
*m: border_assign
*m: ctl32_bindevents && Binds events.
*m: ctl32_create
*m: ctl32_createcaption
*m: ctl32_declaredlls && DLL declarations.
*m: ctl32_destroy
*m: ctl32_resize && Bound to Form.Resize
*m: ctl32_setborder
*m: ctl32_setflat
*m: ctl32_setrighttoleft
*m: ctl32_settheme
*m: ctl32_unbindevents
*m: ctl32_wm_paint
*m: flat_assign
*m: height_assign
*m: hwnd_access
*m: hwnd_assign
*m: marqueeanimationspeed_assign
*m: marqueespeed_access
*m: marqueespeed_assign
*m: marquee_assign
*m: maximum_assign
*m: max_assign
*m: minimum_assign
*m: min_assign
*m: orientation_assign
*m: percent_access
*m: percent_assign
*m: play_assign
*m: repeat_assign
*m: reset && Resets the Value property to the Minimum value.
*m: righttoleft_assign
*m: scrolling_assign
*m: smooth_assign
*m: stepit && Increments the value of the control by the amount specified in step. If a numeric parameter is passed, that value is used instead of the value set in the step property.
*m: step_assign
*m: themes_assign
*m: uformatasbytes
*m: uisxp
*m: ustrtolong
*m: value_access
*m: value_assign
*m: vertical_assign
*m: visible_assign
*m: width_assign
*p: barcolor && Specifies the color of the progress bar. A value of -1 resets color to system default. Backcolor specifies the color of the background, a value of -1 resets color to system default.
*p: border
*p: builderx
*p: caption && The Caption gets generated based on the string stored in the Text property
*p: ctl32_backcolor
*p: ctl32_controlhwnd && CreateWindowEx return value.
*p: ctl32_creating
*p: ctl32_dwexstyle && CreateWindowEx parameter.
*p: ctl32_dwstyle && CreateWindowEx parameter.
*p: ctl32_flat
*p: ctl32_formtype
*p: ctl32_height
*p: ctl32_hinstance && CreateWindowEx parameter.
*p: ctl32_hmenu && CreateWindowEx parameter.
*p: ctl32_hosthwnd && CreateWindowEx parameter.
*p: ctl32_hwndparent
*p: ctl32_left
*p: ctl32_lpclassname && CreateWindowEx parameter.
*p: ctl32_lpparam && CreateWindowEx parameter.
*p: ctl32_lpwindowname && CreateWindowEx parameter.
*p: ctl32_name && Name of the control class
*p: ctl32_oldproc
*p: ctl32_oldstep && Saves old Step value when the StepIt method is called with a parameter.
*p: ctl32_pbproc
*p: ctl32_proxyhwnd && Static window hwnd
*p: ctl32_top
*p: ctl32_version
*p: ctl32_width
*p: flat && Especifies if the flat style is active.
*p: hwnd && Specifies the Window handle of the Control.
*p: marquee && Especifies if the marquee style is active. When set to true, the Smooth property is set to false to avoid wrong display of bars when using XP with no themes.
*p: marqueeanimationspeed && Specifies the speed of the marquee bar, in milliseconds.
*p: marqueespeed
*p: max && For compatibility only. Use Maximum property instead.
*p: maximum && Specifies the upper limit of the value property. Must be a positive or negative number larger than minimum.
*p: min && For compatibility only. Use Minimum property instead.
*p: minimum && Specifies the lower limit of the value property. Must be a positive or negative number smaller than Maximum
*p: orientation && For compatibility only. Use Vertical property instead. 0: Horizontal, 1:Vertical
*p: parenthwnd && Especifies the handle of the parent window of the control.
*p: percent && Specifies the percent of the value property relative to the total of maximum - minimum.
*p: play && When True, fires the StepIt method every 100 milliseconds. To set the speed, change the value of the step property.
*p: repeat && Specifies if the controls rolls over to minimum when value reaches maximum. Use it with Play to display a self updating progressbar.
*p: righttoleft && Specifies if the control should draw right to left.
*p: scrolling && For compatibility only. Use Smooth property instead.
*p: sizeadjust && Adjusts Width/Height of Horizontal/Vertical ProgressBar so that bars show even and complete at the end/top. Use only with Themes applied in Windows XP.
*p: smooth && Specifies if the progressbar is shown using segments, or using a continuous bar.
*p: step && Determines the value to use in the stepit method. Can be a positive or negative value.
*p: text && Text string used to generate the caption. Check Help File
*p: themes && Not Used
*p: value && Specifies the current value of the control.
*p: vertical && Specifies if the progressbar is vertical or horizontal.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN ActiveControl,AddProperty,BackStyle,BorderWidth,Click,ColorSource,ControlCount,Controls,ctl32_controlhwnd,ctl32_creating,ctl32_dwexstyle,ctl32_dwstyle,ctl32_height,ctl32_hinstance,ctl32_hmenu,ctl32_left,ctl32_lpclassname,ctl32_lpparam,ctl32_lpwindowname,ctl32_oldstep,ctl32_proxyhwnd,ctl32_top,ctl32_width,DblClick,DragDrop,DragIcon,DragMode,DragOver,Drag,Draw,Enabled,ForeColor,GotFocus,HelpContextID,LostFocus,MiddleClick,MouseDown,MouseEnter,MouseIcon,MouseLeave,MouseMove,MousePointer,MouseUp,MouseWheel,Moved,Move,Objects,OLECompleteDrag,OLEDragDrop,OLEDragMode,OLEDragOver,OLEDragPicture,OLEDrag,OLEDropEffects,OLEDropHasData,OLEDropMode,OLEGiveFeedback,OLESetData,OLEStartDrag,Picture,Refresh,ResetToDefault,Resize,RightClick,SaveAsClass,SetFocus,ShowWhatsThis,SpecialEffect,StatusBarText,Style,TabStop,ToolTipText,WhatsThisHelpID,WriteExpression,WriteMethod
PROTECTED builderx,ctl32_name,ctl32_version
*<PropValue>
barcolor = -1
border = .F.
builderx = (home() + "wizards\ctl32_progressbar_builder.app")
caption =
ctl32_backcolor = 0
ctl32_controlhwnd = 0
ctl32_dwexstyle = 0
ctl32_dwstyle = 0
ctl32_formtype = 0
ctl32_height = 0
ctl32_hinstance = 0
ctl32_hmenu = 0
ctl32_hosthwnd = 0
ctl32_hwndparent = 0
ctl32_left = 0
ctl32_lpparam = 0
ctl32_lpwindowname = 0
ctl32_name = ctl32_progressbar
ctl32_oldproc =
ctl32_oldstep = 0
ctl32_pbproc =
ctl32_proxyhwnd = 0
ctl32_top = 0
ctl32_version = 3.0
ctl32_width = 0
flat = .F.
ForeColor = 0,0,0
Height = 18
hwnd = 0
marqueeanimationspeed = 100
marqueespeed = 100
max = 0
maximum = 100
min = 0
minimum = 0
Name = "ctl32_progressbar"
orientation = 0
parenthwnd = 0
percent = 0
righttoleft = .F.
scrolling = 0
step = 1
text =
themes = .T.
value = 0
Width = 301
*</PropValue>
ADD OBJECT 'lblControlNameH' AS label WITH ;
Anchor = 7, ;
BackStyle = 0, ;
Caption = "ctl32_ProgressBar", ;
FontName = "Tahoma", ;
FontSize = 8, ;
FontStrikethru = .F., ;
FontUnderline = .F., ;
ForeColor = 0,0,128, ;
Height = 15, ;
Left = 6, ;
Name = "lblControlNameH", ;
Top = 1, ;
Width = 89
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblControlNameV' AS label WITH ;
Anchor = 7, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "ctl32_ProgressBar", ;
FontName = "Tahoma", ;
FontSize = 8, ;
FontStrikethru = .F., ;
FontUnderline = .F., ;
ForeColor = 0,0,128, ;
Height = 96, ;
Left = 0, ;
Name = "lblControlNameV", ;
Rotation = 90, ;
Top = 18, ;
Width = 16
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'tmrControlTimer' AS timer WITH ;
Enabled = .F., ;
Height = 23, ;
Interval = 100, ;
Left = -25, ;
Name = "tmrControlTimer", ;
Top = 0, ;
Width = 23
*< END OBJECT: BaseClass="timer" />
HIDDEN PROCEDURE backcolor_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter for BackColor must be Numeric])
Endif
If m.vNewVal > 16777215 Then
m.vNewVal = -1
Endif
This.ctl32_BackColor = m.vNewVal
This.BackColor= m.vNewVal
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
If This.ctl32_BackColor = -1 Then
SendMessageN(This.ctl32_ControlHwnd, PBM_SETBKCOLOR, 0, CLR_DEFAULT)
Else
SendMessageN(This.ctl32_ControlHwnd, PBM_SETBKCOLOR, 0, This.BackColor)
Endif
Return
ENDPROC
HIDDEN PROCEDURE barcolor_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter for BarColor must be Numeric])
Endif
If m.vNewVal > 16777215 Then
m.vNewVal = -1
Endif
This.BarColor = m.vNewVal
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
If This.BarColor = -1 Then
SendMessageN(This.ctl32_ControlHwnd, PBM_SETBARCOLOR, 0, CLR_DEFAULT)
Else
SendMessageN(This.ctl32_ControlHwnd, PBM_SETBARCOLOR, 0, This.BarColor)
Endif
Return
ENDPROC
HIDDEN PROCEDURE bordercolor_assign
LPARAMETERS vNewVal
If m.vNewVal = -1 Then
m.vNewVal = RGB(0,0,0)
Endif
THIS.BorderColor = m.vNewVal
ENDPROC
PROCEDURE border_assign
Lparameters vNewVal
This.Border = m.vNewVal
If This.ctl32_Creating = TRUE Then
Return
Endif
This.ctl32_SetBorder()
ENDPROC
HIDDEN PROCEDURE ctl32_bindevents && Binds events.
Bindevent(This, [Resize], This, [ctl32_Resize], 1)
Bindevent(This, [Top], This, [ctl32_Resize], 1)
Bindevent(This, [Left], This, [ctl32_Resize], 1)
Bindevent(This, [Value], This, [ctl32_CreateCaption], 1)
*!* ?This.ctl32_Hosthwnd, This.ctl32_Controlhwnd
*!* Bindevent(This.ctl32_Controlhwnd , WM_PAINT, This, [ctl32_WM_Paint], 1)
ENDPROC
PROCEDURE ctl32_create
With This
If .ctl32_Creating Then
Return
Endif
.ctl32_Creating = TRUE
*!* Define parameters for progressbar CreateWindowEx:
.ctl32_dwExStyle = 0
.ctl32_lpClassName = [msctls_progress32]
.ctl32_lpWindowName = .ctl32_lpClassName + Sys(2015)
.ctl32_dwStyle = Bitor(WS_CHILD, WS_CLIPSIBLINGS)
.ctl32_hWndParent = .ctl32_HostHwnd
.ctl32_Left = .Left
.ctl32_Top = .Top
.ctl32_Width = .Width
.ctl32_Height = .Height
*!* Setup Control specific Styles that have to be set at window creation:
*!* Marquee
If .Marquee = TRUE Then
.ctl32_dwStyle = Bitor(.ctl32_dwStyle, PBS_MARQUEE)
Endif
*!* Smooth
If .Smooth = TRUE
.ctl32_dwStyle = Bitor(.ctl32_dwStyle, PBS_SMOOTH)
Endif
*!* Orientation
If .Vertical = TRUE Or .Orientation <> 0 Then
.ctl32_dwStyle = Bitor(.ctl32_dwStyle, PBS_VERTICAL)
Endif
.ctl32_hMenu = 0
.ctl32_hInstance = GetWindowLong(.ctl32_HostHwnd, GWL_HINSTANCE)
.ctl32_lpParam = 0
.ctl32_ControlHwnd = CreateWindowEx( ;
.ctl32_dwExStyle, ;
.ctl32_lpClassName, ;
.ctl32_lpWindowName, ;
.ctl32_dwStyle, ;
.ctl32_Left, ;
.ctl32_Top, ;
.ctl32_Width, ;
.ctl32_Height, ;
.ctl32_hWndParent, ;
.ctl32_hMenu, ;
.ctl32_hInstance, ;
.ctl32_lpParam)
*!* If the handle to the Control is 0 then we have a problem!
If .ctl32_ControlHwnd = 0
Messagebox([Error Creating window ] + .ctl32_lpClassName + [ Host:] + Transform(.ctl32_HostHwnd), 0 + 16, .ctl32_Name)
Endif
.ctl32_BindEvents()
*!* Send Theme message to control:
.ctl32_SetTheme()
*!* Set Control Minimum and Maximum values:
.Min = .Minimum
.Max = .Maximum
*!* Set Control Step Value
.Step = .Step
*!* Set Control Value to the Container Value property
.Value = .Value
*!* .ctl32_SetFlat() Already called by ctl32_SetTheme()
.ctl32_SetBorder()
*!* Set MarqueeAnimationSpeed Value
.MarqueeAnimationSpeed = .MarqueeAnimationSpeed
*!* Set Play state
.Play = .Play
*!* Set Colors
.BackColor = .BackColor
.BarColor = .BarColor
*!* Set Visible state
.Visible = .Visible
*!* We finish Initialization State
.ctl32_Creating = FALSE
Endwith
ENDPROC
PROCEDURE ctl32_createcaption
*!* Bindevent(This, [Value], This, [ctl32_CreateCaption], 1)
If Empty(This.Text) Then
This.Caption = []
Return
Endif
Local ;
lcBVal, ;
lcNVal, ;
lcPVal, ;
lcBMax, ;
lcNMax, ;
lcPMax, ;
lcBMin, ;
lcNMin, ;
lcPMin, ;
lcCaption
m.lcNVal = Transform(This.Value, "999,999,999,999")
m.lcNMax = Transform(This.Maximum, "999,999,999,999")
m.lcNMin = Transform(This.Minimum, "999,999,999,999")
m.lcPVal = Transform(This.Percent, "999%")
m.lcPMax = "100%"
m.lcPMin = "0%"
m.lcBVal = This.uFormatAsBytes(This.Value)
m.lcBMax = This.uFormatAsBytes(This.Maximum)
m.lcBMin = This.uFormatAsBytes(This.Minimum)
m.lcCaption = This.Text
m.lcCaption = Strtran(m.lcCaption , "<<ValueB>>", Alltrim(m.lcBVal), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<ValueN>>", Alltrim(m.lcNVal), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<ValueP>>", Alltrim(m.lcPVal), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MaximumB>>", Alltrim(m.lcBMax), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MaximumN>>", Alltrim(m.lcNMax), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MaximumP>>", Alltrim(m.lcPMax), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MinimumB>>", Alltrim(m.lcBMin), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MinimumN>>", Alltrim(m.lcNMin), 1, 10, 1)
m.lcCaption = Strtran(m.lcCaption , "<<MinimumP>>", Alltrim(m.lcPMin), 1, 10, 1)
This.Caption = lcCaption
ENDPROC
HIDDEN PROCEDURE ctl32_declaredlls && DLL declarations.
*!* 20060516 Commented out all unused API declarations
Local Array laDeclaredDlls(1,3)
Local lnLen
m.lnLen = Adlls(m.laDeclaredDlls)
If Ascan(m.laDeclaredDlls, "CallWindowProc", 1, m.lnLen , 2, 15) = 0
Declare Integer CallWindowProc In win32api As CallWindowProc;
INTEGER lpPrevWndFunc,;
INTEGER HWnd,;
INTEGER msg,;
INTEGER wParam,;
INTEGER Lparam
Endif
*!* If Ascan(m.laDeclaredDlls, "ChildWindowFromPoint", 1, m.lnLen , 2, 15) = 0
*!* Declare Integer ChildWindowFromPoint In win32api ;
*!* INTEGER hWndParent,;
*!* INTEGER px,;
*!* INTEGER py
*!* Endif
If Ascan(m.laDeclaredDlls, "CreateWindowEx", 1, m.lnLen , 2, 15) = 0
Declare Integer CreateWindowEx In win32api As CreateWindowEx;
INTEGER dwExStyle,;
STRING lpClassName,;
STRING lpWindowName,;
INTEGER dwStyle,;
INTEGER x,;
INTEGER Y,;
INTEGER nWidth,;
INTEGER nHeight,;
INTEGER hWndParent,;
INTEGER hMenu,;
INTEGER hInstance,;
INTEGER lpParam
Endif
If Ascan(m.laDeclaredDlls, "DestroyWindow", 1, m.lnLen , 2, 15) = 0
Declare Integer DestroyWindow In win32api As DestroyWindow;
INTEGER HWnd
Endif
If Ascan(m.laDeclaredDlls, "GetClientRect", 1, m.lnLen , 2, 15) = 0
Declare Integer GetClientRect In win32api As GetClientRect;
INTEGER HWnd,;
STRING @ lpRect
Endif
*!* If Ascan(m.laDeclaredDlls, "GetSysColor", 1, m.lnLen , 2, 15) = 0
*!* Declare Integer GetSysColor In win32api ;
*!* INTEGER nIndex
*!* Endif
If Ascan(m.laDeclaredDlls, "GetWindow", 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindow In user32 As GetWindow;
INTEGER HWnd,;
INTEGER wCmd
Endif
If Ascan(m.laDeclaredDlls, "GetWindowLong", 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindowLong In win32api As GetWindowLong;
INTEGER HWnd, ;
INTEGER nIndex
Endif
If Not Val(Os(3)) + Val(Os(4))/100 < 5.01 Then
If Ascan(m.laDeclaredDlls, "IsThemeActive", 1, m.lnLen , 2, 15) = 0
Declare Integer IsThemeActive In uxtheme.Dll As IsThemeActive
Endif
Endif
*!* If Ascan(m.laDeclaredDlls, "PostMessage", 1, m.lnLen , 2, 15) = 0
*!* Declare Integer PostMessage In win32api ;
*!* INTEGER HWnd,;
*!* INTEGER Msg,;
*!* INTEGER wParam,;
*!* INTEGER Lparam
*!* Endif
*!* If Ascan(m.laDeclaredDlls, "RedrawWindow", 1, m.lnLen , 2, 15) = 0
*!* Declare Integer RedrawWindow In win32api ;
*!* INTEGER HWnd,;
*!* STRING @ lprcUpdate,;
*!* INTEGER hrgnUpdate,;
*!* INTEGER fuRedraw
*!* Endif
If Ascan(m.laDeclaredDlls, [SendMessageC], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageC ;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
STRING @ Lparam
ENDIF
If Ascan(m.laDeclaredDlls, "SendMessageN", 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageN;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
Endif
If Ascan(m.laDeclaredDlls, "SetWindowLong", 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowLong In win32api As SetWindowLong;
INTEGER HWnd,;
INTEGER nIndex,;
INTEGER dwNewLong
Endif
If Ascan(m.laDeclaredDlls, "SetWindowPos", 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowPos In win32api As SetWindowPos;
INTEGER HWnd,;
INTEGER hWndInsertAfter,;
INTEGER x,;
INTEGER Y,;
INTEGER cx,;
INTEGER cy,;
INTEGER wFlags
Endif
If Val(Os(3)) + Val(Os(4))/100 >= 5.01 Then
If Ascan(m.laDeclaredDlls, "SetWindowTheme", 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowTheme In UxTheme As SetWindowTheme;
INTEGER HWnd,;
STRING pszSubAppName,;
STRING pszSubIdList
Endif
Endif
*#beautify keyword_nochange
If Ascan(m.laDeclaredDlls, "ShowWindow", 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As ShowWindow ;
INTEGER Hwnd,;
INTEGER nCmdShow
ENDIF
If Ascan(m.laDeclaredDlls, "_ShowWindow", 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As _ShowWindow ;
INTEGER Hwnd,;
INTEGER nCmdShow
ENDIF
*#beautify
If Ascan(m.laDeclaredDlls, "StrFormatByteSize", 1, m.lnLen , 2, 15) = 0
Declare Integer StrFormatByteSize In shlwapi As StrFormatByteSize ;
INTEGER qdw,;
STRING @ pszBuf,;
INTEGER uiBufSize
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_destroy
*!* Destroy Windows
If This.ctl32_ControlHwnd > 0 Then
DestroyWindow(This.ctl32_ControlHwnd)
Endif
If This.ctl32_ProxyHwnd > 0 Then
DestroyWindow(This.ctl32_ProxyHwnd)
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_resize && Bound to Form.Resize
*!* If we are in the Control Init Stage, or
*!* we do not have a handle to the Control yet, just return:
If This.ctl32_Creating = TRUE Or This.ctl32_ControlHwnd = 0 Then
Return
Endif
*!* Else, resize the Control Window to its container size:
With This
.ctl32_Left = .Left
.ctl32_Top = .Top
.ctl32_Width = .Width
.ctl32_Height = .Height
SetWindowPos(.ctl32_ControlHwnd, 0,;
.ctl32_Left, ;
.ctl32_Top, ;
.ctl32_Width, ;
.ctl32_Height, ;
SWP_NOZORDER)
Endwith
ENDPROC
HIDDEN PROCEDURE ctl32_setborder
Local lnExStyle
Local llThemes
m.llThemes = This.uIsXP() And isThemeActive() = 1 And _Screen.Themes And Thisform.Themes And This.Themes
With This
If .Border = TRUE And m.llThemes = FALSE Then
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_STYLE)
m.lnExStyle = Bitset(m.lnExStyle, WS_BORDER_BIT)
SetWindowLong(.ctl32_ControlHwnd, GWL_STYLE, m.lnExStyle)
Else
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_STYLE)
m.lnExStyle = BitClear(m.lnExStyle, WS_BORDER_BIT)
SetWindowLong(.ctl32_ControlHwnd, GWL_STYLE, m.lnExStyle)
Endif
*!* Refresh control window so frame change gets redrawn
SetWindowPos(.ctl32_ControlHwnd, ;
HWND_TOP, ;
0, ;
0, ;
0, ;
0, ;
BITOR(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_FRAMECHANGED))
Endwith
ENDPROC
PROCEDURE ctl32_setflat
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
Local lnExStyle
Local llThemes
m.llThemes = This.uIsXP() And isThemeActive() = 1 And _Screen.Themes And Thisform.Themes And This.Themes
With This
If .Flat = TRUE Or m.llThemes = TRUE Then
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE)
m.lnExStyle = Bitclear(m.lnExStyle, WS_EX_STATICEDGE_BIT) && WS_EX_STATICEDGE
SetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE, m.lnExStyle)
Else
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE)
m.lnExStyle = Bitset(m.lnExStyle, WS_EX_STATICEDGE_BIT) && WS_EX_STATICEDGE
SetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE, m.lnExStyle)
Endif
*!* Refresh control window so frame change gets redrawn
SetWindowPos(.ctl32_ControlHwnd, ;
HWND_TOP, ;
0, ;
0, ;
0, ;
0, ;
BITOR(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_FRAMECHANGED))
Endwith
ENDPROC
PROCEDURE ctl32_setrighttoleft
With This
If .RightToLeft = FALSE Then
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE)
m.lnExStyle = Bitclear(m.lnExStyle, WS_EX_LAYOUTRTL_BIT) && WS_EX_LAYOUTRTL
SetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE, m.lnExStyle)
Else
m.lnExStyle = GetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE)
m.lnExStyle = Bitset(m.lnExStyle, WS_EX_LAYOUTRTL_BIT) && WS_EX_LAYOUTRTL
SetWindowLong(.ctl32_ControlHwnd, GWL_EXSTYLE, m.lnExStyle)
Endif
Endwith
ENDPROC
PROCEDURE ctl32_settheme
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
Local llThemes
m.llThemes = This.uIsXP() And isThemeActive() = 1 And _Screen.Themes And Thisform.Themes And This.Themes
If This.uIsXP() = TRUE
If m.llThemes = TRUE Then
SetWindowTheme(This.ctl32_ControlHwnd, Null, Null)
Else
SetWindowTheme(This.ctl32_ControlHwnd, Null, "")
*This.ctl32_SetBackColor()
Endif
This.ctl32_SetFlat()
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_unbindevents
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
Unbindevent(This, [RESIZE], This, [CTL32_RESIZE])
Unbindevent(This, [TOP], This, [CTL32_RESIZE])
Unbindevent(This, [LEFT], This, [CTL32_RESIZE])
ENDPROC
PROCEDURE ctl32_wm_paint
Lparameters tnHWnd As Integer, tnMsg As Integer, tnwParam As Integer, tnLparam As Integer
If tnHWnd <> _Screen.HWnd Then
?Transform(tnHWnd,"@0")
Endif
With This
*!* If tnMsg = WM_PAINT Then
*!* .CTL32_DrawBorder()
*!* Endif
*!* *SetWindowLong(THIS.ctl32_ControlHwnd, GWL_WNDPROC, This.ctl32_pbProc)
m.lnResult = CallWindowProc(This.ctl32_OldProc, tnHWnd, tnMsg, tnwParam, tnLparam)
*!* *SetWindowLong(THIS.ctl32_ControlHwnd, GWL_WNDPROC, This.ctl32_OldProc)
*!* *This.ctl32_pbProc = SetWindowLong(THIS.ctl32_ControlHwnd, GWL_WNDPROC, This.ctl32_OldProc)
Endwith
Return m.lnResult
ENDPROC
PROCEDURE Destroy
This.Ctl32_Destroy()
ENDPROC
PROCEDURE flat_assign
Lparameters vNewVal
This.Flat = m.vNewVal
This.ctl32_SetFlat()
ENDPROC
PROCEDURE height_assign
Lparameters vNewVal
This.Height = m.vNewVal
With This
If .SizeAdjust = TRUE Then
If .Orientation = 1 Or .Vertical = TRUE Then
.Height = Round((.Height - 8)/8,0) * 8 + 5
Endif
Endif
Endwith
ENDPROC
HIDDEN PROCEDURE hwnd_access
*!* Returns the HWnd of the Control
RETURN This.ctl32_ControlHwnd
ENDPROC
HIDDEN PROCEDURE hwnd_assign
Lparameters vNewVal
Return
ENDPROC
PROCEDURE Init
*!* Ctl32_ProgressBar
*!* Control creado por Carlos Alloatti - calloatti@gmail.com
*!* Utiliza funciones API de Windows
*!* Probado con Windows XP, 98 y VFP 9
*!* Versi<73>n 1.00 - 2005-12-01
*!* Versi<73>n 2.00 - 2006-04-01
*!* Versi<73>n 3.00 - 2006-05-01
*!* This parameter is passed from host ctl32 control
Lparameters tnParentHwnd
This.lblControlNameH.Caption = ""
This.lblControlNameV.Caption = ""
This.BackStyle = 0
With This
*!* Check if object instantiated with a -1 parameter, that means no Init yet
If Pcount() > 0 And m.tnParentHwnd = -1 Then
Return
Endif
If Type([ThisForm]) <> [O] Then
Messagebox([USAGE: _Screen.Newobject("oProgressBar","ctl32_progressbar","ctl32_progressbar.vcx")],16)
Return
Endif
.ctl32_declaredlls()
*!* Save VFP Proc
.ctl32_OldProc = GetWindowLong(_vfp.HWnd, GWL_WNDPROC)
*!* Determine the type of container the StaturBar is in:
*!* CTL32_FORMTYPE_DEFAULT 0
*!* CTL32_FORMTYPE_TOPLEVEL 1
*!* CTL32_FORMTYPE_SCREEN 2
.ctl32_FormType = CTL32_FORMTYPE_DEFAULT
*!* If container is a TLF, must have ShowWindow = 2
If Thisform.ShowWindow = SHOWWINDOW_ASTOPLEVELFORM Then
This.ctl32_FormType = CTL32_FORMTYPE_TOPLEVEL
Endif
*!* If ThisForm.Name equals the _Screen.Name, then container is _Screen
If Thisform.Name = _Screen.Name Then
This.ctl32_FormType = CTL32_FORMTYPE_SCREEN
Endif
If Pcount() > 0 Then
.ctl32_HostHwnd = m.tnParentHwnd
*!* Just in case its geting recreated by a parent ctl32_statusbar
This.ctl32_Destroy()
Else
If .ctl32_FormType = CTL32_FORMTYPE_TOPLEVEL Then && TLF
*!* Get Hwnd of client window of Top Level Form //Craig Boyd//
If Version(5) >= 900 Then
.ctl32_HostHwnd = Sys(2327, Sys(2325, Sys(2326, Thisform.HWnd)))
Else
.ctl32_HostHwnd = GetWindow(Thisform.HWnd, GW_CHILD)
Endif
Else
.ctl32_HostHwnd = Thisform.HWnd
Endif
Endif
If .Parent.BaseClass <> "Form" And .ctl32_HostHwnd = 0 Then
Return
Endif
If .SizeAdjust = TRUE Then
If .Orientation = 1 Or .Vertical = TRUE Then
.Height = Round((.Height - 8)/8,0) * 8 + 5
Else
.Width = Round((.Width - 5)/8,0) * 8 + 5
Endif
Endif
.ctl32_Create()
Endwith
ENDPROC
HIDDEN PROCEDURE marqueeanimationspeed_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.MarqueeAnimationSpeed = m.vNewVal
If This.ctl32_ControlHwnd = 0 Then
Return
ENDIF
SendMessageN(This.ctl32_ControlHwnd, PBM_SETMARQUEE, 1, This.MarqueeAnimationSpeed)
ENDPROC
PROCEDURE marqueespeed_access
Return This.MarqueeAnimationSpeed
ENDPROC
PROCEDURE marqueespeed_assign
LPARAMETERS vNewVal
THIS.marqueespeed = m.vNewVal
This.MarqueeAnimationSpeed = m.vNewVal
ENDPROC
HIDDEN PROCEDURE marquee_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
ENDIF
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.Marquee = m.vNewVal
If This.Marquee = TRUE Then
This.Play = FALSE
Endif
*!* Marquee change needs to recreate Control
If This.ctl32_ControlHwnd <> 0 Then
This.ctl32_Destroy()
This.ctl32_Create()
Endif
ENDPROC
HIDDEN PROCEDURE maximum_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Maximum = m.vNewVal
This.Max = m.vNewVal
*!* If actual Value is greater than new Maximum, set value to new Maximum
If This.Value > This.Maximum Then
This.Value = This.Maximum
Endif
If This.ctl32_ControlHwnd = 0 Then
Return
ENDIF
*!* Set Minimum and Maximum values:
SendMessageN(This.ctl32_ControlHwnd, PBM_SETRANGE32, This.Minimum, This.Maximum)
ENDPROC
HIDDEN PROCEDURE max_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Max = m.vNewVal
This.Maximum = m.vNewVal
ENDPROC
HIDDEN PROCEDURE minimum_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Minimum = m.vNewVal
This.Min = m.vNewVal
*!* If actual Value is less than new Minimum, set value to new Minimum
If This.Value < This.Minimum Then
This.Value = This.Minimum
Endif
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
*!* Set Minimum and Maximum values:
SendMessageN(This.ctl32_ControlHwnd, PBM_SETRANGE32, This.Minimum, This.maximum)
ENDPROC
HIDDEN PROCEDURE min_assign
LPARAMETERS vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Min = m.vNewVal
This.Minimum = m.vNewVal
ENDPROC
HIDDEN PROCEDURE orientation_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Orientation = m.vNewVal
If This.Orientation = 0 Then
This.Vertical = FALSE
Else
This.Vertical = TRUE
Endif
ENDPROC
HIDDEN PROCEDURE percent_access
Return Int(100 * (This.Value - This.Minimum) / (Abs(This.Maximum - This.Minimum)))
ENDPROC
HIDDEN PROCEDURE percent_assign
Lparameters vNewVal
Return
ENDPROC
HIDDEN PROCEDURE play_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
If m.vNewVal = TRUE And This.Marquee = TRUE Then
Return
Endif
This.Play = m.vNewVal
If This.Play = TRUE Then
This.Value = This.Minimum
Endif
This.tmrControlTimer.Enabled = This.Play
ENDPROC
PROCEDURE repeat_assign
LPARAMETERS vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
ENDIF
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
THIS.Repeat = m.vNewVal
ENDPROC
PROCEDURE reset && Resets the Value property to the Minimum value.
This.Value = This.Minimum
ENDPROC
PROCEDURE righttoleft_assign
Lparameters vNewVal
Local lnExStyle
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.RightToLeft = m.vNewVal
This.ctl32_SetRightToLeft()
This.ctl32_SetRightToLeft()
ENDPROC
HIDDEN PROCEDURE scrolling_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Srolling = m.vNewVal
If This.Scrolling = 0 Then
This.Smooth = FALSE
Else
This.Smooth = TRUE
Endif
ENDPROC
HIDDEN PROCEDURE smooth_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
If This.Smooth = m.vNewVal Then
Return
Endif
This.Smooth = m.vNewVal
*!* Smooth change needs to recreate Control
If This.ctl32_ControlHwnd <> 0 Then
This.ctl32_destroy()
This.ctl32_Create()
Endif
ENDPROC
PROCEDURE stepit && Increments the value of the control by the amount specified in step. If a numeric parameter is passed, that value is used instead of the value set in the step property.
Lparameters lnVal
Local lnOldStep
*!* If no numeric parameter, use actual step value:
If Type("m.lnVal") <> "N"
m.lnVal = This.Step
Endif
If This.Repeat = FALSE And This.Value + m.lnVal > This.Maximum Then
This.Value = This.Maximum
Return
Endif
If This.Repeat = FALSE And This.Value + m.lnVal < This.Minimum Then
This.Value = This.Minimum
Return
Endif
*!* If parameter is different from actual step value:
If m.lnVal <> This.Step Then
This.ctl32_OldStep = This.Step
This.Step = m.lnVal
Else
This.ctl32_OldStep = 0
Endif
If This.ctl32_ControlHwnd <> 0 Then
*!* Send StepIt message:
This.Value = This.Value + This.Step
*SendMessageN(This.ctl32_ControlHwnd, PBM_STEPIT, 0, 0)
Endif
*!* Reset Step Value if old value saved:
If This.ctl32_OldStep <> 0 Then
This.Step = This.ctl32_OldStep
Endif
*!* Update Container Value Property with the position property of Control,
*!* forcing Access and Assign Events to fire:
*!* This.Value = This.Value
ENDPROC
HIDDEN PROCEDURE step_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
This.Step = m.vNewVal
If This.ctl32_ControlHwnd = 0 Then
Return
Endif
*!* Set Step Value
SendMessageN(This.ctl32_ControlHwnd, PBM_SETSTEP , This.Step, 0)
ENDPROC
PROCEDURE themes_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.Themes = m.vNewVal
This.ctl32_SetTheme()
ENDPROC
PROCEDURE uformatasbytes
Lparameters qdw
Local pszBuf
m.pszBuf = Replicate(Chr(0), 254)
StrFormatByteSize(m.qdw, @m.pszBuf, Len(m.pszBuf))
m.pszBuf = Alltrim(m.pszBuf)
* Remove chr(0)
m.pszBuf = Left(m.pszBuf,Len(m.pszBuf)-1)
Return Alltrim(m.pszBuf)
ENDPROC
PROCEDURE uisxp
*!* Check OS Version and return TRUE if XP or greater - 5.01 is Windows XP
LOCAL lcXP
m.lcXP = IIF(Val(Os(3)) + Val(Os(4))/100 < 5.01, FALSE, TRUE)
Return m.lcXP
ENDPROC
PROCEDURE ustrtolong
*!* This function converts a four bytes long String to a Long
Lparameters tcLongStr
Local lnx, lnRetval As Integer
*!* Bug Fixed - Doru Constantin
If Version(5) >= 900 Then
m.lnRetval = CToBin(m.tcLongStr,[4RS])
Else
m.lnRetval = 0
For m.lnx = 0 To 24 Step 8
m.lnRetval = m.lnRetval + (Asc(m.tcLongStr) * (2^m.lnx))
m.tcLongStr = Right(m.tcLongStr, Len(m.tcLongStr) - 1)
Next
Endif
Return m.lnRetval
ENDPROC
HIDDEN PROCEDURE value_access
Local nValue
*!* If setting up Control, use Value of Container, not Value of Control
If This.ctl32_Creating = TRUE OR This.ctl32_ControlHWnd = 0 Then
m.nValue = This.Value
Else
*!* Ask Control for Value to return:
m.nValue = SendMessageN(This.ctl32_ControlHwnd, PBM_GETPOS, 0, 0)
Endif
Return m.nValue
ENDPROC
HIDDEN PROCEDURE value_assign
Lparameters vNewVal
If Type("m.vNewVal") <> [N]
Messagebox([Parameter must be Numeric: ] + Program(), 16)
Return
Endif
If This.Repeat = FALSE
If m.vNewVal > This.Maximum Then
Return
Endif
If m.vNewVal < This.Minimum Then
Return
Endif
Else
If m.vNewVal > This.Maximum Then
m.vNewVal = This.Minimum
Endif
If m.vNewVal < This.Minimum Then
m.vNewVal = This.Maximum
Endif
Endif
This.Value = m.vNewVal
If This.ctl32_ControlHWnd <> 0 Then
SendMessageN(This.ctl32_ControlHwnd, PBM_SETPOS, m.vNewVal, 0)
Endif
ENDPROC
HIDDEN PROCEDURE vertical_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
ENDIF
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.Vertical = m.vNewVal
If This.Vertical = TRUE Then
This.Orientation = 1
Else
This.Orientation = 0
Endif
*!* Vertical change needs to recreate Control
If This.ctl32_ControlHwnd <> 0 Then
This.ctl32_destroy()
This.ctl32_Create()
Endif
ENDPROC
HIDDEN PROCEDURE visible_assign
Lparameters vNewVal
If Type("m.vNewVal") = [N] Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
ENDIF
If Type("m.vNewVal") <> [L] Then
Messagebox([Parameter must be Logical: ] + Program(), 16)
Return
Endif
This.Visible = m.vNewVal
If This.ctl32_ControlHwnd = 0 Then
Return
ENDIF
If This.Visible = TRUE Then
_ShowWindow(This.ctl32_ProxyHwnd, SW_SHOWNA)
_ShowWindow(This.ctl32_ControlHwnd, SW_SHOWNA)
Else
_ShowWindow(This.ctl32_ProxyHwnd, SW_HIDE)
_ShowWindow(This.ctl32_ControlHwnd, SW_HIDE)
Endif
ENDPROC
PROCEDURE width_assign
Lparameters vNewVal
*To do: Modify this routine for the Assign method
This.Width = m.vNewVal
With This
If .SizeAdjust = TRUE Then
If .Orientation = 0 Or .Vertical = FALSE Then
.Width = Round((.Width - 5)/8,0) * 8 + 5
Endif
Endif
Endwith
ENDPROC
PROCEDURE tmrControlTimer.Timer
If This.Parent.HWnd = 0 Then
Return
Endif
This.Parent.stepit()
*This.Parent.Value = This.Parent.Value + This.Parent.Step
ENDPROC
ENDDEFINE
DEFINE CLASS ctl32_progressbarlabel AS label
*< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: ctl32_bind
*m: ctl32_declares
*m: ctl32_init
*m: ctl32_unbind
*m: ctl32_update
*m: uformatasbytes
*p: buddycontrol && Especifies the full name of the ctl32_ProgressBar control to bind this label to. For example: ThisForm.ctl32_ProgressBar1
*p: ctl32_name
*p: ctl32_version
*p: labelcaption && Especifies the text to display in the label. Any text can be entered, keywords <<Value>> and <<Maximum>> will be replaced by the progressbar respective values.
*p: labelstyle && Especifies the Style used to display numbers in label text. N: Number, P: Percent, B: Bytes/KB/MB/GB
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED ctl32_name,ctl32_version
*<PropValue>
Alignment = 1
BorderStyle = 0
buddycontrol =
Caption = "ctl32_ProgressBar_Label"
ctl32_name = ctl32_ProgressBarLabel
ctl32_version = 1.1
FontName = "Tahoma"
FontSize = 8
Height = 16
labelcaption = <<Value>>
labelstyle = N
Name = "ctl32_progressbarlabel"
Width = 300
_memberdata = <VFPData>
</VFPData>
*</PropValue>
HIDDEN PROCEDURE ctl32_bind
If Not Empty(This.BuddyControl) Then
If Type(This.BuddyControl) = [U] Then
This.BuddyControl = [ThisForm.] + This.BuddyControl
Endif
Bindevent(Evaluate(This.BuddyControl),"VALUE",This,"CTL32_UPDATE",1)
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_declares
Local Array laDeclaredDlls(1,3)
Local lnLen
m.lnLen = Adlls(m.laDeclaredDlls)
If Ascan(m.laDeclaredDlls, "StrFormatByteSize", 1, m.lnLen , 2, 15) = 0
Declare Integer StrFormatByteSize In shlwapi As StrFormatByteSize ;
INTEGER qdw,;
STRING @ pszBuf,;
INTEGER uiBufSize
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_init
This.Caption = ""
This.ctl32_Declares
This.ctl32_Bind
This.ctl32_Update
ENDPROC
HIDDEN PROCEDURE ctl32_unbind
If Not Empty(This.BuddyControl) Then
Unbindevent(Evaluate(This.BuddyControl),"VALUE",This,"CTL32_UPDATE")
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_update
If Empty(This.BuddyControl)
Return
Endif
If Type("This.LabelStyle") <> [C]
WAIT ([LabelStyle Property must be Character: ] + Program()) WINDOW nowait
Return
Endif
Local lcValue, lcMaximum, lcCaption
Do Case
Case This.LabelStyle = "N" && Value
lcValue = Transform((Evaluate(This.BuddyControl + ".Value")),"999,999,999,999")
lcMaximum = Transform((Evaluate(This.BuddyControl + ".Maximum")),"999,999,999,999")
lcMinimum = Transform((Evaluate(This.BuddyControl + ".Minimum")),"999,999,999,999")
Case This.LabelStyle = "P" && Percent
lcValue = Transform(Evaluate(This.BuddyControl + ".Percent"),"999%")
lcMaximum = "100%"
lcMinimum = "0%"
Case This.LabelStyle = "B" && Bytes
lcValue = This.uFormatAsBytes(Evaluate(This.BuddyControl + ".Value"))
lcMaximum = This.uFormatAsBytes(Evaluate(This.BuddyControl + ".Maximum"))
lcMinimum = This.uFormatAsBytes(Evaluate(This.BuddyControl + ".Minimum"))
Otherwise && same as "N"
lcValue = Transform((Evaluate(This.BuddyControl + ".Value")),"999,999,999,999")
lcMaximum = Transform((Evaluate(This.BuddyControl + ".Maximum")),"999,999,999,999")
lcMinimum = Transform((Evaluate(This.BuddyControl + ".Minimum")),"999,999,999,999")
Endcase
lcCaption = This.LabelCaption
lcCaption = Strtran(lcCaption ,"<<Value>>",Alltrim(lcValue),1,10,1)
lcCaption = Strtran(lcCaption ,"<<Maximum>>",Alltrim(lcMaximum),1,10,1)
lcCaption = Strtran(lcCaption ,"<<Minimum>>",Alltrim(lcMinimum),1,10,1)
This.Caption = m.lcCaption
This.Refresh
ENDPROC
PROCEDURE Destroy
This.ctl32_Unbind
ENDPROC
PROCEDURE Init
This.ctl32_Init
ENDPROC
HIDDEN PROCEDURE uformatasbytes
LPARAMETERS qdw
LOCAL pszBuf
m.pszBuf = SPACE(100)
StrFormatByteSize(m.qdw, @m.pszBuf, Len(m.pszBuf))
m.pszBuf = ALLTRIM(m.pszBuf)
* Remove chr(0)
m.pszBuf = Left(m.pszBuf,Len(m.pszBuf)-1)
RETURN ALLTRIM(m.pszBuf)
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink