Category : Files from Magazines
Archive   : DBMS0790.ZIP
Filename : ZIEDLER.JUL

 
Output of file : ZIEDLER.JUL contained in archive : DBMS0790.ZIP

Listing 1


*******************************************************************
*-- Name....: TRIOLD.FMT
*-- Date....: 11-17-89
*-- Version.: dBASE IV, Format 1.0
*-- Notes...: Format files use "" as delimiters!
*******************************************************************


*-- Format file initialization code
--------------------------------------------

IF SET("TALK")="ON"
SET TALK OFF
lc_talk="ON"
ELSE
lc_talk="OFF"
ENDIF

*-- This form was created in COLOR mode
SET DISPLAY TO COLOR

lc_status=SET("STATUS")
*-- SET STATUS was ON when you went into the Forms Designer.
IF lc_status = "OFF"
SET STATUS ON
ENDIF


*-- @ SAY GETS Processing.
-----------------------------------------------------

*-- Format Page: 1

@ 0,20 TO 3,57 COLOR r+/b
@ 1,22 SAY "Sonata Bay Development Corporation" COLOR w/b
@ 1,58 SAY "²" COLOR n/n
@ 2,30 SAY "Customer Info Form" COLOR w/b
@ 2,58 SAY "²" COLOR n/n
@ 3,58 SAY "²" COLOR n/n

@ 4,23 SAY "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²" COLOR n/n
@ 6,5 TO 13,53 COLOR g+/b
@ 7,7 SAY "Customer " COLOR g+/b
@ 7,16 GET customer PICTURE "@!
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
MESSAGE "Enter full names of both spouses" ;
COLOR g+/b,g+/b
@ 7,54 SAY "²" COLOR n/n
@ 7,59 SAY "Sales person" COLOR g+/b
@ 7,72 GET salesmn PICTURE "@A! XX" COLOR g+/b,g+/b
@ 8,54 SAY "²" COLOR n/n
@ 8,59 SAY "Phone" COLOR g+/b
@ 8,66 GET phone PICTURE "(999)999-9999" COLOR g+/b,g+/b
@ 9,7 SAY "Address" COLOR g+/b
@ 9,16 GET ad1 PICTURE "@! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" COLOR
g+/b,g+/b @ 9,54 SAY "²" COLOR n/n
@ 9,59 SAY "In market " COLOR g+/b
@ 9,69 SAY inmkt PICTURE "X" COLOR g+/b
@ 10,16 GET ad2 PICTURE "@! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" COLOR
g+/b,g+/b
@ 10,54 SAY "²" COLOR n/n
@ 11,16 GET city PICTURE "@! XXXXXXXXXXXXXXXXXXXX" COLOR
g+/b,g+/b
@ 11,36 SAY ", " COLOR g+/b
@ 11,38 GET state PICTURE "@A! XX" COLOR g+/b,g+/b
@ 11,42 GET zip PICTURE "99999-9999" COLOR g+/b,g+/b
@ 11,54 SAY "²" COLOR n/n
@ 12,54 SAY "²" COLOR n/n
@ 13,54 SAY "²" COLOR n/n
@ 14,8 SAY "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
COLOR n/n
@ 18,18 SAY "Ok (Y/N/Q)" COLOR bg+/b
@ 18,29 SAY "ÍÍÍÍ" COLOR bg+/b
@ 18,33 SAY CHR(16) COLOR bg+/b
*-- Memory variable: mans
@ 18,35 GET m->mans PICTURE "@A! A" ;
VALID mans $ 'YNQ' ;
DEFAULT 'Y' ;
COLOR n/n,n/n

*-- Format file exit code
-----------------------------------------------------

*-- SET STATUS was ON when you went into the Forms Designer.
IF lc_status = "OFF" && Entered form with status off
SET STATUS OFF && Turn STATUS "OFF" on the way out
ENDIF

IF lc_talk="ON"
SET TALK ON
ENDIF

RELEASE lc_talk,lc_fields,lc_status
*-- EOP: TRIOLD.FMT



