home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
PULL70.ZIP
/
PULLSHEL.ZIP
/
PULLDATA.PAS
next >
Wrap
Pascal/Delphi Source File
|
1993-06-21
|
11KB
|
321 lines
{ ========================================================================== }
{ PullData.pas - User Statistics for data-entry windows. ver 7.0, 06-21-93 }
{ }
{ This file contains all the data to configure the data-entry fields in }
{ data windows or work windows. }
{ Copyright (c) 1988,1993 James H. LeMay, All rights reserved. }
{ ========================================================================== }
{$i pulldefs.inc }
{$define UseMsgLineCode }
UNIT PullData;
INTERFACE
uses
Crt,Qwik,Wndw,Pull,PullStat;
{ ================ Set up variables for data windows here: ================= }
{ Place your variables names here to interface with the menus. }
{ Careful! -- there's NO type checking for parameters in Transfer. You MUST }
{ be certain case statement, DataWndw, and TypeOfData all match. Be }
{ especially careful of string lengths that are too long. They can be no }
{ longer than DataStrSize. }
{ -------------------------------------------------------------------------- }
const
aByte: byte = 100;
aInteger: integer = 200;
type
{ Work window data entry names. }
DataEntryNames = (NoDE,aIntegerDE);
var
DataEntryOattr, { Output attribute }
DataEntryIattr, { Input attribute }
DataWndwIattr, { Input attribute }
DataWndwOattr, { Output attribute }
DataWndwBattr: byte; { Border attribute }
DataWndwBrdr: Borders;
IMPLEMENTATION
uses
WUtil,
{$ifdef UseStrg }
Strg;
{$else }
Strs;
{$endif }
{ ================ Set up your Error Message Lines here: =================== }
{ Error Messages are used for indicating that data entry was invalid or out }
{ of range. ErrMsgLine[1] is reserved for custom error messages that you }
{ can create at runtime. Messages up to InvalidEM are reserved and must }
{ match those in PULL.PAS. }
{ -------------------------------------------------------------------------- }
type
ErrMsgNames = (NoEM,UserEM,InvalidEM,MyEM);
{$ifdef UseMsgLineCode }
procedure GetErrMsgs;
begin
AutoNumLock := false; { If true, turns on NumLock on with data entry }
CapsLockCol := 41; { First column for ' CAPS NUM SCROLL ' on MsgLine. }
ErrMsgLine[ord(InvalidEM)]:=' Invalid entry. ESC-acknowledge';
ErrMsgLine[ord(MyEM)] :=' This indicates an error. ESC-acknowledge';
end;
{$endif UseMsgLineCode }
procedure MakeErrMsg (Low,High: longint);
begin
{$ifdef UseMsgLineCode }
DataPad.ErrMsg := ord(UserEM);
ErrMsgLine[ord(UserEM)] :=
'Range: '+StrL(Low)+' to '+StrL(High)+'. Press ESC';
{$endif }
end;
{ ====================== Data Entry Range Checking ========================= }
{ These procedures are completely defined by the user. They may not even be }
{ necessary if the string entered is satisfactory as a valid number. The }
{ calls must be forced to FAR because they are called indirectly. }
{ "Translate" can alter each key from the keyboard before it gets evaluated. }
{ "Verify" will check the range or even completely alter the entire string. }
{ -------------------------------------------------------------------------- }
{ -------------------- Data Window Data Entry Checking --------------------- }
procedure CheckAbyte; far;
begin
with DataPad do
if ((Bdata<20) or (Bdata>50)) then
MakeErrMsg (20,50);
end;
{ -------------------- Work Window Data Entry Checking --------------------- }
procedure TranslateCase; far;
begin
if not ExtKey then
Key := upcase(Key); { Simple upper case translation }
end;
procedure VerifyAinteger; far;
begin
with DataPad do
if ((Idata=0) or (Idata>200)) then
MakeErrMsg (1,200);
end;
{ ======================== GetUserDataEntry ================================ }
{ The major configurations for all menus go here. The program first clears }
{ all RECORD values to $00. The values below will set new values. Therefore,}
{ setting RECORD values to "false", nil, or the like is not necessary. }
{ -------------------------------------------------------------------------- }
{ Code saving utilities: }
procedure GetDataWndw (Index: word);
begin
DWI := Index;
TopDataWndw := DataWndw^[DWI];
end;
procedure SaveDataWndw;
begin
DataWndw^[DWI] := TopDataWndw;
end;
procedure GetDataEntry (Index: word);
begin
DEI := Index;
TopEntry := DataEntry^[DEI];
end;
procedure SaveDataEntry;
begin
DataEntry^[DEI] := TopEntry;
end;
procedure GetDataEntryStats;
begin
{ ------------- Set up your PULL-DOWN Data Windows here: ----------------- }
{ Justification will default with numbers right justified and string to }
{ the left if none is specified. }
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (ord(aByteDW)); { Just gets cleared TopDataWndw }
VarAddr := @aByte;
{ TypeOfData := Bytes; } { This is the default }
Field := 3;
{ JustifyOutput := Right; } { This is the default }
{ MsgLineNum := ord(DE_ML); } { This is the default }
{ HelpWndwNum := ord(DataWndwHW); } { This is the default }
SaveDataWndw; { Saves it in the heap }
end; { with }
{ ------------------------ Work Window Data Entry ------------------------ }
AutoTab := true; { After entry, tabs to next one in sequence }
with DataPad do
if QvideoMode=Mono then
Hattr := LightGrayBG
else Hattr := White+CyanBG; { Optional Attribute of Data Entry hilite }
{ Use SameAttr if not desired }
with TopEntry do
begin
GetDataEntry (ord(aIntegerDE));
VarAddr := @aInteger;
TypeOfData := Integers;
Row := 4;
Col := 11;
Field := 4;
MaxField := 3;
CheckRangeProc := VerifyAinteger;
{ MsgLineNum := ord(DE_ML); } { This is the default }
{ HelpWndwNum := ord(DataWndwHW); } { This is the default }
SaveDataEntry;
end;
end; { procedure GetDataEntryStats }
{ =================== Data Entry Initialization Code ======================= }
{ The following code initializes all of the stats for the data entry windows }
{ and the work window data entry fields. There is no need to edit this }
{ Except for the default colors in SetDefaultColors. }
{ -------------------------------------------------------------------------- }
procedure AllocateHeap;
begin
if HeapOK (sizeof(DataWndws)) then
GetMem (DataWndw,SizeOf(DataWndws));
FillB (DataWndw^,SizeOf(DataWndws),0);
if HeapOK (sizeof(DataEntries)) then
GetMem (DataEntry,SizeOf(DataEntries));
FillB (DataEntry^,SizeOf(DataEntries),0);
end;
procedure SetDefaultColors;
begin
{ ------------------ Set up your colors and borders here: ---------------- }
if QvideoMode=Mono then
begin
DataEntryIattr := LightGray; { Input attribute }
DataEntryOattr := White; { Output attribute }
DataWndwIattr := White; { Input attribute }
DataWndwOattr := LightGrayBG; { Output attribute }
end
else
begin
DataEntryIattr := Yellow+MagentaBG; { Input attribute }
DataEntryOattr := Black+LightGrayBG; { Output attribute }
DataWndwIattr := Black+BrownBG; { Input attribute }
DataWndwOattr := Yellow+BlackBG; { Output attribute }
end;
DataWndwBattr := Black+BrownBG; { Border attribute }
DataWndwBrdr := HdoubleBrdr;
end;
procedure InitDataColors;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Iattr := DataWndwIattr; { Input attribute }
Oattr := DataWndwOattr; { Output attribute }
Battr := DataWndwBattr; { Border attribute }
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
Iattr := DataEntryIattr; { Input attribute }
Oattr := DataEntryOattr; { Output attribute }
SaveDataEntry;
end;
end;
function GetJustify (Justify: DirType; TOD: TypeOfDataType): DirType;
begin
if Justify=NoDir then
begin
if TOD<=UserNums then
GetJustify := Right { for nums }
else GetJustify := Left; { for chars and strings }
end
else GetJustify:=Justify;
end;
function GetSetName (SN: SetNames; TOD: TypeOfDataType): SetNames;
begin
if SN=NoSet then
case TOD of
Bytes,Words: GetSetName := UnsignedSet;
ShortInts..LongInts: GetSetName := SignedSet;
Reals: GetSetName := RealSet;
else
GetSetName := CharSet;
end
else GetSetName:=SN;
end;
procedure InitDataDefaults;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Border := DataWndwBrdr;
SetName := GetSetName (SetName,TypeOfData);
Row := 1;
Col := 2;
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DW_ML);
if HelpWndwNum=0 then
HelpWndwNum := ord(DataWndwHW);
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
SetName := GetSetName (SetName,TypeOfData);
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DE_ML);
if HelpWndwNum=0 then
HelpWndwNum := ord(DataWndwHW);
SaveDataEntry;
end;
end;
BEGIN
AllocateHeap;
SetDefaultColors;
InitDataColors;
{$ifdef UseMsgLineCode }
GetErrMsgs;
{$endif }
GetDataEntryStats;
InitDataDefaults;
END.