Class works great in VFP7 but not in VFP8

Level Extreme platform

Subscription

Corporate profile

Products & Services

Support

Legal

Français

Class works great in VFP7 but not in VFP8

Message

From

15/02/2004 10:04:47

Fabio Lunardon
Lunacom
Marostica, Italy

13/02/2004 15:52:31

Tc Holzer
Isle of Man

General information

Forum:

Visual FoxPro

Category:

Other

Title:

Re: Class works great in VFP7 but not in VFP8

Miscellaneous

Thread ID:

00877235

Message ID:

00877483

Views:

This message has been marked as the solution to the initial question of the thread.

Tracy, the problem is not on the form,
but on the costruction of the therm.

*TESTHERM.PRG
CLEAR
*CLOSE ALL
SET SAFETY OFF

CREATE CURSOR JUNKDBF (cvalue c(10))

FOR i = 1 TO 30
	APPEND BLANK
	REPLACE cvalue WITH ALLTRIM(STR(i))
ENDFOR

al3_file="whatever" && or whatever
Y=0
mrectot = RECCOUNT('junkdbf')  && we are stepping thru this table
lnrep = 0
oprogress = CREATEOBJECT('therm',mrectot+3,al3_file)
oprogress.CAPTION = "Processing..."
oprogress.VISIBLE = .T.

llabortall = .F.
ON KEY LABEL ALT+F10 DO abortall

SELECT junkdbf

GO TOP

SCAN
   IF llabortall  && this works in VFP7 too but not in VFP8 for some reason
      EXIT
   ENDIF
   lnrep = lnrep + 1
   y = lnrep
   oprogress.label2.CAPTION="Processing: "+junkdbf.cvalue
   oprogress.updatetherm(Y)
*	DOEVENTS						&& <== THIS IS NOT NEED
*	oprogress.refresh()				&& <== THIS IS NOT NEED
	ia = 0
	FOR Ia = 1 TO 10000000
	ENDFOR
   *adding oprogress.draw() or .refresh() here doesn't seem to make any difference
   *--Processing takes place here
ENDSCAN
*MORE STUFF ETC

IF TYPE('oprogress')="O" .and. !ISNULL(oprogress)
   oprogress.RELEASE()
ELSE
   oprogress=.NULL.
   RELEASE oprogress
ENDIF

USE IN JUNKDBF

ON KEY LABEL ALT+F10

RETURN

PROCEDURE abortall
   llabortall = .T.
RETURN

DEFINE CLASS therm AS FORM

   HEIGHT = 120
   WIDTH = 328
   SHOWWINDOW = 1
   DOCREATE = .T.
   AUTOCENTER = .T.
   BORDERSTYLE = 2
   CAPTION = ""
   CONTROLBOX = .F.
   CLOSABLE = .F.
   MAXBUTTON = .F.
   MINBUTTON = .F.
   MOVABLE = .F.

   *-- Denominator used to define the width of the bar and the label
   n_denominator = 0
   NAME = "therm"


   ADD OBJECT backshape AS SHAPE WITH ;
      TOP = 36, ;
      LEFT = 15, ;
      HEIGHT = 34, ;
      WIDTH = 300, ;
      BACKSTYLE = 1, ;
      BORDERSTYLE = 0, ;
      BACKCOLOR = RGB(255,255,255), ;
      NAME = "Backshape"


   ADD OBJECT label1 AS LABEL WITH ;
      FONTBOLD = .T., ;
      FONTNAME = "MS Sans Serif", ;
      ALIGNMENT = 2, ;
      CAPTION = "Label1", ;
      HEIGHT = 18, ;
      LEFT = 117, ;
      TOP = 45, ;
      WIDTH = 93, ;
      TABINDEX = 2, ;
      FORECOLOR = RGB(0,0,255), ;
      BACKCOLOR = RGB(255,255,255), ;
      NAME = "Label1"


   ADD OBJECT foreshape AS SHAPE WITH ;
      TOP = 37, ;
      LEFT = 15, ;
      HEIGHT = 32, ;
      WIDTH = 0, ;
      BACKSTYLE = 0, ;
      BORDERSTYLE = 0, ;
      DRAWMODE = 10, ;
      FILLSTYLE = 0, ;
      BACKCOLOR = RGB(255,255,255), ;
      FILLCOLOR = RGB(0,0,255), ;
      NAME = "ForeShape"


   ADD OBJECT text1 AS TEXTBOX WITH ;
      THEMES = .F.,;	&& <====== THIS IS THE PROBLEM, THEMED 3D TEXTBOX ARE NOT TRASPARENT, A ERROR FOR ME !!!!!!!!!!!!!!
      BACKSTYLE = 0, ;
      HEIGHT = 38, ;
      LEFT = 12, ;
      TOP = 33, ;
      WIDTH = 304, ;
      NAME = "Text1"


   ADD OBJECT label2 AS LABEL WITH ;
      AUTOSIZE = .T., ;
      FONTNAME = "MS Sans Serif", ;
      FONTSIZE = 8, ;
      CAPTION = "Processing...", ;
      HEIGHT = 15, ;
      LEFT = 14, ;
      TOP = 11, ;
      WIDTH = 63, ;
      NAME = "Label2"


   *-- Update thermometer
   PROCEDURE updatetherm
      LPARAMETER p_newnumer
      LOCAL n_pct
      n_pct = MIN((m.p_newnumer / m.THISFORM.n_denominator),1)	&& <
      THISFORM.foreshape.WIDTH = INT(300 * m.n_pct)
      THISFORM.label1.CAPTION = TRANSFORM(m.n_pct * 100, '###%')
      