Listing 2


*******************************************************
*-- Name....: TRIAL.PRG
*-- Date....: 11-17-89
*-- Version.: dBASE IV, Format 1.0
*-- Notes...: Format files use "" as delimiters!
*******************************************************



*-- @ SAY GETS Processing.
-----------------------------------------------------

*-- Format Page: 1

PRIVATE mCUSTOMER
PRIVATE mSALESMN
PRIVATE mPHONE
PRIVATE mAD1
PRIVATE mINMKT
PRIVATE mAD2
PRIVATE mCITY
PRIVATE mSTATE
PRIVATE mZIP
PRIVATE MANS

**********************************************************
*-- USE following declarations for editing a record------

mCUSTOMER = SONCUST->CUSTOMER
mSALESMN = SONSLS->SALESMN
mPHONE = SONCUST->PHONE
mAD1 = SONCUST->AD1
mINMKT = SONCUST->INMKT
mAD2 = SONCUST->AD2
mCITY = SONCUST->CITY
mSTATE = SONCUST->STATE
mZIP = SONCUST->ZIP MANS = space(1)
**********************************************************

*-- USE following declarations for appending a record---------

mCUSTOMER = space(35)
mSALESMN = space(2)
mPHONE = space(13)
mAD1 = space(30)
mINMKT = space(1)
mAD2 = space(30)
mCITY = space(20)
mSTATE = space(2)
mZIP = space(10)
MANS = space(1)
****************************************************************

@ 0,20 TO 3,57 COLOR r+/b
@ 1,22 SAY "Sonata Bay Development Corporation" COLOR w/b
@ 1,58 SAY "²" COLOR n/n
@ 2,30 SAY "Customer Info Form" COLOR w/b
@ 2,58 SAY "²" COLOR n/n
@ 3,58 SAY "²" COLOR n/n
@ 4,23 SAY "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²" COLOR n/n
@ 6,5 TO 13,53 COLOR g+/b
@ 7,7 SAY "Customer " COLOR g+/b
@ 7,16 GET mcustomer PICTURE "@!
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" ;
MESSAGE "Enter full names of both spouses" ;
COLOR g+/b,g+/b
@ 7,54 SAY "²" COLOR n/n
@ 7,59 SAY "Sales person" COLOR g+/b
@ 7,72 GET msalesmn PICTURE "@A! XX" COLOR g+/b,g+/b
@ 8,54 SAY "²" COLOR n/n
@ 8,59 SAY "Phone" COLOR g+/b
@ 8,66 GET mphone PICTURE "(999)999-9999" COLOR g+/b,g+/b
@ 9,7 SAY "Address" COLOR g+/b
@ 9,16 GET mad1 PICTURE "@! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" COLOR
g+/b,g+/b
@ 9,54 SAY "²" COLOR n/n
@ 9,59 SAY "In market " COLOR g+/b
@ 9,69 SAY minmkt PICTURE "X" COLOR g+/b
@ 10,16 GET mad2 PICTURE "@! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
COLOR g+/b,g+/b
@ 10,54 SAY "²" COLOR n/n @ 11,16 GET mcity PICTURE "@!
XXXXXXXXXXXXXXXXXXXX" COLOR g+/b,g+/b
@ 11,36 SAY ", " COLOR g+/b
@ 11,38 GET mstate PICTURE "@A! XX" COLOR g+/b,g+/b
@ 11,42 GET mzip PICTURE "99999-9999" COLOR g+/b,g+/b
@ 11,54 SAY "²" COLOR n/n

@ 12,54 SAY "²" COLOR n/n
@ 13,54 SAY "²" COLOR n/n
@ 14,8 SAY "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
COLOR n/n
@ 18,18 SAY "Ok (Y/N/Q)" COLOR bg+/b
@ 18,29 SAY "ÍÍÍÍ" COLOR bg+/b
@ 18,33 SAY CHR(16) COLOR bg+/b
*-- Memory variable: mans
@ 18,35 GET m->mans PICTURE "@A! A" ;
VALID mans $ 'YNQ' ;
DEFAULT 'Y'

