Category : Pascal Source Code
Archive   : GSDB21.ZIP
Filename : GS_DBTBL.PAS

UNIT GS_DBTbl;

INTERFACE

USES
Crt,
Dos,
GS_Error,
GS_KeyI,
GS_dBase,
GS_Wind,
GS_Pick,
GS_Strng,
GS_DBFld;


type


dBTabl_Arry_Fld = array [0..MaxInt] of byte;
dBTabl_Pick_Obj = Object
dbas : ^GS_dBase_DB; {Object to refer to}
Pick_Win : GS_Wind_Objt; {Window object for menu}
Tabl : ^dBTabl_Arry_Fld; {Menu table on the heap}
Sz_Tab : longint; {Size of table}
siz : integer; {Size of a table entry}
recs : longint; {Number records in table}
Sel_Item : longint; {Last entry number selected}
Scn_Key : string; {Holds select key formula}
AddRecOk : boolean; {True allows appending}
AddRec : boolean; {True if append selected}

procedure Append_dbTabl(tf : boolean);
procedure Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
procedure Reset_dBTabl;
procedure Build_dBTabl(zfld : string);
function Choose_dBTabl : boolean;
function Pick_dBTabl(zfld : string) : boolean;
function Find_dBTabl(pcnd : string) : boolean;
function FindNext_dBTabl(pcnd : string) : boolean;
function Scan_dBTabl(pfld, pcnd, zfld : string)
: boolean;
end;


implementation


var
File_Win : GS_Wind_Objt;
ap : string[10];


procedure dBTabl_Pick_Obj.Append_dBTabl(tf : boolean);
begin
AddRecOK := tf;
AddRec := false;
Reset_dBTabl;
end;



procedure dBTabl_Pick_Obj.Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
begin
ap := '- APPEND -';
dBas := @Fil;
Tabl := nil;
Pick_Win.InitWin(x1,y1,x2,y2,tx,bg,tx,itx,ibg,true,stg,true);
Scn_Key := '^^^^';
Sel_Item := 1;
AddRecOK := false;
AddRec := false;
end;

procedure dBTabl_Pick_Obj.Reset_dBTabl;
begin
if Tabl <> nil then FreeMem(Tabl,Sz_Tab);
Tabl := nil;
Scn_Key := '^^^^';
Sel_Item := 1;
end;

procedure dBTabl_Pick_Obj.Build_dBTabl(zfld : string);
var
l : longint;
t : string[127];
ia : boolean;
begin
Reset_dBTabl;
zfld := AllCaps(zfld);
Scn_Key := zfld;
with dBas^ do
begin
ia := dbfNdxActv;
dbfNdxActv := false; {Temporarily turn off any index}
GetRec(Top_Record);
t := Formula(zfld);
l := 0;
recs := dBas^.NumRecs;
if AddRecOK then inc(recs);
siz := length(t) + 5;
Sz_Tab := recs * siz;
GetMem(Tabl,Sz_Tab);
while (not File_EOF) do
begin
t := Formula(zfld);
move(t,Tabl^[l*siz],siz-4);
move(RecNumber,Tabl^[(l*siz)+siz-4],4);
inc(l);
GetRec(Next_Record);
end;
dbfNdxActv := ia;
GetRec(Top_Record); {Puts DBF and NDX back in sync}
recs := l;
GS_Pick_Item_Sort(Tabl^,siz,recs);
end;
end;


function dBTabl_Pick_Obj.Choose_dBTabl : boolean;
var
i,
l : longint;
c1: char;
v : integer;
begin
AddRec := false;
if recs > 0 then
i := GS_Pick_Row_Item(Tabl^,siz,recs, Sel_Item)
else
begin
gotoxy((((lo(WindMax)-lo(WindMin))-4) div 2)+1,
((hi(WindMax)-hi(WindMin)) div 2)+1);
write('Empty');
repeat
c1 := GS_KeyI_GetKey;
until c1 in [#13,#27];
i := 0;
end;
if i > 0 then
begin
Choose_dBTabl := true;
if (AddREcOK) and (i = recs) then
AddRec := true
else
begin
move(Tabl^[((i-1)*siz)+siz-4],l,4);
dBas^.GetRec(l);
end;
Sel_Item := i;
end else Choose_dBTabl := false;
end;

function dBTabl_Pick_Obj.Pick_dBTabl(zfld : string) : boolean;
var
t : string[127];
v : integer;
ta : byte;
begin
Pick_Win.SetWin;
AddRec := false;
zfld := AllCaps(zfld);
if Scn_Key <> zfld then Reset_dBTabl;
Scn_Key := zfld;
if Tabl = nil then
begin
gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
((hi(WindMax)-hi(WindMin)) div 2)+1);
ta := TextAttr;
TextAttr := TextAttr + 128;
write('Working');
TextAttr := ta;
Build_dBTabl(zfld);
if AddRecOK then
begin
inc(recs);
v := siz-5;
FillChar(t[1],v,' ');
t[0] := chr(v);
Insert(ap,t,succ((v - 10) div 2));
System.Delete(t,v+1,10);
move(t,Tabl^[(recs-1)*siz],siz-4);
end;
end;
ClrScr;
Pick_dBTabl := Choose_dBTabl;
Pick_Win.RelWin;
end;