*      THISFORM.REFRESH						&& <== THIS IS NOT NEED

   ENDPROC


   PROCEDURE INIT
      LPARAMETERS pn_denom, pc_msg
      THIS.label1.CAPTION = '0%'
      THISFORM.n_denominator = pn_denom
      IF PCOUNT() = 2					&& <==== use PCOUNT()
         THISFORM.label2.CAPTION = pc_msg
      ENDIF
   ENDPROC


   PROCEDURE text1.WHEN
      RETURN .F.
   ENDPROC


ENDDEFINE
*
*-- EndDefine: therm
**************************************************

But if you put TextBox under the shape, themed is usable:

*TESTHERM.PRG
CLEAR
*CLOSE ALL
SET SAFETY OFF

CREATE CURSOR JUNKDBF (cvalue c(10))

FOR i = 1 TO 30
	APPEND BLANK
	REPLACE cvalue WITH ALLTRIM(STR(i))
ENDFOR

al3_file="whatever" && or whatever
Y=0
mrectot = RECCOUNT('junkdbf')  && we are stepping thru this table
lnrep = 0
oprogress = CREATEOBJECT('therm',mrectot+3,al3_file)
oprogress.CAPTION = "Processing..."
oprogress.VISIBLE = .T.

llabortall = .F.
ON KEY LABEL ALT+F10 DO abortall

SELECT junkdbf

GO TOP

SCAN
   IF llabortall  && this works in VFP7 too but not in VFP8 for some reason
      EXIT
   ENDIF
   lnrep = lnrep + 1
   y = lnrep
   oprogress.label2.CAPTION="Processing: "+junkdbf.cvalue
   oprogress.updatetherm(Y)
*	DOEVENTS						&& <== THIS IS NOT NEED
*	oprogress.refresh()				&& <== THIS IS NOT NEED
	ia = 0
	FOR Ia = 1 TO 10000000
	ENDFOR
   *adding oprogress.draw() or .refresh() here doesn't seem to make any difference
   *--Processing takes place here
ENDSCAN
*MORE STUFF ETC

IF TYPE('oprogress')="O" .and. !ISNULL(oprogress)
   oprogress.RELEASE()
ELSE
   oprogress=.NULL.
   RELEASE oprogress
ENDIF

USE IN JUNKDBF

ON KEY LABEL ALT+F10

RETURN

PROCEDURE abortall
   llabortall = .T.
RETURN