*-- Format file exit code
-----------------------------------------------------

*---- Replace all fields (remember to append blanks if needed)---

SELECT SONCUST
* APPEND BLANK
REPLACE CUSTOMER WITH mCUSTOMER

SELECT SONSLS
* APPEND BLANK
REPLACE SALESMN WITH mSALESMN

SELECT SONCUST
* APPEND BLANK
REPLACE PHONE WITH mPHONE
REPLACE AD1 WITH mAD1
REPLACE INMKT WITH mINMKT
REPLACE AD2 WITH mAD2
REPLACE CITY WITH mCITY
REPLACE STATE WITH mSTATE
REPLACE ZIP WITH mZIP
**************************************************************


*-- EOP: TRIAL.PRG


Listing 3


// Field attribute selectors (FOREACH Fld_element x .... NEXT)
//
FLD_FILENAME 060, // File name (Alias) of current field
// Menu Path: None - Value: String
FLD_FIELDNAME 061, // Field name of Element
// Menu Path: None - Value: String
FLD_FIELDTYPE 063, // Where the data is coming from
// Menu Path: None - Value: 0:dBF field
// 1:calc'ed
// 2:sum 3:predefined 4:memory var
FLD_VALUE_TYPE 064, // Field data type in dBF
// Menu Path: None - Value: 67:char
// 68:date 70:float
// 76:logical 77:memo 78:numeric
// Chr(fld_value_type) returns C:char
// D:date etc.
FLD_LENGTH 065, // Length of field in dBF
// Menu Path: None - Value: Number
FLD_DECIMALS 066, // Decimal positions for numeric data
// Menu Path: None - Value: Number
FLD_TEMPLATE 074, // Picture template
// Menu Path: FMT - Value: String
FLD_PICFUN 075, // Picture functions
// Menu Path: FMP - Value: String
FLD_PIC_CHOICE 180, // Picture function string for
// enumerated (M) picture.
// Menu Path: FMP - Value: String
FLD_PIC_SCROLL 183, // Picture function scroll
// for (S) picture
// Menu Path: FMP - Value: String
FLD_DESCRIPT 076, // Calc & sum description
// Menu Path: FMD - Value: String
FLD_EXPRESSION 077, // Calculated field expression
// Menu Path: FME - Value: String
FLD_L_BOUND 079, // Lower field range bound
// Menu Path: FMES - Value: String
FLD_U_BOUND 080, // Upper field range bound
// Menu Path: FMEL - Value: String
FLD_DEF_VAL 081, // Default field value
// Menu Path: FMED - Value: String
FLD_ED_COND 082, // Edit if condition
// Menu Path: FMEE - Value: String
FLD_OK_COND 083, // Satisfy condition
// Menu Path: FMEA - Value: String
FLD_REJ_MSG 084, // Reject message
// Menu Path: FMEU - Value: String
FLD_HLP_MSG 099, // Help message
// Menu Path: FMEM - Value: String
FLD_MEM_TYP 170, // Memo window type
// Menu Path: FMED - Value: 1:Open
// 2:Marker
FLD_EDITABLE 087, // Say or Get data
// Menu Path: FMED - Value: 0:say 1:get
FLD_CARRY 088, // Carry value forward
// Menu Path: FMEC - Value: 0:no 1:yes
FLD_DISPLAY 171, // Field display



Listing 4


