Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : SCR2FRG.ZIP
Filename : SCR2FRG.COD

 
Output of file : SCR2FRG.COD contained in archive : SCR2FRG.ZIP
//
// Module Name: SCR2FRG.COD
//

FORMAT to REPORT (.scr -> .frg) File Template
----------------------------------------------------
Written by Bryan Flynn, Ashton-Tate Software Support

Description: This file will convert .SCR files to .FRG files,
Enabling the user to print Screen Forms with the
REPORT FORM command. This special .GEN file will
replace the default FORM.GEN that is used to generate
screen forms.

Notes: o The SUMMARY option is not supported and has no effect if specified.
o ".PB" in the first column of a screen line will insert a page break
at that point.
o The screen form (.SCR) must be regenerated, using this .GEN
file, for the .FRG to be created. Note that when modifying
the screen, pressing will force regeneration.

For further details on the use of SCR2FRG.GEN, see the March 1990 issue
of Ashton-Tate's TechNotes magazine.

{
include "form.def"; // Form selectors
include "builtin.def"; // Builtin functions
//
enum wrong_class = "This .GEN file can only be used on SCREEN FORM files. ",
window_limit = 26;
//

if Frame_class != form then // We are not processing a form object
pause(wrong_class + any_key);
goto NoGen;
endif

var frg_name, // Format file name
crlf, // line feed
temp, // tempory work variables
line_cnt, // Count for total lines processed
default_drv,// dBASE default drive
scrn_size, // Screen size when generation starts
scrn_size2, // = 43 or 25
display, // Type of display screen we are on
dB_status, // dBASE status bar (on|off) before entering designer
maxrow, // Used for blank lines
box_ht, // HEIGHT of DEFINEd BOXes
is_memo, // How many memos w/ windows are currently being printed
no_AT, // Don't print AT location if memo marker
avail_stck, // Stack to hold which set of memo variables is available
used_stck, // Stack to hold which set of memo variables is being used
// memo#_1 = Holds expression for printout of memos
// memo#_2 = What line of memo to print
// memo#_3 = How many lines of memo to print
// Screen can have up to 26 memo windows next to each other at any one time.
// Arrays not supported in the Template Language
memo1_1, memo1_2, memo1_3, memo2_1, memo2_2, memo2_3, memo3_1, memo3_2, memo3_3,
memo4_1, memo4_2, memo4_3, memo5_1, memo5_2, memo5_3, memo6_1, memo6_2, memo6_3,
memo7_1, memo7_2, memo7_3, memo8_1, memo8_2, memo8_3, memo9_1, memo9_2, memo9_3,
memo10_1, memo10_2, memo10_3,memo11_1, memo11_2, memo11_3,memo12_1, memo12_2, memo12_3,
memo13_1, memo13_2, memo13_3,memo14_1, memo14_2, memo14_3,memo15_1, memo15_2, memo15_3,
memo16_1, memo16_2, memo16_3,memo17_1, memo17_2, memo17_3,memo18_1, memo18_2, memo18_3,
memo19_1, memo19_2, memo19_3,memo20_1, memo20_2, memo20_3,memo21_1, memo21_2, memo21_3,
memo22_1, memo22_2, memo22_3,memo23_1, memo23_2, memo23_3,memo24_1, memo24_2, memo24_3,
memo25_1, memo25_2, memo25_3,memo26_1, memo26_2, memo26_3;


//-----------------------------------------------
// Assign default values to some of the variables
//-----------------------------------------------
is_memo = 0;
avail_stck=" 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20,21," +
"22,23,24,25,26,";
used_stck="";

crlf = chr(10);
temp = "";
line_cnt = 0;

//-------------------------------
// Test screen size if display > 2 screen is 43 lines
//-------------------------------
display = numset(_flgcolor);
if display > ega25 then scrn_size = 39 else scrn_size = 21 endif;
scrn_size2 = scrn_size + 4;
dB_status = numset(_flgstatus); // _flgstatus defined in BUILTIN.DEF
if scrn_size == 21 and !dB_status then
scrn_size = 24;
endif
//else
if scrn_size == 39 and !dB_status then // STATUS is off
scrn_size = 42;
endif

//-------------------------------
// Create .FRG file
//-------------------------------
default_drv = strset(_defdrive); // Grab default drive from dBASE

frg_name = FRAME_PATH + NAME;
if not fileok(frg_name) then
if !default_drv then
frg_name = NAME;
else
frg_name = default_drv + ":" + NAME;
endif
endif
frg_name = upper(frg_name);
if not create(frg_name+".FRG") then
pause(fileroot(frg_name) +".FRG" + read_only + any_key);
goto nogen;
endif
if not fileexist(frg_name+".FMT") then
cursor_pos(2, 1);
cput("You don't have a FORMAT file by this name. Ignore 'File does not exist' error");
endif
}
//
*--- Name....: {filename(frg_name)}FRG
*--- Date....: {ltrim(SUBSTR(date(),1,8))}
*--- Version.: dBASE IV, Format {Frame_ver}.0x
*
*--- Parameters
PARAMETERS m_NoEject, m_Plain, m_Summary, m_Heading, m_Extra
*--- NOT USED: m_Summary
*--- The first three parameters are of type logical.
*--- The fourth parameter is a string. The fifth is extra.
PRIVATE _peject, _wrap, _box, m_Talk, m_Width, m_Prntflg, m_PSpace, m_Atline