DEFINE CLASS therm AS FORM

   HEIGHT = 120
   WIDTH = 328
   SHOWWINDOW = 1
   DOCREATE = .T.
   AUTOCENTER = .T.
   BORDERSTYLE = 2
   CAPTION = ""
   CONTROLBOX = .F.
   CLOSABLE = .F.
   MAXBUTTON = .F.
   MINBUTTON = .F.
   MOVABLE = .F.

   *-- Denominator used to define the width of the bar and the label
   n_denominator = 0
   NAME = "therm"

   ADD OBJECT text1 AS TEXTBOX WITH ;
      THEMES = .T.,;	&& <====== NOW YOU CAN PUT 
      BACKSTYLE = 0, ;
      HEIGHT = 38, ;
      LEFT = 12, ;
      TOP = 33, ;
      WIDTH = 304, ;
      NAME = "Text1"

   ADD OBJECT backshape AS SHAPE WITH ;
      TOP = 36, ;
      LEFT = 15, ;
      HEIGHT = 34, ;
      WIDTH = 300, ;
      BACKSTYLE = 1, ;
      BORDERSTYLE = 0, ;
      BACKCOLOR = RGB(255,255,255), ;
      NAME = "Backshape"


   ADD OBJECT label1 AS LABEL WITH ;
      FONTBOLD = .T., ;
      FONTNAME = "MS Sans Serif", ;
      ALIGNMENT = 2, ;
      CAPTION = "Label1", ;
      HEIGHT = 18, ;
      LEFT = 117, ;
      TOP = 45, ;
      WIDTH = 93, ;
      TABINDEX = 2, ;
      FORECOLOR = RGB(0,0,255), ;
      BACKCOLOR = RGB(255,255,255), ;
      NAME = "Label1"


   ADD OBJECT foreshape AS SHAPE WITH ;
      TOP = 37, ;
      LEFT = 15, ;
      HEIGHT = 32, ;
      WIDTH = 0, ;
      BACKSTYLE = 0, ;
      BORDERSTYLE = 0, ;
      DRAWMODE = 10, ;
      FILLSTYLE = 0, ;
      BACKCOLOR = RGB(255,255,255), ;
      FILLCOLOR = RGB(0,0,255), ;
      NAME = "ForeShape"





   ADD OBJECT label2 AS LABEL WITH ;
      AUTOSIZE = .T., ;
      FONTNAME = "MS Sans Serif", ;
      FONTSIZE = 8, ;
      CAPTION = "Processing...", ;
      HEIGHT = 15, ;
      LEFT = 14, ;
      TOP = 11, ;
      WIDTH = 63, ;
      NAME = "Label2"


   *-- Update thermometer
   PROCEDURE updatetherm
      LPARAMETER p_newnumer
      LOCAL n_pct
      n_pct = MIN((m.p_newnumer / m.THISFORM.n_denominator),1)	&& <
      THISFORM.foreshape.WIDTH = INT(300 * m.n_pct)
      THISFORM.label1.CAPTION = TRANSFORM(m.n_pct * 100, '###%')
      
*      THISFORM.REFRESH						&& <== THIS IS NOT NEED

   ENDPROC


   PROCEDURE INIT
      LPARAMETERS pn_denom, pc_msg
      THIS.label1.CAPTION = '0%'
      THISFORM.n_denominator = pn_denom
      IF PCOUNT() = 2					&& <==== use PCOUNT()
         THISFORM.label2.CAPTION = pc_msg
      ENDIF
   ENDPROC


   PROCEDURE text1.WHEN
      RETURN .F.
   ENDPROC


ENDDEFINE
*
*-- EndDefine: therm
**************************************************

But you can remove BackShape:

*TESTHERM.PRG
CLEAR
*CLOSE ALL
SET SAFETY OFF

CREATE CURSOR JUNKDBF (cvalue c(10))

FOR i = 1 TO 30
	APPEND BLANK
	REPLACE cvalue WITH ALLTRIM(STR(i))
ENDFOR

al3_file="whatever" && or whatever
Y=0
mrectot = RECCOUNT('junkdbf')  && we are stepping thru this table
lnrep = 0
oprogress = CREATEOBJECT('therm',mrectot+3,al3_file)
oprogress.CAPTION = "Processing..."
oprogress.VISIBLE = .T.

llabortall = .F.
ON KEY LABEL ALT+F10 DO abortall

SELECT junkdbf

GO TOP