function dBTabl_Pick_Obj.Find_dBTabl(pcnd : string) : boolean;
var
i,
l : longint;
m,
s : string;
mtch : boolean;
begin
mtch := false;
m := AllCaps(pcnd);
if recs > 0 then
begin
i := 0;
repeat
move(Tabl^[i*siz],s,siz-4);
s[0] := m[0];
if (AllCaps(s) = m) then mtch := true;
inc(i);
until (i = recs) or (mtch);
if not mtch then i := 0;
end
else
begin
i := 0;
end;
if i > 0 then
begin
Find_dBTabl := true;
move(Tabl^[((i-1)*siz)+siz-4],l,4);
dBas^.GetRec(l);
Sel_Item := i;
end else Find_dBTabl := false;
end;

function dBTabl_Pick_Obj.FindNext_dBTabl(pcnd : string) : boolean;
var
i,
l : longint;
m,
s : string;
begin
m := AllCaps(pcnd);
if (recs > 0) and (Sel_Item < recs) then
begin
i := Sel_Item;
move(Tabl^[i*siz],s,siz-4);
s[0] := m[0];
inc(i);
if AllCaps(s) <> m then i := 0;
end
else
begin
i := 0;
end;
if i > 0 then
begin
FindNext_dBTabl := true;
move(Tabl^[((i-1)*siz)+siz-4],l,4);
dBas^.GetRec(l);
Sel_Item := i;
end else FindNext_dBTabl := false;
end;

function dBTabl_Pick_Obj.Scan_dBTabl(pfld, pcnd, zfld : string) : boolean;
var
m,
s : string;
t : string[127];
v : integer;
ta : byte;
ia : boolean;
l : longint;
begin
Pick_Win.SetWin;
AddRec := false;
zfld := AllCaps(zfld);
pfld := AllCaps(pfld);
Reset_dBTabl;
Scn_Key := zfld;
gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
((hi(WindMax)-hi(WindMin)) div 2)+1);
ta := TextAttr;
TextAttr := TextAttr + 128;
write('Working');
TextAttr := ta;
with dBas^ do
begin
ia := dbfNdxActv;
dbfNdxActv := false; {Temporarily turn off any index}
GetRec(Top_Record);
m := Formula(pfld);
if m[0] < pcnd[0] then pcnd[0] := m[0];
m := AllCaps(pcnd);
t := Formula(zfld);
l := 0;
recs := dBas^.NumRecs;
if AddRecOK then inc(recs);
siz := length(t) + 5;
Sz_Tab := recs * siz;
GetMem(Tabl,Sz_Tab);
while (not File_EOF) do
begin
s := Formula(pfld);
s[0] := m[0];
if AllCaps(s) = m then
begin
t := Formula(zfld);
move(t,Tabl^[l*siz],siz-4);
move(RecNumber,Tabl^[(l*siz)+siz-4],4);
inc(l)
end; ;
GetRec(Next_Record);
end;
dbfNdxActv := ia;
GetRec(Top_Record); {Puts DBF and NDX back in sync}
recs := l;
GS_Pick_Item_Sort(Tabl^,siz,recs);
end;
if AddRecOK then
begin
inc(recs);
v := siz-5;
FillChar(t[1],v,' ');
t[0] := chr(v);
Insert(ap,t,succ((v - 10) div 2));
System.Delete(t,v+1,10);
move(t,Tabl^[(recs-1)*siz],siz-4);
end;
ClrScr;

Scan_dBTabl := Choose_dBTabl;
Pick_Win.RelWin;
end;



end.