*--- Report file initialization code --------------------------------------------

*--- Test for no records found
IF EOF() .OR. .NOT. FOUND()
RETURN
ENDIF

*--- Turn wrap mode off
_wrap = .F.

*--- Set _box to true so DEFINEd BOXes will print
_box = .T.

*--- Start printing at line zero of page.
_plineno=0

*--- Set NOEJECT parameter of the REPORT FORM command.
if m_NoEject
IF _peject = "BEFORE"
_peject = "NONE"
ENDIF
IF _peject = "BOTH"
_peject = "AFTER"
ENDIF
ENDIF

*--- Set-up environment
ON ESCAPE DO PrnAbort &&Do procedure PRNABORT if ESC is pressed when printing.
IF SET("TALK") = "ON" &&Save status of TALK so it can be restored later.
SET TALK OFF
m_Talk = "ON"
ELSE
m_Talk = "OFF"
ENDIF
m_Width = SET("MEMOWIDTH") &&Save current memowidth setting.
SET MEMOWIDTH TO 65 &&When printing memos, memowidth must be 65.
m_Prntflg = .T. &&Set to FALSE when user presses ESCAPE.

*--- Set up when to page break.
IF _pspacing > 1
m_Atline= _plength - (_pspacing + 1)
ELSE
m_Atline= _plength - 1
ENDIF
ON PAGE AT LINE m_Atline EJECT PAGE

*--- Print Report.
PRINTJOB

IF .NOT. m_Plain .AND. LEN(m_Heading) > 0
?? m_Heading FUNCTION "I;V80"
?
ENDIF

ON PAGE AT LINE m_Atline DO Pgfoot

*--- File Loop
DO WHILE m_Prntflg && FOUND() .AND. .NOT. EOF() .AND. m_Prntflg
DO __Detail
CONTINUE
IF FOUND() .AND. .NOT. EOF() .AND. m_Prntflg .AND. _pageno <= _pepage
EJECT PAGE && EJECT occurrs after each record
ELSE && Don't want to print HEADING after last record
ON PAGE
EJECT PAGE
EXIT
ENDIF
ENDDO

IF .NOT. m_Prntflg && User pressed the escape key while printing
DO RESET
RETURN
ENDIF

ENDPRINTJOB

DO Reset
RETURN
*--- EOP: {filename(frg_name)}FRG

*--- Executed when user presses ESCAPE while report is running.
PROCEDURE Prnabort
m_Prntflg = .F.
RETURN
*--- EOP: Prnabort

*--- Reset dBASE environment prior to calling report.
*--- Note that any ON ESCAPE or ON PAGE routine user had before
*--- running the REPORT FORM command will be cleared.
PROCEDURE Reset
SET TALK &m_Talk
SET MEMOWIDTH TO m_Width
ON ESCAPE
RETURN
*--- EOP: Reset