SCAN
   IF llabortall  && this works in VFP7 too but not in VFP8 for some reason
      EXIT
   ENDIF
   lnrep = lnrep + 1
   y = lnrep
   oprogress.label2.CAPTION="Processing: "+junkdbf.cvalue
   oprogress.updatetherm(Y)
	FOR Ia = 1 TO 10000000
	ENDFOR
   *adding oprogress.draw() or .refresh() here doesn't seem to make any difference
   *--Processing takes place here
ENDSCAN
*MORE STUFF ETC

IF TYPE('oprogress')="O" .and. !ISNULL(oprogress)
   oprogress.RELEASE()
ELSE
   oprogress=.NULL.
   RELEASE oprogress
ENDIF

USE IN JUNKDBF

ON KEY LABEL ALT+F10

RETURN

PROCEDURE abortall
   llabortall = .T.
RETURN

DEFINE CLASS therm AS FORM
   HEIGHT = 120
   WIDTH = 328
   SHOWWINDOW = 1
   DOCREATE = .T.
   AUTOCENTER = .T.
   BORDERSTYLE = 2
   CAPTION = ""
   CONTROLBOX = .F.
   CLOSABLE = .F.
   MAXBUTTON = .F.
   MINBUTTON = .F.
   MOVABLE = .F.

   *-- Denominator used to define the width of the bar and the label
   n_denominator = 0
   NAME = "therm"

   ADD OBJECT text1 AS TEXTBOX WITH ;
      BACKSTYLE = 1, ;
      HEIGHT = 38, ;
      LEFT = 12, ;
      TOP = 33, ;
      WIDTH = 304, ;
      BACKCOLOR = RGB(255,255,255), ;
      NAME = "Text1"

   ADD OBJECT foreshape AS SHAPE WITH ;
      TOP = 37, ;
      LEFT = 15, ;
      HEIGHT = 32, ;
      WIDTH = 0, ;
      BACKSTYLE = 0, ;
      BORDERSTYLE = 0, ;
      DRAWMODE = 10, ;
      FILLSTYLE = 0, ;
      BACKCOLOR = RGB(255,255,255), ;
      FILLCOLOR = RGB(0,0,255), ;
      NAME = "ForeShape"
      
   ADD OBJECT label1 AS LABEL WITH ;
      FONTBOLD = .T., ;
      FONTNAME = "MS Sans Serif", ;
      ALIGNMENT = 2, ;
      CAPTION = "Label1", ;
      HEIGHT = 18, ;
      LEFT = 117, ;
      TOP = 45, ;
      WIDTH = 93, ;
      TABINDEX = 2, ;
      FORECOLOR = RGB(255,0,0), ;
      BACKSTYLE = 0, ;
      NAME = "Label1"

   ADD OBJECT label2 AS LABEL WITH ;
      AUTOSIZE = .T., ;
      FONTNAME = "MS Sans Serif", ;
      FONTSIZE = 8, ;
      CAPTION = "Processing...", ;
      HEIGHT = 15, ;
      LEFT = 14, ;
      TOP = 11, ;
      WIDTH = 63, ;
      NAME = "Label2"


   *-- Update thermometer
   PROCEDURE updatetherm
      LPARAMETER p_newnumer
      LOCAL n_pct
      n_pct = MIN((m.p_newnumer / m.THISFORM.n_denominator),1)	&& <
      THISFORM.foreshape.WIDTH = INT(300 * m.n_pct)
      THISFORM.label1.CAPTION = TRANSFORM(m.n_pct * 100, '###%')

   ENDPROC

   PROCEDURE INIT
      LPARAMETERS pn_denom, pc_msg
      THIS.label1.CAPTION = '0%'
      THISFORM.n_denominator = pn_denom
      IF PCOUNT() = 2					&& <==== use PCOUNT()
         THISFORM.label2.CAPTION = pc_msg
      ENDIF
   ENDPROC

   PROCEDURE text1.WHEN
      RETURN .F.
   ENDPROC


ENDDEFINE
*
*-- EndDefine: therm
**************************************************

Or best, Remove Textbox and use BackShape.
Fabio

Map

View

Click here to load this message in the networking platform