At 2010-01-25 19:44, Graham Trott wrote:
>I would just like to create a simple progress bar that does not use
>any screen real estate.
I have used a routine for many years that resembles FP:s internal
progress bar showing progress during sql-selects. I have propably
"stolen" it somewhere, can't remember...
*!*****************************************************************************
*!
*! Function: PROGRESS()
*!
*!*****************************************************************************
FUNCTION progress
PARAMETERS lnPct, lcTopMsg, lcBotMsg
PRIVATE lnPct, lcBotMsg, lcTopMsg, llGraphic, lnPctAt, lcPctAt
*****
* Validate the Parameters
*****
IF TYPE("m.lnPct") # "N"
m.lnPct = 0
ENDIF
IF TYPE("m.lcBotMsg") # "C"
m.lcBotMsg = ""
ENDIF
IF TYPE("m.lcTopMsg") # "C"
m.lcTopMsg = ""
ENDIF
#DEFINE c_dlgface "MS Sans Serif"
#DEFINE c_dlgsize 8.000
#DEFINE c_dlgstyle "B"
* define window when calling the first time
*
IF NOT WEXIST('W_PROGRESS')
* This only gets run once, first time called
*
SET CURSOR OFF
DEFINE WINDOW w_progress ;
AT INT((SROW() - (( 5.615 * FONTMETRIC(1, c_dlgface,
c_dlgsize, c_dlgstyle )) /
FONTMETRIC(1,WFONT(1,""),WFONT(2,""),WFONT(3,"")))) / 2) , ;
INT((SCOL() - (( 63.833 * FONTMETRIC(6, c_dlgface,
c_dlgsize, c_dlgstyle )) /
FONTMETRIC(1,WFONT(1,""),WFONT(2,""),WFONT(3,"")))) / 2) ;
SIZE 5.615, 63.833 ;
FONT c_dlgface, c_dlgsize ;
STYLE c_dlgstyle ;
NOCLOSE ;
NONE ;
COLOR RGB(0, 0, 0, 192, 192, 192)
* nofloat ;
MOVE WINDOW w_progress CENTER
ACTIVATE WINDOW w_progress NOSHOW
* Draw lines to create 'raised-panel' look:
@ 0.000, 0.000 TO 0.000, 63.833 COLOR RGB( 255, 255, 255,
255, 255, 255)
@ 0.000, 0.000 TO 5.615, 0.000 COLOR RGB( 255, 255, 255,
255, 255, 255)
@ 0.385, 0.667 TO 5.231, 0.667 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 0.308, 0.667 TO 0.308, 63.167 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 0.385, 63.000 TO 5.308, 63.000 COLOR RGB( 255, 255, 255,
255, 255, 255)
@ 5.231, 0.667 TO 5.231, 63.167 COLOR RGB( 255, 255, 255,
255, 255, 255)
@ 5.538, 0.000 TO 5.538, 63.833 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 0.000, 63.667 TO 5.615, 63.667 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 3.000, 3.333 TO 4.231, 3.333 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 3.000, 60.333 TO 4.308, 60.333 COLOR RGB( 255, 255, 255,
255, 255, 255)
@ 3.000, 3.333 TO 3.000, 60.333 COLOR RGB( 128, 128, 128,
128, 128, 128)
@ 4.231, 3.333 TO 4.231, 60.500 COLOR RGB( 255, 255, 255,
255, 255, 255)
SHOW WINDOW w_progress TOP
ELSE
ACTIVATE WINDOW w_progress
ENDIF
* Display the horizontal progress bar
DO CASE
CASE m.lnPct > 0 AND m.lnPct < 100
m.nblocks = (m.lnPct / 100) * 57
m.lcPct = LTRIM(STR(m.lnPct))+" %"
IF PARAMETERS() > 2
@ 0.5, 3 SAY m.lcTopMsg FONT c_dlgface, c_dlgsize
STYLE c_dlgstyle
ENDIF
IF PARAMETERS() > 1
@ 1.5, 3 SAY m.lcBotMsg FONT c_dlgface, c_dlgsize
STYLE c_dlgstyle
ENDIF
m.lnPctAt = (WCOLS()-TXTWIDTH(m.lcPct))/2
@ 3.00, 3.33 TO 4.231, m.nBlocks + 3.333 PATTERN 1 COLOR
RGB( 128, 128, 128, 128, 128, 128)
* @ 3.10, m.nBlocks+3.43 TO 4.231, 60.400 PATTERN 1 COLOR
RGB(192, 192, 192, 192, 192, 192)
@ 3.10, m.nBlocks+3.40 TO 4.231, 60.400 PATTERN 1 COLOR
RGB(192, 192, 192, 192, 192, 192) && DO:970901
IF m.lnPct < 50
@ 3.15, m.lnPctAt SAY m.lcPct FONT c_dlgface,
c_dlgsize STYLE c_dlgstyle+"T" COLOR RGB( 0, 0, 0, 192, 192, 192)
ELSE
@ 3.15, m.lnPctAt SAY m.lcPct FONT c_dlgface,
c_dlgsize STYLE c_dlgstyle+"T" COLOR RGB(255, 255, 255, 192, 192, 192)
ENDIF
CASE m.lnPct < 1
m.nblocks = (m.lnPct / 100) * 57
m.lcPct = LTRIM(STR(m.lnPct))+" %"
IF PARAMETERS() > 2
@ 0.5, 3 SAY m.lcTopMsg FONT c_dlgface, c_dlgsize
STYLE c_dlgstyle
ENDIF
IF PARAMETERS() > 1
@ 1.5, 3 SAY m.lcBotMsg FONT c_dlgface, c_dlgsize
STYLE c_dlgstyle
ENDIF
m.lnPctAt = (WCOLS()-TXTWIDTH(m.lcPct))/2
@ 3.00, 3.33 TO 4.231, m.nBlocks + 3.333 PATTERN 1 COLOR
RGB( 128, 128, 128, 128, 128, 128)
@ 3.10, m.nBlocks+3.40 TO 4.231, 60.400 PATTERN 1 COLOR
RGB(192, 192, 192, 192, 192, 192)
IF m.lnPct < 50
@ 3.15, m.lnPctAt SAY m.lcPct FONT c_dlgface,
c_dlgsize STYLE c_dlgstyle+"T" COLOR RGB( 0, 0, 0, 192, 192, 192)
ELSE
@ 3.15, m.lnPctAt SAY m.lcPct FONT c_dlgface,
c_dlgsize STYLE c_dlgstyle+"T" COLOR RGB(255, 255, 255, 192, 192, 192)
ENDIF
CASE m.lnPct >= 100
m.nblocks = 57
m.lcPct = "100 %"
m.lnPctAt = (WCOLS()-TXTWIDTH(m.lcPct))/2
@ 3.000, 3.333 TO 4.231, m.nblocks + 3.333 PATTERN 1 COLOR
RGB(128, 128, 128, 128, 128, 128)
@ 3.15, m.lnPctAt SAY m.lcPct FONT c_dlgface, c_dlgsize
STYLE c_dlgstyle+"T" COLOR RGB(255, 255, 255, 192, 192, 192)
WAIT '' TIMEOUT .5
RELEASE WINDOW w_progress
SET CURSOR ON
ENDCASE
******************************
* Dan Olsson
* <mailto:d...@dolittle.se>
* <http://www.dolittle.se>
_______________________________________________
Post Messages to: ProFox@leafe.com
Subscription Maintenance: http://leafe.com/mailman/listinfo/profox
OT-free version of this list: http://leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message:
http://leafe.com/archives/byMID/profox/6.2.5.6.2.20100126102703.10240...@dolittle.se
** All postings, unless explicitly stated otherwise, are the opinions of the
author, and do not constitute legal or medical advice. This statement is added
to the messages for those lawyers who are too stupid to see the obvious.
