*!* *Used in external procedure
*!* =thermometr(0,1000,.T.,.F.,'Title of window','Thermometr message')
*!* FOR I = 1 TO 1000
*!* =thermometr(I,1000)
*!* ENDFOR
*!* =thermometr(0,1000,.F.,.T.)
procedure thermometr
PARAMETERS nTmpCount,nRecCount,lOpenScreen,lCloseScreen,cThermTitle,cThermMsg

#DEFINE C_THERMCLASS 'thermometer' && single progress bar

IF TYPE('nTmpCount') != 'N' .AND. TYPE('nRecCount') != 'N'
=MESSAGEBOX('Не заданы параметры линейки',0+16,'Ошибка')
RETURN
ENDIF

DO CASE
CASE lOpenScreen = .T.
IF TYPE('cThermTitle') = 'L'
cThermTitle = ''
ENDIF
IF TYPE('cThermMsg') = 'L'
cThermMsg = 'Пожалуйста, подождите!'
ENDIF

=AddClassLib()

PUBLIC gOTherm

gOTherm = CREATEOBJ(C_THERMCLASS,cThermTitle, cThermMsg)
*!* parameters cWinTitle, cTitle, iBasis, iInterval

gOTherm.Show()
CASE lCloseScreen = .T.
gOTherm.Complete()
RELEASE gOTherm
OTHERWISE
gOTherm.Update(nTmpCount/nRecCount * 100)
ENDCASE

*******************************************
FUNCTION AddClassLib

#DEFINE C_MAINCLASSLIB "thermometr.vcx"

IF ATC(C_MAINCLASSLIB,SET("CLASSLIB")) = 0

IF !FILE("thermometr.vcx")
find_file = GETFILE("VCX")
IF LEN(ALLTRIM(find_file)) = 0
RETURN
ELSE
Name_File = ALLTRIM(find_file)
ENDIF
ELSE
Name_File = "thermometr.vcx"
ENDIF

IF ATC(C_MAINCLASSLIB,Name_File)#0
SET CLASS TO &Name_File ADDITIVE
ELSE
RETURN .F.
ENDIF

ENDIF

ENDFUNC
*******************************

а файлы thermometr.vct и thermometr.vcx впихнутл во вложение....

а не скажете ли - что сложного в моем примере???
готовая функция запускается с параметрами - и переделывать ничего не надо... в чем проблема - то???