*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_progressbar.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS ctl32_progressbar AS container *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="tmrControlTimer" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="lblName2" UniqueID="" Timestamp="" /> #INCLUDE "ctl32.h" * *m: ctl32_addproperties *m: ctl32_bindevents && Binds events. *m: ctl32_create *m: ctl32_createcaption *m: ctl32_declaredlls *m: ctl32_destroy *m: ctl32_resize && Bound to Form.Resize *m: ctl32_setstyle *m: ctl32_settheme *m: ctlbackcolor_assign *m: ctlbarcolor_assign *m: ctlbordercolor_assign *m: ctlcaption_access *m: ctlcaption_assign *m: ctlhwnd_access *m: ctlhwnd_assign *m: ctlmarqueespeed_assign *m: ctlmarquee_assign *m: ctlmaximum_assign *m: ctlminimum_assign *m: ctlpercent_access *m: ctlpercent_assign *m: ctlplay_assign *m: ctlrepeat_assign *m: ctlreset && Resets the Value property to the Minimum value. *m: ctlsizeadjust_assign *m: ctlsmooth_assign *m: ctlstepit && 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: ctlstep_assign *m: ctlstyle_assign *m: ctlthemes_assign *m: ctlvaluechanged *m: ctlvalue_access *m: ctlvalue_assign *m: ctlvertical_assign *m: ctlvisible_assign *m: evthandler_form_themes *m: evthandler_page_activate *m: evthandler_page_deactivate *m: evthandler_screen_themes *m: evthandler_this_moved *m: evthandler_this_resize *m: height_assign *m: width_assign *p: builderx *p: ctl32_controlhwnd && CreateWindowEx return value. *p: ctlabout *p: ctlbackcolor *p: ctlbarcolor && 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: ctlbordercolor *p: ctlcaption *p: ctlformat && Text string used to generate the caption. Check Help File *p: ctlhwnd && Specifies the Window handle of the Control. *p: ctlmarquee && 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: ctlmarqueespeed && Specifies the speed of the marquee bar, in milliseconds. *p: ctlmaximum && Specifies the upper limit of the value property. Must be a positive or negative number larger than minimum. *p: ctlminimum && Specifies the lower limit of the value property. Must be a positive or negative number smaller than Maximum *p: ctlpercent && Specifies the percent of the value property relative to the total of maximum - minimum. *p: ctlplay && When True, fires the StepIt method every 100 milliseconds. To set the speed, change the value of the step property. *p: ctlrepeat && Specifies if the controls rolls over to minimum when value reaches maximum. Use it with Play to display a self updating progressbar. *p: ctlsizeadjust && 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: ctlsmooth && Specifies if the progressbar is shown using segments, or using a continuous bar. *p: ctlstep && Determines the value to use in the stepit method. Can be a positive or negative value. *p: ctlstyle *p: ctlthemes && Not Used *p: ctlvalue && Specifies the current value of the control. *p: ctlversion *p: ctlvertical && Specifies if the progressbar is vertical or horizontal. *p: ctlvisible *p: _memberdata && XML Metadata for customizable properties * HIDDEN ctl32_controlhwnd PROTECTED builderx * BackColor = 140,200,200 builderx = (home() + "wizards\ctl32_progressbar_builder.app") ctl32_controlhwnd = 0 ctlabout = ctl32_progressbar - Carlos Alloatti. ctlbackcolor = -1 ctlbarcolor = -1 ctlbordercolor = -1 ctlcaption = ctlformat = ctlhwnd = 0 ctlmarqueespeed = 100 ctlmaximum = 100 ctlminimum = 0 ctlpercent = 0 ctlstep = 1 ctlstyle = 1 ctlthemes = .T. ctlvalue = 0 ctlversion = 20061010 ctlvisible = .T. ForeColor = 0,0,0 Height = 18 Name = "ctl32_progressbar" Width = 301 * ADD OBJECT 'lblname' AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "ctl32_progressbar", ; FontName = "Tahoma", ; FontSize = 8, ; ForeColor = 0,0,128, ; Left = 6, ; Name = "lblname", ; Top = 2 *< END OBJECT: BaseClass="label" /> ADD OBJECT 'lblName2' 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 = "lblName2", ; 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 ctl32_addproperties *!* Stores the hWnd of the host window This.AddProperty([nHosthWnd], This.oUtil._HostHWnd()) *!* Stores the value of VFP window procedure This.AddProperty([nVFPWndProc], This.oUtil._VFPWndProc()) *!* Stores hWnd of Windows common control created by the class This.AddProperty([nCtlHwnd], 0) *!* Stores hWnd of Windows common control created by the class This.AddProperty([nProxyHwnd], 0) *!* Indicates if the control is in the creation stage This.AddProperty([lCreating], FALSE) *!* Stores old ctlStep Value This.AddProperty([nOldStep], 0) ENDPROC HIDDEN PROCEDURE ctl32_bindevents && Binds events. *!* Manage resize amd move: Bindevent(This, [Resize], This, [evtHandler_This_Resize], 1) Bindevent(This, [Moved], This, [evtHandler_This_Moved], 1) *!* Manage theme changing Bindevent(_Screen, [Themes], This, [EvtHandler_Screen_Themes], 1) If ThisForm.Name <> _Screen.Name then Bindevent(Thisform, [Themes], This, [EvtHandler_Form_Themes], 1) Endif *!* If we are inside a page in a pageframe: m.loControl = This.Parent Do While Not Upper(loControl.BaseClass) == [FORM] If Upper(m.loControl.BaseClass) == [PAGE] Then Bindevent(m.loControl, [Activate], This, [EvtHandler_Page_Activate], 1) Bindevent(m.loControl, [Deactivate], This, [EvtHandler_Page_Deactivate], 1) Endif m.loControl = m.loControl.Parent ENDDO m.loControl = null ENDPROC HIDDEN PROCEDURE ctl32_create This.BackStyle = 0 This.ctlSizeAdjust = This.ctlSizeAdjust Local ; dwExStyle As Integer, ; lpClassName As Character, ; lpWindowName As Character, ; dwStyle As Integer, ; hWndParent As Integer, ; hMenu As Integer, ; hInstance As Integer, ; lpParam As Integer, ; lnTop As Integer, ; lnLeft As Integer, ; lnWidth As Integer, ; lnHeight As Integer, ; lnLeft As Integer, ; lnTop As Integer If This.lCreating Then Return Endif *!* We enter Initialization Stage... (checked by ctl32_Resize) This.lCreating = true *!* Create Static window to hold progressbar if needed If This.ctlStyle = 3 Then *!* Define parameters for static createwindowex: m.dwExStyle = 0 m.lpClassName = WC_STATICA m.lpWindowName = "" m.dwStyle = Bitor(WS_CHILD, WS_CLIPSIBLINGS) m.hWndParent = This.nHostHwnd m.hMenu = 0 m.hInstance = This.oUtil._HInstance() m.lpParam = 0 If This.nStatusBar > 0 Then m.lnLeft = This.Left + 1 m.lnTop = This.Top + 1 Else m.lnLeft = This.oUtil._ObjToClient(This, [L]) + 1 m.lnTop = This.oUtil._ObjToClient(This, [T]) + 1 Endif *!* Create proxy window This.nProxyHwnd = CreateWindowEx( ; m.dwExStyle, ; m.lpClassName, ; m.lpWindowName, ; m.dwStyle, ; m.lnLeft, ; m.lnTop, ; This.Width - 2, ; This.Height - 2, ; m.hWndParent, ; m.hMenu, ; m.hInstance, ; m.lpParam) Endif *!* Define parameters for progressbar createwindowex: m.dwExStyle = 0 m.lpClassName = PROGRESS_CLASSA m.lpWindowName = "" m.dwStyle = Bitor(WS_CHILD, WS_CLIPSIBLINGS) If This.ctlStyle = 3 Then m.hWndParent = This.nProxyHwnd m.lnLeft = -2 m.lnTop = -2 m.lnWidth = This.Width + 2 m.lnHeight = This.Height + 2 Else If This.nStatusBar > 0 Then m.lnLeft = This.Left m.lnTop = This.Top Else m.lnLeft = This.oUtil._ObjToClient(This, [L]) m.lnTop = This.oUtil._ObjToClient(This, [T]) Endif m.hWndParent = This.nHostHwnd m.lnWidth = This.Width m.lnHeight = This.Height Endif *!* Setup Control specific Styles that have to be set at window creation: *!* ctlMarquee If This.ctlMarquee = true Then m.dwStyle = Bitor(m.dwStyle, PBS_MARQUEE) Endif *!* ctlSmooth If This.ctlSmooth = true m.dwStyle = Bitor(m.dwStyle, PBS_SMOOTH) Endif *!* Orientation If This.ctlVertical = true Then m.dwStyle = Bitor(m.dwStyle, PBS_VERTICAL) Endif m.hMenu = 0 m.hInstance = This.oUtil._HInstance() m.lpParam = 0 This.nCtlHwnd = CreateWindowEx( ; m.dwExStyle, ; m.lpClassName, ; m.lpWindowName, ; m.dwStyle, ; m.lnLeft, ; m.lnTop, ; m.lnWidth, ; m.lnHeight, ; m.hWndParent, ; m.hMenu, ; m.hInstance, ; m.lpParam) *!* Remove border if ctlStyle is 2 If This.ctlStyle = 2 Then This.ctl32_SetStyle(2) Endif *!* Set container visibility according to ctlStyle *!* (Style 3 will always make progress bar rebuild) If This.ctlStyle < 3 Then This.Visible = FALSE Endif *!* Set ctlMinimum and ctlMaximum values: SendMessageN(This.nCtlHwnd, PBM_SETRANGE32, This.ctlMinimum, This.ctlMaximum) *!* Send Theme message to control: This.ctlThemes = This.ctlThemes *!* Set Control ctlStep Value This.ctlStep = This.ctlStep *!* Set Control Value to the Container Value property This.ctlValue = This.ctlValue *!* Set ctlMarqueeSpeed Value This.ctlMarqueeSpeed = This.ctlMarqueeSpeed *!* Set ctlPlay state This.ctlPlay = This.ctlPlay *!* Set Colors This.ctlBackColor = This.ctlBackColor This.ctlBarColor = This.ctlBarColor This.ctlBorderColor = This.ctlBorderColor *!* Set ctlVisible state This.ctlVisible = This.ctlVisible *!* We finish Initialization State This.lCreating = FALSE ENDPROC HIDDEN PROCEDURE ctl32_createcaption ENDPROC HIDDEN PROCEDURE ctl32_declaredlls *!* This procedure registers the Windows API functions used by the class *!* An array of existing declared API functions is created and checked to *!* prevent re-declaration of API functions. *!* When a function is used with an ALIAS, it is first declared with an ALIAS *!* equal to the original name, and then declared again with the desired alias. *!* This is because of a bug in VFP: *!* If you declare an API function with an alias, and later declare the same api *!* function without an alias, the first aliased declaration dissapears. *!* We create an empty array first because if there are no API declarations *!* then adlls will not create the array *!* Then the ascan search will work with no error Local Array laDeclaredDlls(1,3) Local lnLen m.lnLen = Adlls(m.laDeclaredDlls) *!* win32api is used instead of the library name, check these: *!* blogs.msdn.com/calvin_hsia/archive/2006/04/27/585305.aspx *!* blogs.msdn.com/calvin_hsia/archive/2006/04/24/582479.aspx *!* "User32.dll, Gdi32.dll, Kernel32.dll , Advapi32.dll and Mpr.dll are searched (in that order)" If Ascan(m.laDeclaredDlls, "CreateWindowEx", 1, m.lnLen , 2, 15) = 0 Declare Integer CreateWindowEx In win32api ; 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 ; integer HWnd Endif If Ascan(m.laDeclaredDlls, [SendMessage], 1, m.lnLen , 2, 15) = 0 Declare Integer SendMessageA In win32api As SendMessage ; integer HWnd,; integer Msg,; integer wParam,; integer 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 ; integer HWnd,; integer nIndex,; integer dwNewLong Endif If Ascan(m.laDeclaredDlls, "SetWindowPos", 1, m.lnLen , 2, 15) = 0 Declare Integer SetWindowPos In win32api ; integer HWnd,; integer hWndInsertAfter,; integer x,; integer Y,; integer cx,; integer cy,; integer wFlags Endif If This.oUtil._OSVersion() >= CON_OS_WINXP Then If Ascan(m.laDeclaredDlls, "SetWindowTheme", 1, m.lnLen , 2, 15) = 0 Declare Integer SetWindowTheme In UxTheme ; integer HWnd,; string pszSubAppName,; string pszSubIdList Endif Endif *!* We must prevent Beautify from changing the case of "ShowWindow" since its also a VFP keyword *#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 ENDPROC HIDDEN PROCEDURE ctl32_destroy *!* Destroy Windows If This.nCtlHwnd > 0 Then DestroyWindow(This.nCtlHwnd) Endif If This.nProxyHwnd > 0 Then DestroyWindow(This.nProxyHwnd) 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.lCreating = TRUE Or This.nCtlHwnd = 0 Then Return Endif *!* Else, resize the Control Window to its container size: Local ; lnLeft As Integer, ; lnTop As Integer, ; lnWidth As Integer, ; lnHeight As Integer If This.ctlStyle = 3 Then *!* Position proxy window If This.nStatusBar > 0 Then m.lnLeft = This.Left + 1 m.lnTop = This.Top + 1 Else m.lnLeft = This.oUtil._ObjToClient(This, [L]) + 1 m.lnTop = This.oUtil._ObjToClient(This, [T]) + 1 Endif SetWindowPos(This.nProxyHwnd, 0,; m.lnLeft, ; m.lnTop, ; This.Width - 2, ; This.Height - 2, ; SWP_NOZORDER) m.lnLeft = -2 m.lnTop = -2 m.lnWidth = This.Width + 2 m.lnHeight = This.Height + 2 Else If This.nStatusBar > 0 Then m.lnLeft = This.Left m.lnTop = This.Top Else m.lnLeft = This.oUtil._ObjToClient(This, [L]) m.lnTop = This.oUtil._ObjToClient(This, [T]) Endif m.lnWidth = This.Width m.lnHeight = This.Height Endif SetWindowPos(This.nCtlHwnd, 0,; m.lnLeft, ; m.lnTop, ; m.lnWidth, ; m.lnHeight, ; SWP_NOZORDER) ENDPROC HIDDEN PROCEDURE ctl32_setstyle Lparameters tnStyle *!* Only add border if not Themed If (This.oUtil._ThemeStatus() And This.ctlThemes) = FALSE Then If m.tnStyle = 1 Then SetWindowLong(This.nCtlHwnd, GWL_EXSTYLE, WS_EX_STATICEDGE) *!* Refresh control window so border gets redrawn SetWindowPos(This.nCtlHwnd, HWND_TOP, 0,0,0,0, Bitor(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_FRAMECHANGED)) Endif Endif If m.tnStyle = 2 Then SetWindowLong(This.nCtlHwnd, GWL_EXSTYLE, 0) *!* Refresh control window so border gets redrawn SetWindowPos(This.nCtlHwnd, HWND_TOP, 0,0,0,0, Bitor(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_FRAMECHANGED)) Endif ENDPROC HIDDEN PROCEDURE ctl32_settheme If This.oUtil._OSVersion() >= CON_OS_WINXP Then If (This.oUtil._ThemeStatus() And This.ctlThemes) = TRUE Then *!* Restore Theme SetWindowTheme(This.nCtlHwnd, Null, Null) *!* Remove border This.ctl32_SetStyle(2) Else *!* Remove Theme SetWindowTheme(This.nCtlHwnd, Null, " ") *!* Reset border This.ctl32_SetStyle(This.ctlStyle) Endif Endif ENDPROC HIDDEN PROCEDURE ctlbackcolor_assign Lparameters vNewVal If Type("m.vNewVal") <> [N] Return Endif If m.vNewVal > 16777215 Then m.vNewVal = -1 Endif This.ctlBackColor = m.vNewVal This.BackColor= m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then If This.ctlBackColor = -1 Then SendMessageN(This.nCtlHwnd, PBM_SETBKCOLOR, 0, CLR_DEFAULT) Else SendMessageN(This.nCtlHwnd, PBM_SETBKCOLOR, 0, This.ctlBackColor) Endif Endif ENDPROC HIDDEN PROCEDURE ctlbarcolor_assign Lparameters vNewVal If Type("m.vNewVal") <> [N] return Endif If m.vNewVal > 16777215 Then m.vNewVal = -1 Endif This.ctlBarColor = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then If This.ctlBarColor = -1 Then SendMessageN(This.nCtlHwnd, PBM_SETBARCOLOR, 0, CLR_DEFAULT) Else SendMessageN(This.nCtlHwnd, PBM_SETBARCOLOR, 0, This.ctlBarColor) Endif Endif ENDPROC HIDDEN PROCEDURE ctlbordercolor_assign Lparameters vNewVal If m.vNewVal = -1 Then m.vNewVal = Rgb(0,0,0) Endif This.ctlBorderColor = m.vNewVal This.BorderColor = This.ctlBorderColor ENDPROC HIDDEN PROCEDURE ctlcaption_access If Empty(This.ctlFormat) Then Return [] Endif Local ; lcValB, ; lcValN, ; lcValP, ; lcMaxB, ; lcMaxN, ; lcMaxP, ; lcMinB, ; lcMinN, ; lcMinP, ; lcOut m.lcValN = Transform(This.ctlValue, "999,999,999,999") m.lcMaxN = Transform(This.ctlMaximum, "999,999,999,999") m.lcMinN = Transform(This.ctlMinimum, "999,999,999,999") m.lcValP = Transform(This.ctlPercent, "999%") m.lcMaxP = "100%" m.lcMinP = "0%" m.lcValB = This.oUtil._StrFormatByteSize(This.ctlValue) m.lcMaxB = This.oUtil._StrFormatByteSize(This.ctlMaximum) m.lcMinB = This.oUtil._StrFormatByteSize(This.ctlMinimum) m.lcOut = This.ctlFormat m.lcOut = Strtran(m.lcOut , "ValBytes", Alltrim(m.lcValB), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "ValNumber", Alltrim(m.lcValN), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "ValPercent", Alltrim(m.lcValP), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MaxBytes", Alltrim(m.lcMaxB), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MaxNumber", Alltrim(m.lcMaxN), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MaxPercent", Alltrim(m.lcMaxP), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MinBytes", Alltrim(m.lcMinB), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MinNumber", Alltrim(m.lcMinN), 1, 99, 1) m.lcOut = Strtran(m.lcOut , "MinPercent", Alltrim(m.lcMinP), 1, 99, 1) Return m.lcOut ENDPROC HIDDEN PROCEDURE ctlcaption_assign Lparameters vNewVal Return ENDPROC HIDDEN PROCEDURE ctlhwnd_access If This.nStatusBar = -1 Then Return 0 Endif Return This.nCtlHwnd ENDPROC HIDDEN PROCEDURE ctlhwnd_assign Lparameters vNewVal Return ENDPROC HIDDEN PROCEDURE ctlmarqueespeed_assign Lparameters vNewVal This.ctlMarqueeSpeed = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then SendMessageN(This.nCtlHwnd, PBM_SETMARQUEE, 1, This.ctlMarqueeSpeed) Endif ENDPROC HIDDEN PROCEDURE ctlmarquee_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif ENDIF This.ctlMarquee = m.vNewVal If This.nStatusBar = -1 Then Return Endif *!* ctlMarquee change needs to recreate Control If This.nCtlHwnd > 0 Then This.ctl32_Destroy() This.ctl32_Create() Endif ENDPROC HIDDEN PROCEDURE ctlmaximum_assign Lparameters vNewVal This.ctlMaximum = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then *!* Set ctlMinimum and ctlMaximum values: SendMessageN(This.nCtlHwnd, PBM_SETRANGE32, This.ctlMinimum, This.ctlMaximum) Endif ENDPROC HIDDEN PROCEDURE ctlminimum_assign Lparameters vNewVal This.ctlMinimum = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then *!* Set ctlMinimum and ctlMaximum values: SendMessageN(This.nCtlHwnd, PBM_SETRANGE32, This.ctlMinimum, This.ctlMaximum) Endif ENDPROC HIDDEN PROCEDURE ctlpercent_access Return Int(100 * (This.ctlValue - This.ctlMinimum) / (Abs(This.ctlMaximum - This.ctlMinimum))) ENDPROC HIDDEN PROCEDURE ctlpercent_assign Lparameters vNewVal Return ENDPROC HIDDEN PROCEDURE ctlplay_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif Endif This.ctlPlay = m.vNewVal If This.nStatusBar = -1 Then Return Endif This.tmrControlTimer.Enabled = This.ctlPlay ENDPROC HIDDEN PROCEDURE ctlrepeat_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif Endif This.ctlRepeat = m.vNewVal ENDPROC PROCEDURE ctlreset && Resets the Value property to the Minimum value. Lparameters tToEnd If PCOUNT() = 0 Then This.ctlValue = This.ctlMinimum Else This.ctlValue = This.ctlMaximum Endif ENDPROC HIDDEN PROCEDURE ctlsizeadjust_assign Lparameters vNewVal This.ctlSizeAdjust = m.vNewVal This.Height = This.Height This.Width = This.Width ENDPROC HIDDEN PROCEDURE ctlsmooth_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif Endif If This.ctlSmooth = m.vNewVal Then Return Endif This.ctlSmooth = m.vNewVal If This.nStatusBar = -1 Then Return Endif *!* ctlSmooth change needs to recreate Control If This.nCtlHwnd > 0 Then This.ctl32_destroy() This.ctl32_Create() Endif ENDPROC PROCEDURE ctlstepit && 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 This.nStatusBar = -1 Then Return Endif If This.ctlMarquee = TRUE Then Return Endif *!* If no numeric parameter, use actual ctlStep value: If Type("m.lnVal") <> "N" m.lnVal = This.ctlStep Endif *!* If parameter is different from actual ctlStep value, save old value: If m.lnVal <> This.ctlStep Then This.nOldStep = This.ctlStep This.ctlStep = m.lnVal Else This.nOldStep = 0 Endif If This.nCtlHwnd > 0 Then *!* Send ctlStepIt message: SendMessageN(This.nCtlHwnd, PBM_STEPIT, 0, 0) *!* Trigger event: Raiseevent(This, [ctlValueChanged]) Endif *!* Reset ctlStep Value if old value saved: If This.nOldStep <> 0 Then This.ctlStep = This.nOldStep Endif ENDPROC HIDDEN PROCEDURE ctlstep_assign Lparameters vNewVal This.ctlStep = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then *!* Set ctlStep Value SendMessageN(This.nCtlHwnd, PBM_SETSTEP , This.ctlStep, 0) Endif ENDPROC HIDDEN PROCEDURE ctlstyle_assign Lparameters vNewVal Local lnOldStyle, llUpdate, lnParam lnOldStyle = This.ctlStyle llUpdate = FALSE This.ctlStyle = m.vNewVal If This.nStatusBar = -1 Then Return Endif *!* 1 normal 3d border (only when theme is off) *!* 2 flat no border *!* 3 flat with border (adds proxy window an uses container border) Do Case Case This.ctlStyle = 1 *!* Recreate control if old style was 3 If m.lnOldStyle = 3 Then m.llUpdate = TRUE Else This.ctl32_SetStyle(1) Endif Case This.ctlStyle = 2 If m.lnOldStyle = 3 Then m.llUpdate = TRUE Else This.ctl32_SetStyle(2) Endif Case This.ctlStyle = 3 If m.lnOldStyle <> 3 Then This.Visible = TRUE m.llUpdate = TRUE Endif Endcase If m.llUpdate Then If This.nCtlHwnd > 0 Then This.ctl32_destroy() Endif This.ctl32_Create() Endif ENDPROC HIDDEN PROCEDURE ctlthemes_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif Endif This.ctlThemes = m.vNewVal If This.nStatusBar = -1 Then Return Endif This.ctl32_SetTheme() ENDPROC PROCEDURE ctlvaluechanged ENDPROC HIDDEN PROCEDURE ctlvalue_access If This.nStatusBar = -1 Then Return This.ctlValue Endif *!* If setting up Control, use ctlValue of Container, not ctlValue of Control If This.lCreating Or This.nCtlHwnd = 0 Then Return This.ctlValue Endif *!* Ask Control for Value to return: Return SendMessageN(This.nCtlHwnd, PBM_GETPOS, 0, 0) ENDPROC HIDDEN PROCEDURE ctlvalue_assign Lparameters vNewVal This.ctlValue = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.nCtlHwnd > 0 Then SendMessageN(This.nCtlHwnd, PBM_SETPOS, m.vNewVal, 0) *!* Trigger event: Raiseevent(This, [ctlValueChanged]) Endif ENDPROC HIDDEN PROCEDURE ctlvertical_assign Lparameters vNewVal If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif ENDIF This.ctlVertical = m.vNewVal If This.nStatusBar = -1 Then Return Endif *!* ctlVertical change needs to recreate Control If This.nCtlHwnd > 0 Then This.ctl32_destroy() This.ctl32_Create() Endif ENDPROC HIDDEN PROCEDURE ctlvisible_assign Lparameters vNewVal Local lnParam If Type("m.vNewVal") = [N] Then If m.vNewVal = 0 Then m.vNewVal = FALSE Else m.vNewVal = TRUE Endif Endif This.ctlVisible = m.vNewVal If This.nStatusBar = -1 Then Return Endif If This.ctlVisible = TRUE Then m.lnParam = SW_SHOWNA Else m.lnParam = SW_HIDE Endif This.Visible = This.ctlVisible And (This.ctlStyle = 3) If This.nProxyHwnd > 0 Then _ShowWindow(This.nProxyHwnd, m.lnParam) Endif If This.nCtlHwnd > 0 Then _ShowWindow(This.nCtlHwnd, m.lnParam) Endif ENDPROC PROCEDURE Destroy This.Ctl32_Destroy() ENDPROC HIDDEN PROCEDURE evthandler_form_themes This.ctl32_SetTheme() ENDPROC HIDDEN PROCEDURE evthandler_page_activate If This.ctlVisible = TRUE Then If This.nProxyHwnd <> 0 Then _ShowWindow(This.nProxyHwnd, SW_SHOWNA) Endif If This.nCtlHwnd <> 0 Then _ShowWindow(This.nCtlHwnd, SW_SHOWNA) Endif Endif ENDPROC HIDDEN PROCEDURE evthandler_page_deactivate If This.ctlVisible = TRUE Then If This.nProxyHwnd <> 0 Then _ShowWindow(This.nProxyHwnd, SW_HIDE) Endif If This.nCtlHwnd > 0 Then _ShowWindow(This.nCtlHwnd, SW_HIDE) Endif Endif ENDPROC HIDDEN PROCEDURE evthandler_screen_themes This.ctl32_SetTheme() ENDPROC HIDDEN PROCEDURE evthandler_this_moved This.ctl32_Resize() ENDPROC HIDDEN PROCEDURE evthandler_this_resize This.ctl32_Resize() ENDPROC HIDDEN PROCEDURE height_assign Lparameters vNewVal This.Height = m.vNewVal If This.ctlSizeAdjust = TRUE Then If This.ctlVertical = TRUE Then This.Height = Round((This.Height - 8)/8,0) * 8 + 5 Endif Endif ENDPROC PROCEDURE Init *!* This parameter is passed from host ctl32_statusbar control Lparameters tnStatusBar *!* This Property we need now: If Not Pemstatus(This, [nStatusBar], CON_PEMSTAT_DEFINED) This.AddProperty([nStatusBar], 0) Endif *!* If we have a parameter, Status Bar is creating this If Pcount() > 0 And Type([m.tnStatusBar]) = T_NUMERIC Then This.nStatusBar = m.tnStatusBar Endif *!* Check if -1 parameter from statusbar, that means no Init yet If This.nStatusBar = -1 Return Endif *!* Add Util object If Not Pemstatus(This, [oUtil], CON_PEMSTAT_DEFINED) This.Newobject([oUtil], [_Util], [ctl32_common.vcx]) Endif This.ctl32_DeclareDlls() This.ctl32_AddProperties() If This.nStatusBar > 0 Then This.nHostHwnd = This.nStatusBar *!* Just in case its geting recreated by a parent ctl32_statusbar This.ctl32_Destroy() Endif This.ctl32_Create() This.ctl32_BindEvents() ENDPROC HIDDEN PROCEDURE width_assign Lparameters vNewVal This.Width = m.vNewVal If This.ctlSizeAdjust = TRUE Then If This.ctlVertical = FALSE Then This.Width = Round((This.Width - 5)/8,0) * 8 + 5 Endif Endif ENDPROC PROCEDURE lblname.Init return FALSE ENDPROC PROCEDURE lblName2.Init return FALSE ENDPROC PROCEDURE tmrControlTimer.Timer If This.Parent.ctlHWnd = 0 Then Return Endif This.Parent.ctlStepIt() ENDPROC ENDDEFINE DEFINE CLASS ctl32_progressbarlabel AS label *< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: ctl32_bind *m: ctl32_bytestostr *m: ctl32_declares *m: ctl32_init *m: ctl32_unbind *m: ctl32_update *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: ctlabout *p: ctlversion *p: labelcaption && Especifies the text to display in the label. Any text can be entered, keywords <> and <> 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 * PROTECTED ctl32_name,ctl32_version * Alignment = 1 BorderStyle = 0 buddycontrol = Caption = "ctl32_ProgressBar_Label" ctl32_name = ctl32_ProgressBarLabel ctl32_version = 1.1 ctlabout = ctl32_progressbarlabel - Carlos Alloatti ctlversion = 20061010 FontName = "Tahoma" FontSize = 8 Height = 16 labelcaption = <> labelstyle = N Name = "ctl32_progressbarlabel" Width = 300 _memberdata = * 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),"ctlValueChanged",This,"CTL32_UPDATE",1) Endif ENDPROC HIDDEN PROCEDURE ctl32_bytestostr LPARAMETERS qdw LOCAL pszBuf m.pszBuf = SPACE(100) StrFormatByteSizeA(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 HIDDEN PROCEDURE ctl32_declares DECLARE INTEGER StrFormatByteSizeA IN shlwapi; INTEGER qdw,; STRING @ pszBuf,; INTEGER uiBufSize ENDPROC HIDDEN PROCEDURE ctl32_init This.Caption = "" This.ctl32_Declares This.ctl32_Bind This.ctl32_Update ENDPROC HIDDEN PROCEDURE ctl32_unbind 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 + ".ctlValue")),"999,999,999,999") lcMaximum = Transform((Evaluate(This.BuddyControl + ".ctlMaximum")),"999,999,999,999") lcMinimum = Transform((Evaluate(This.BuddyControl + ".ctlMinimum")),"999,999,999,999") Case This.LabelStyle = "P" && Percent lcValue = Transform(Evaluate(This.BuddyControl + ".ctlPercent"),"999%") lcMaximum = "100%" lcMinimum = "0%" Case This.LabelStyle = "B" && Bytes lcValue = This.ctl32_bytestostr(Evaluate(This.BuddyControl + ".ctlValue")) lcMaximum = This.ctl32_bytestostr(Evaluate(This.BuddyControl + ".ctlMaximum")) lcMinimum = This.ctl32_bytestostr(Evaluate(This.BuddyControl + ".ctlMinimum")) Otherwise && same as "N" lcValue = Transform((Evaluate(This.BuddyControl + ".ctlValue")),"999,999,999,999") lcMaximum = Transform((Evaluate(This.BuddyControl + ".ctlMaximum")),"999,999,999,999") lcMinimum = Transform((Evaluate(This.BuddyControl + ".ctlMinimum")),"999,999,999,999") Endcase lcCaption = This.LabelCaption lcCaption = Strtran(lcCaption ,"<>",Alltrim(lcValue),1,10,1) lcCaption = Strtran(lcCaption ,"<>",Alltrim(lcMaximum),1,10,1) lcCaption = Strtran(lcCaption ,"<>",Alltrim(lcMinimum),1,10,1) This.Caption = lcCaption This.Refresh ENDPROC PROCEDURE Destroy This.ctl32_Unbind ENDPROC PROCEDURE Init This.ctl32_Init ENDPROC ENDDEFINE