1: //
2: // Module Name: FORMS2.COD
3: // Description: This module produces dBASE IV .PRG files
4: // in lieu of FORM.COD's .FMT files
5:
6: Format (.fmt) File Template
7: ---------------------------
8: Version 1.0
9: Ashton-Tate (c) 1987, 1988 as modifed by S. Zeidler
10:
11: {
12: include "form.def"; // Form selectors



Listing 5


28: var fmt_name, // Format file name
29: crlf, // line feed
30: carry_flg, // Flag to test carry loop
31: carry_cnt, // Count of the fields to carry
32: carry_len, // Length of carry line until 75 characters
33: carry_lent, // Total cumulative length of carry line
34: carry_first,// Flag to test "," output for carry fields
35: color_flg, // Flag if color should stay on line
36: line_cnt, // Count for total lines processed
37: page_cnt, // Count for total pages processed
38: temp, // temporary work variable
39: cnt, // Foreach loop variable
40: wnd_cnt, // Window counter
41: wnd_names, // Window names to clear at bottom of file
42: default_drv,// dBASE default drive
43: dB_status, // dBASE status before entering designer
44: scrn_size, // Screen size when generation starts
45: display, // Type of display screen we are on
46: color, // Color returned from getcolor function
47: fcstemp; // extra var with my company prefix



Listing 6


69: //-------------------------------
70: // Create Format file
71: //-------------------------------
72: default_drv = strset(_defdrive); // grab default drive
73:
74: fmt_name = frame_path + name;
75: if not FILEOK(fmt_name) then
76: if !default_drv then
77: fmt_name = name;
78: else
79: fmt_name = default_drv + ":" + NAME;
80: endif
81: endif
82: fmt_name = upper(fmt_name);
83: // if not create(fmt_name+".FMT") then
84: // pause(fileroot(fmt_name) +".FMT" + read_only + any_key);
85: // goto nogen;
86: // endif
87: if not create(fmt_name+".prg") then
88: pause(fileroot(fmt_name) +".prg" + read_only + any_key);
89: goto nogen;
90: endif



Listing 7


100: {print(replicate("*",80)+crlf);}
101: //*-- Name....: {filename(fmt_name)}FMT
102: *-- Name....: {filename(fmt_name)}PRG
103: *-- Date....: {ltrim(SUBSTR(date(),1,8))}
104: *-- Version.: dBASE IV, Format {Frame_ver}.0
*-- Author..: Steve Zeidler
*-- Notice..: Copyright, 1990.
105: *-- Notes...: Format files use "" as delimiters!
106: {print(replicate("*",80)+crlf);}



Listing 8


109: //*-- Format file initialization code
----------------------------------- ---------
110: //
111: //IF SET("TALK")="ON"
112: // SET TALK OFF
113: // lc_talk="ON"
114: //ELSE
115: // lc_talk="OFF"
116: //ENDIF
117: //{ case display of
118: // mono: temp="MONO";
119: // cga: temp="COLOR";
120: // ega25: temp="EGA25";
121: // mono43: temp="MONO43";
122: // ega43: temp="EGA43";
123: // endcase
124: //}
125: //
126: //*-- This form was created in {temp} mode
127: //SET DISPLAY TO {temp}
128: //{ temp="";}
129: //
130: //lc_status=SET("STATUS")
131: //*-- SET STATUS was \
132: //{if dB_status then}
133: //ON when you went into the Forms Designer.
134: //IF lc_status = "OFF"
135: // SET STATUS ON
136: //{else}
137: //OFF when you went into the Forms Designer.
138: //IF lc_status = "ON"
139: // SET STATUS OFF
140: //{endif}
141: //ENDIF
142:
//----------------------------------------------------



Listing 9


196: *-- @ SAY GETS Processing.
-----------------------------------------------------
197:
198: *-- Format Page: {page_cnt}
199:
200: {foreach fld_element k
201: if FLD_FIELDTYPE == dbf then
202: print ("PRIVATE m"+fld_fieldname+crlf)
203: endif
204: if FLD_FIELDTYPE == memvar then
205: print ("PRIVATE "+fld_fieldname+crlf)
206: endif
207: next k;
208: print(crlf) }
209: {print(replicate("*",80)+crlf);}



Listing 10


211: *-- USE following declarations for editing a record-----
212:
213: {foreach fld_element k
214: if FLD_FIELDTYPE == dbf then
215: fcstemp="m"+FLD_FIELDNAME+" = " + FLD_FILENAME+'->'+FLD_FIELDNAME;
216: endif
217:



Listing 11


218: if FLD_FIELDTYPE == memvar then
219: fcstemp= FLD_FIELDNAME+" = ";
220:
221: case FLD_VALUE_TYPE of
222: fcschar : fcstemp = fcstemp + "space("+len(FLD_TEMPLATE)+")";
223: fcsdate : fcstemp=fcstemp+ "{}";
224: fcsfloat : fcstemp=fcstemp+ "0" ;
225: fcslogical : fcstemp=fcstemp+ ".f." ;
226: fcsnum : fcstemp=fcstemp+ "0";
227: endcase
228:
229: endif
230: print (fcstemp+crlf);
231: next k; }
232: {print(replicate("*",80)+crlf);}
233:



Listing 12


235: *-- USE following declarations for appending a record----
236:
237: {foreach fld_element k
238: if FLD_FIELDTYPE==dbf then
239: fcstemp="m"+fld_fieldname+" = " ;
240: case FLD_VALUE_TYPE of
241: fcschar : fcstemp=fcstemp+ "space("+FLD_LENGTH+")";
242: fcsdate : fcstemp=fcstemp+ "{}";
243: fcsfloat : fcstemp=fcstemp+ "0" ;
244: fcslogical : fcstemp=fcstemp+ ".f." ;
245: fcsnum : fcstemp=fcstemp+ "0";
246: endcase
247: endif
248:
249: if FLD_FIELDTYPE==memvar then
250: fcstemp=fld_fieldname+" = ";
251: case FLD_VALUE_TYPE of
252: fcschar : fcstemp=fcstemp+ "space("+len(FLD_TEMPLATE)+")";
253: fcsdate : fcstemp=fcstemp+ "{}";
254: fcsfloat : fcstemp=fcstemp+ "0" ;
255: fcslogical : fcstemp=fcstemp+ ".f." ;
256: fcsnum : fcstemp=fcstemp+ "0";
257: endcase
258: endif
259:
260: print (fcstemp+crlf);
261: next k; }
262: {print(replicate("*",80)+crlf);}




Listing 13


559: { define fil_rep()}
560: *---- Replace all fields (remember to append blanks if needed)-----
561:
562: {
563: VAR lstfile;
564: lstfile="";
565: foreach Fld_element k
566: if FLD_FIELDTYPE == dbf then
567: if lstfile != FLD_FILENAME then
568: print(crlf+"SELECT"+FLD_FILENAME+crlf)
569: print("* APPEND BLANK"+crlf)
570: endif
571: print("REPLACE "+FLD_FIELDNAME+" WITH m"+FLD_FIELDNAME+crlf)
572: lstfile=FLD_FILENAME;
573: endif
574: next k;
575: print(replicate("*",80)+crlf);
576:
577: return;
578: enddef;
579: }


Listing 14


408: //*-- SET STATUS was \
409: //{if dB_status then}
410: //ON when you went into the Forms Designer.
411: //IF lc_status = "OFF" && Entered form with status off
412: // SET STATUS OFF && Turn STATUS "OFF" on the way out
413: //{else}
414: //OFF when you went into the Forms Designer.
415: //IF lc_status = "ON" && Entered form with status on
416: // SET STATUS ON && Turn STATUS "ON" on the way out
417: //{endif}
418: //ENDIF



Listing 15


430: //IF lc_talk="ON"
431: // SET TALK ON
432: //ENDIF
433: //RELEASE {if carry_flg
then}lc_carry,{endif}lc_talk,lc_fields,lc_status
434: {if carry_flg then
435: print("RELEASE lc_carry")
436: endif }
437:
438: *-- EOP: {filename(fmt_name)}PRG
439: {if cnt == 0 then
440: pause(form_empty + any_key);
441: endif;
442: // fileerase(fmt_name+".FMO");
443: nogen:
444: return 0;




NO MORE LISTINGS!!!


  3 Responses to “Category : Files from Magazines
Archive   : DBMS0790.ZIP
Filename : ZIEDLER.JUL

  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/