PROCEDURE __Detail
{maxrow = line_cnt = 0;
FOREACH ELEMENT form_object
if ROW_POSITN - line_cnt > scrn_size then
line_cnt = line_cnt + scrn_size + 1;
endif
nextline:
if maxrow < ROW_POSITN then
outmemo();}
?
{ ++maxrow;
goto nextline;
endif
no_AT=0; // "?? ... AT ## " should not be outputted if item is a memo with a window
case ELEMENT_TYPE of
@TEXT_ELEMENT:
if asc(TEXT_ITEM) < 32 then // Control character - use CHR()
if len(TEXT_ITEM) == 1 then}
?? CHR({asc(TEXT_ITEM)}) AT {nul2zero(COL_POSITN)}
{ else}
?? REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) AT {nul2zero(COL_POSITN)}
{ endif
else
if nul2zero(COL_POSITN) == 0 and len(TEXT_ITEM) >=3 and
upper(substr(TEXT_ITEM, 1, 3)) == ".PB" then
// User specified page break}
EJECT PAGE
{ if len(TEXT_ITEM) > 3 then}
?? "{substr(TEXT_ITEM, 4)}" AT 3
{ endif
else // no page break specified}
?? "{TEXT_ITEM}" AT {nul2zero(COL_POSITN)}
{ endif
endif
@BOX_ELEMENT:
outbox(form_object)
@FLD_ELEMENT:
case FLD_FIELDTYPE of
calc:}
* Calculated field - {FLD_DESCRIPT}
?? \
{ foreach FLD_EXPRESSION fcursor in form_object
FLD_EXPRESSION}
{ next} \
{ dbf:
if not (chr(FLD_VALUE_TYPE) == "M") then //Not type memo}
?? \
{ lower(FLD_FIELDNAME)} \
{ else //Item is memo field
if (FLD_MEM_TYP == 2) or
(is_memo == window_limit) then //No window for memo}
?? IIF(LEN({FLD_FIELDNAME}) = 0, "memo", "MEMO") \
{ else //Memo is in a window
++is_memo;

// Determine how wide memo line should be
if BOX_WIDTH - 2 > 65 then
temp = 65;
else
temp = BOX_WIDTH - 2;
endif

// Expression used when outputting memo in a window
// TEMP is assigned to memo#_1 in find_empty_memo()
temp = FLD_FIELDNAME + space(10-len(alltrim(FLD_FIELDNAME))) +
alltrim(str(temp)) + "), '') AT " + alltrim(str(BOX_LEFT + 1));
outbox(form_object) // Define memo window box
find_empty_memo(); // Assign memo expression

no_AT=1; // Don't print AT location
endif
endif
memvar:}
* Memory variable
?? \
{ lower("m->"+FLD_FIELDNAME)} \
{ endcase //FLD_FLDTYPE of}\
{ if not no_AT}AT {COL_POSITN} {endif}\
{ if FLD_TEMPLATE and not (chr(FLD_VALUE_TYPE) == "M") then}
PICTURE "{ if FLD_PICFUN and not AT("M",FLD_PICFUN) then
if not at("S",FLD_PICFUN) then}\
@{FLD_PICFUN} {FLD_TEMPLATE}"
{ else //Scroll field
substr(FLD_TEMPLATE,1,FLD_PIC_SCROLL)}"
{ endif
else //No picture clause, just template}
{FLD_TEMPLATE}"
{ endif
else}
{ if not no_AT then print(crlf) endif //If memo marker or no template
endif}
{ otherwise: //Non ELEMENT
endcase //ELEMENT of
next form_object;
outmemo();//fill out memo box
if ((maxrow + 1) % scrn_size2) != 0 then
//If not on last line of screen, finish "??" line from the above FOREACH loop.}
?
{ ++maxrow;
nextline2:
if ((maxrow + 1) % scrn_size2) != 0 then
// If not on last line of screen, fill out remainder of screen with ?'s
outmemo();}
?
{ ++maxrow;
goto nextline2;
endif
endif}
RETURN
*--- EOP: __Detail

PROCEDURE Pgfoot
EJECT PAGE
IF .NOT. m_Plain .AND. LEN(m_Heading) > 0
?? m_Heading FUNCTION "I;V80"
?
ENDIF
RETURN
*--- EOP: Pgfoot

{fileerase(frg_name+".FRO");
nogen:
return 0;

//---------------------------------------
// Template user defined functions below
//---------------------------------------

define nul2zero(numbr);
// If number is null and we are expecting a zero - convert the null to 0
if !numbr then numbr=0 endif;
return numbr;
enddef

define outbox(cur)
var temp;}
DEFINE BOX FROM {nul2zero(cur.BOX_LEFT)} TO \
{ nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1} HEIGHT \
{ temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1;
if temp > scrn_size then
box_ht = (scrn_size - cur.BOX_TOP + 1);
else
box_ht = (temp - cur.BOX_TOP + 1);
endif
// box_ht is defined in main program and is needed if the box is
// to be used with a memo window
box_ht} \
{ case cur.BOX_TYPE of
0: // Single}
SINGLE
{ 1: // Double}
DOUBLE
{ 2: // Defined}
CHR({cur.BOX_SPECIAL_CHAR})
{ endcase
enddef

define outmemo()
// There can be up to 26 memo windows next to eachother in Screen Form
var temp_stck;
temp_stck = used_stck;
do while temp_stck
outmemo2(val(substr(temp_stck, 1, 2)))
temp_stck = substr(temp_stck, 4);
enddo
return;
enddef

define outmemo2(whch_memo)
case whch_memo of
1: outmemo3(memo1_1, memo1_2, memo1_3, " 1")
2: outmemo3(memo2_1, memo2_2, memo2_3, " 2")
3: outmemo3(memo3_1, memo3_2, memo3_3, " 3")
4: outmemo3(memo4_1, memo4_2, memo4_3, " 4")
5: outmemo3(memo5_1, memo5_2, memo5_3, " 5")
6: outmemo3(memo6_1, memo6_2, memo6_3, " 6")
7: outmemo3(memo7_1, memo7_2, memo7_3, " 7")
8: outmemo3(memo8_1, memo8_2, memo8_3, " 8")
9: outmemo3(memo9_1, memo9_2, memo9_3, " 9")
10: outmemo3(memo10_1, memo10_2, memo10_3, "10")
11: outmemo3(memo11_1, memo11_2, memo11_3, "11")
12: outmemo3(memo12_1, memo12_2, memo12_3, "12")
13: outmemo3(memo13_1, memo13_2, memo13_3, "13")
14: outmemo3(memo14_1, memo14_2, memo14_3, "14")
15: outmemo3(memo15_1, memo15_2, memo15_3, "15")
16: outmemo3(memo16_1, memo16_2, memo16_3, "16")
17: outmemo3(memo17_1, memo17_2, memo17_3, "17")
18: outmemo3(memo18_1, memo18_2, memo18_3, "18")
19: outmemo3(memo19_1, memo19_2, memo19_3, "19")
20: outmemo3(memo20_1, memo20_2, memo20_3, "20")
21: outmemo3(memo21_1, memo21_2, memo21_3, "21")
22: outmemo3(memo22_1, memo22_2, memo22_3, "22")
23: outmemo3(memo23_1, memo23_2, memo23_3, "23")
24: outmemo3(memo24_1, memo24_2, memo24_3, "24")
25: outmemo3(memo25_1, memo25_2, memo25_3, "25")
26: outmemo3(memo26_1, memo26_2, memo26_3, "26")
endcase
return;
enddef


define outmemo3(expr, what_line, maximum_lines, whch_memo)
// Don't print out anything if printing top or bottom line of box
if (what_line != 1) and (what_line != maximum_lines) then}
?? IIF('' <> MLINE({alltrim(substr(expr, 1, 10))}, {what_line - 1}), \
SUBSTR(MLINE({alltrim(substr(expr, 1, 10))}, {what_line - 1}), 1, {substr(expr, 11)}
{ endif
++what_line;
if what_line > maximum_lines then // Done printing memo
--is_memo;
// Take this reference off active stack
used_stck = substr(used_stck, 1, at(whch_memo, used_stck) - 1) +
substr(used_stck, at(whch_memo, used_stck) + 3);
// Put this memo back on available stack so the corresponding memo
// variables can be used again.
avail_stck = whch_memo + "," + avail_stck;
endif
return;
enddef

define assign_vals(expr, what_line, maximum_lines)
// Called when memo with window is encountered
expr = temp; // temp is from main program
what_line = 1; // First line to print of memo
maximum_lines = box_ht;
return;
enddef

define find_empty_memo()
used_stck = substr(avail_stck, 1, 3) + used_stck;
avail_stck = substr(avail_stck, 4);
case val(substr(used_stck, 1, 2)) of
1: assign_vals(memo1_1, memo1_2, memo1_3)
2: assign_vals(memo2_1, memo2_2, memo2_3)
3: assign_vals(memo3_1, memo3_2, memo3_3)
4: assign_vals(memo4_1, memo4_2, memo4_3)
5: assign_vals(memo5_1, memo5_2, memo5_3)
6: assign_vals(memo6_1, memo6_2, memo6_3)
7: assign_vals(memo7_1, memo7_2, memo7_3)
8: assign_vals(memo8_1, memo8_2, memo8_3)
9: assign_vals(memo9_1, memo9_2, memo9_3)
10: assign_vals(memo10_1, memo10_2, memo10_3)
11: assign_vals(memo11_1, memo11_2, memo11_3)
12: assign_vals(memo12_1, memo12_2, memo12_3)
13: assign_vals(memo13_1, memo13_2, memo13_3)
14: assign_vals(memo14_1, memo14_2, memo14_3)
15: assign_vals(memo15_1, memo15_2, memo15_3)
16: assign_vals(memo16_1, memo16_2, memo16_3)
17: assign_vals(memo17_1, memo17_2, memo17_3)
18: assign_vals(memo18_1, memo18_2, memo18_3)
19: assign_vals(memo19_1, memo19_2, memo19_3)
20: assign_vals(memo20_1, memo20_2, memo20_3)
21: assign_vals(memo21_1, memo21_2, memo21_3)
22: assign_vals(memo22_1, memo22_2, memo22_3)
23: assign_vals(memo23_1, memo23_2, memo23_3)
24: assign_vals(memo24_1, memo24_2, memo24_3)
25: assign_vals(memo25_1, memo25_2, memo25_3)
26: assign_vals(memo26_1, memo26_2, memo26_3)
endcase
return;
enddef
}
// EOP SCR2FRG.COD


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : SCR2FRG.ZIP
Filename : SCR2FRG.COD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/