Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Animated Icon
Message
 
To
22/01/2003 13:35:12
Joel Whitehead
Ccs Central Computer Services Inc.
Thunder Bay, Ontario, Canada
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Title:
Miscellaneous
Thread ID:
00744375
Message ID:
00744631
Views:
10
Joel,

This class is similar to class by Daniel Gramunt, but instead of ActiveX it uses windows Animation control and system AVI from Shell32.dll, so external file is not required.
***********************************************************************
*        File: ProgressDlg.prg
*     Created: 25.06.2002
*      Author: Alexander Golovlev
*     Country: Russian Federation
*       Email: avg.kedr@overta.ru , golovlev@yandex.ru
***********************************************************************

* Description...: Dialog with progress bar and animation using
*				: Windows Animation common control.
*				: Based on idea of Daniel Gramunt's Animation class.
*				:
* Methods.......: Init(tcCaption, tcMessage, tnRange)
*				: SetRange(tnRange)
*				: SetPos(tnPos, tcMessage)
*				:
***********************************************************************

#define ANIMATE_CLASS		"SysAnimate32"
#define ACS_TRANSPARENT		0x0002
#define ACS_AUTOPLAY		0x0004
#define WS_CHILD            0x40000000
#define WS_VISIBLE          0x10000000

#define WM_USER             0x0400 
#define ACM_OPEN			(WM_USER+100)
#define ACM_PLAY			(WM_USER+101)
#define ACM_STOP			(WM_USER+102)

DEFINE CLASS ProgressDlg AS form

	Height = 133
	Width = 297
	DoCreate = .T.
	AutoCenter = .T.
	Caption = "Progress"
	ClipControls = .F.
	ControlBox = .F.
	Name = "ProgressDlg"
	nRange = 100
	nPos = 0
	lCancel = .F.
	hWnd = 0

	ADD OBJECT shape2 AS shape WITH ;
		Top = 96, ;
		Left = 12, ;
		Height = 25, ;
		Width = 201, ;
		SpecialEffect = 0, ;
		Name = "Shape2"

	ADD OBJECT shape1 AS shape WITH ;
		Top = 97, ;
		Left = 13, ;
		Height = 24, ;
		Width = 0, ;
		BorderStyle = 0, ;
		BackColor = RGB(0,0,255), ;
		Name = "Shape1"

	ADD OBJECT lblInfo AS label WITH ;
		Caption = "Processing:", ;
		Height = 17, ;
		Left = 12, ;
		Top = 76, ;
		Width = 272, ;
		Name = "lblInfo"

	ADD OBJECT cmdCancel AS commandbutton WITH ;
		Top = 96, ;
		Left = 224, ;
		Height = 25, ;
		Width = 60, ;
		Cancel = .T., ;
		Caption = "Cancel", ;
		Name = "cmdCancel"

	PROCEDURE Init(tcCaption, tcMessage, tnRange)
	*  Parameter List...: tcCaption	- Form caption. Optional.
	*					: tcMessage	- Message to display. Optional.
	*					: tnRange	- Progress Bar range. Optional.

		Declare Long CreateWindowEx In Win32API ;
				Long dwExStyle, ;		&& extended window style
				String @lpClassName, ;	&& class name
			    String @lpWindowName, ;	&& window name
		    	Long dwStyle, ;			&& window style
			    Long x, ;				&& horizontal position of window
		    	Long y, ;				&& vertical position of window
			    Long nWidth, ;			&& window width
		    	Long nHeight, ;			&& window height
			    Long hWndParent, ;		&& handle of parent or owner window
		    	Long hMenu, ;			&& handle of menu or child-window identifier
			    Long hInstance, ;		&& handle of application instance
		    	Long lpParam 			&& window-creation data
		Declare Long SendMessage In Win32API ;
			    Long hwnd,;				&& handle of destination window
		    	Long uMsg, ;			&& message to send
			    Long wParam,;			&& first message parameter
		    	Long lParam 			&& second message parameter
		Declare Long GetModuleHandle In Win32API ;
				String @lpModuleName	&& module name

		If VarType(tcCaption) = 'C' AND !Empty(tcCaption)
			This.Caption = tcCaption
		EndIf
		If VarType(tcMessage) = 'C' AND !Empty(tcMessage)
			This.lblInfo.Caption = tcMessage
		EndIf
		If VarType(tnRange) = 'N' AND tnRange != 0
			This.nRange = tnRange
		EndIf

		nInstance = GetModuleHandle(NULL)
		nShellHandle = GetModuleHandle("shell32.dll")

		This.Show()
		If Version(5) < 700
			If ! 'FOXTOOLS' $ Set('LIBRARY')
				Set Library To Home() + "FOXTOOLS.FLL" Additive
			Endif
			This.hWnd = _WhTohWnd(_WFindTitl(This.Caption))
		Endif
		hWndCtrl = CreateWindowEx(0, ANIMATE_CLASS, NULL, ;
			ACS_TRANSPARENT + ACS_AUTOPLAY + WS_CHILD + WS_VISIBLE, ;
			12, 12, 288, 58, ;
			This.hWnd, 0, nInstance, 0)
		SendMessage(hWndCtrl, ACM_OPEN, nShellHandle, 160)
	ENDPROC

	PROCEDURE SetRange(tnRange)
	*  Parameter List...: tnRange	- Progress Bar range.
		If VarType(tnRange) = 'N' AND tnRange != 0
			This.nRange = tnRange
			This.shape1.Width = 200 * This.nPos / This.nRange
		EndIf
	ENDPROC

	PROCEDURE SetPos(tnPos, tcMessage)
	*  Parameter List...: tnPos		- Progress Bar position.
	*					: tcMessage	- Message to display. Optional.
		If VarType(tcMessage) = 'C' AND !Empty(tcMessage)
			This.lblInfo.Caption = tcMessage
		EndIf
		If VarType(tnPos) = 'N'
			This.nPos  = tnPos
			This.shape1.Width = 200 * This.nPos / This.nRange
		EndIf
	ENDPROC

	PROCEDURE cmdCancel.Click
		ThisForm.lCancel = .T.
	ENDPROC

ENDDEFINE
>I have a procedure that does not lend itself to showing a thermometer to the user. I was thinking of displaying an animated icon on the form just to let the user know something is happening after they click on the command button that starts the procedure. I found an AVI in \Program Files\Microsoft Visual FoxPro 7\Graphics\Videos called Filemove.Avi that would be perfect. Is there an easy way to display this avi on my form? Is there something other than an AVI which would be a better choice? Will I be making the form too complicated by adding a multimedia Activex control just to display this AVI - in other words am I just asking for trouble? Should I just throw up a WAIT WINDOW NOWAIT message?
>
>Thanks in advance for any help!!
Previous
Reply
Map
View

Click here to load this message in the networking platform