*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (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" * *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 * 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 * 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 * 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 , "<>", Alltrim(m.lcBVal), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcNVal), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcPVal), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcBMax), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcNMax), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcPMax), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcBMin), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", Alltrim(m.lcNMin), 1, 10, 1) m.lcCaption = Strtran(m.lcCaption , "<>", 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ón 1.00 - 2005-12-01 *!* Versión 2.00 - 2006-04-01 *!* Versió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" * *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 <> 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 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),"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 ,"<>",Alltrim(lcValue),1,10,1) lcCaption = Strtran(lcCaption ,"<>",Alltrim(lcMaximum),1,10,1) lcCaption = Strtran(lcCaption ,"<>",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