program GSDMOTV2;
{------------------------------------------------------------------------------
DBase File Display
TurboVision Sample 2
Copyright (c) Richard F. Griffin
28 January 1993
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This program demonstrates that the basic Griffin Solutions
routines will work in a TurboVision environment.
This demo provides a file viewer using TurboVision methods.
One unit, GSV_FLDS.PAS is also used for improved inputline
support.
Memory is at a premium in the IDE using TurboVision. If you
get heap overflow errors or 'strange' things happen, if probably
means there is not enough memory to run in the IDE. To regain
memory, you can compile to disk instead of memory. Use the
MemAvail value in the Watch window to see how much memory is
available.
-------------------------------------------------------------------------------}
uses DOS,
Objects, Drivers, Views, Menus, Dialogs, StdDlg, App, Memory,
GSOBShel, GSV_Flds;
const
cmFileOpen = 100;
cmVideoMode = 101;
cmNextRec = 102;
cmPrevRec = 103;
cmPageUp = 104;
cmPageDn = 105;
hcFileOpen = 2;
hcDataField = 901;
type
PdBDialog = ^TdBDialog;
TdBDialog = object(TDialog)
FldColl : PCollection;
FldsInFile: integer;
FldsOnScrn: integer;
FirstField: integer;
FirstItem : PView;
dbCheck : PCheckBoxes;
CBox : word;
dbStatic : PStaticText;
dbCancel : PButton;
procedure HandleEvent(var Event: TEvent); virtual;
procedure ShowDialog(ClrInp : boolean);
procedure SaveDialog(C : Word; ClrInp : boolean);
end;
TMyApp = object(TApplication)
Dialog : PdBDialog;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure FileOpen;
procedure NewDialog;
end;
var
NewMode : word;
MyApp: TMyApp;
procedure TdBDialog.HandleEvent(var Event: TEvent);
var
Chg : boolean;
Rfrsh : boolean;
MLine : TPoint;
Q,
R : TRect;
L : integer;
W : word;
P : Pointer;
begin
if Event.What = evKeyDown then
begin
case Event.KeyCode of
kbPgUp,
kbPgDn : begin
if Event.KeyCode = kbPgUp then W := cmPageUp
else W := cmPageDn;
ClearEvent(Event);
P := Message(Owner,evCommand,W,@Self);
exit;
end;
kbAltE : begin end;
kbEnter : if Current^.HelpCtx = hcDataField then
Event.KeyCode := kbTab;
kbDown : Event.KeyCode := kbTab;
kbUp : Event.KeyCode := kbShiftTab;
else begin
TDialog.HandleEvent(Event);
exit;
end;
end;
if Current^.Valid(1) then TDialog.HandleEvent(Event)
else
ClearEvent(Event);
exit;
end;
if Event.What = evMouseDown then
begin
dbCancel^.GetBounds(Q);
Current^.GetBounds(R);
MakeLocal(Event.Where,MLine);
Chg := R.Contains(MLine);
if not Chg then Chg := Q.Contains(MLine);
if not Chg then Chg := (MLine.X = 3) and (Mline.Y = 0);
if Chg then TDialog.HandleEvent(Event)
else
if Current^.Valid(1) then TDialog.HandleEvent(Event)
else
ClearEvent(Event);
exit;
end;
if Event.What = evCommand then
begin
case Event.Command of
cmPageUp,
cmPageDn : begin
Chg := true;
if (Current^.HelpCtx = hcDataField) then
Chg := Current^.Valid(1);
if Chg then
begin
L := FirstField;
if Event.Command = cmPageUp then
FirstField := FirstField-(FldsOnScrn-1)
else
FirstField := FirstField+(FldsOnScrn-1);
if FirstField < 1 then FirstField := 1
else
if FirstField > FldsInFile-(FldsOnScrn-1) then
FirstField := FldsInFile-(FldsOnScrn-1);
if FirstField <> L then
begin
SaveDialog(0,true);
ShowDialog(true);
end;
FirstItem^.Select;
end;
ClearEvent(Event);
exit;
end;
cmNextRec,
cmPrevRec : begin
Chg := true;
if (Current^.HelpCtx = hcDataField) then
Chg := Current^.Valid(1);
if Chg then
begin
Rfrsh := FirstField <> 1;
FirstField := 1;
SaveDialog(1,Rfrsh);
if Event.Command = cmNextRec then
Skip(1)
else Skip(-1);
ShowDialog(Rfrsh);
FirstItem^.Select;
end;
ClearEvent(Event);
exit;
end;
end;
end;
TDialog.HandleEvent(Event)
end;
{ TMyApp }
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmFileOpen : FileOpen;
cmVideoMode:
begin
NewMode := ScreenMode xor smFont8x8;
if NewMode and smFont8x8 <> 0 then
ShadowSize.X := 1
else ShadowSize.X := 2;
SetScreenMode(NewMode);
end;
else
Exit;
end;
ClearEvent(Event);
end;
end;
procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~F~ile', hcNoContext, NewMenu(
NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
NewLine(
NewItem('~V~ideo mode','', kbNoKey, cmVideoMode, hcNoContext,
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))),
nil)
)));
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
nil)),
nil)
));
end;
procedure TMyApp.FileOpen;
var
Dg: PFileDialog;
FileName: PathStr;
D: DirStr;
N: NameStr;
E: ExtStr;
begin
Dg := New(PFileDialog, Init('*.DBF', 'Open a File',
'~N~ame', fdOpenButton + fdHelpButton, 100));
Dg^.HelpCtx := hcFileOpen;
if ValidView(Dg) <> nil then
begin
if Desktop^.ExecView(Dg) <> cmCancel then
begin
Dg^.GetFileName(FileName);
FSplit(FExpand(FileName), D, N, E);
GSOBShel.Select(1);
Use(D+N);
NewDialog;
CloseDataBAses;
end;
Dispose(Dg, Done);
end;
end;
procedure TMyApp.NewDialog;
var
dBInput: PdBInputLine;
R: TRect;
C: Word;
Pgd: boolean;
begin
GoTop;
GetExtent(R);
dec(R.B.Y,2);
Dialog := New(PdBDialog, Init(R, Alias));
with Dialog^ do
begin
FldColl := nil;
FirstField := 1;
FldsOnScrn := Size.Y-5;
FldsInFile := FieldCount;
Pgd := FldsOnScrn < FldsInFile;
if FldsOnScrn > FldsInFile then
FldsOnScrn := FldsInFile;
R.Assign(3, Size.Y-2, 18, Size.Y-1);
dBCheck := New(PCheckBoxes, Init(R,
NewSItem('D~e~leted',
nil)
));
R.Assign(40, Size.Y-2, 65, Size.Y-1);
dBStatic := New(PStaticText, Init(R,'Record'));
Insert(dbStatic);
ShowDialog(true);
Insert(dbCheck);
R.Assign(68, 2, 78, 4);
Insert(New(PButton, Init(R, '~F~inish', cmOK, bfNormal)));
R.Assign(68, 5, 78, 7);
dbCancel := New(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
Insert(dbCancel);
if Pgd then
begin
R.Assign(68, 8, 78, 10);
Insert(New(PButton, Init(R, 'Pg~U~p', cmPageUp, bfNormal)));
R.Assign(68, 11, 78, 13);
Insert(New(PButton, Init(R, 'Pg~D~n', cmPageDn, bfNormal)));
end;
R.Assign(68, 14, 78, 16);
Insert(New(PButton, Init(R, '~P~rev', cmPrevRec, bfNormal)));
R.Assign(68, 17, 78, 19);
Insert(New(PButton, Init(R, '~N~ext', cmNextRec, bfNormal)));
dBInput := FldColl^.At(0);
dBInput^.Select;
end;
C := DeskTop^.ExecView(Dialog);
Dialog^.SaveDialog(C,true);
Dispose(Dialog^.FldColl, Done);
Dispose(Dialog, Done);
end;
procedure TdBDialog.ShowDialog(ClrInp : boolean);
var
dBInput: PdBInputLine;
R: TRect;
I,
X,
Y : Integer;
S : string;
S1,S2 : string[8];
DFlg : word;
begin
Y := 1;
if FldColl = nil then
begin
ClrInp := true;
New(FldColl, Init(FieldCount,4));
for i := FirstField to FldsInFile do
begin
X := FieldLen(i);
if X+27 > Size.X then X := Size.X-27;
R.Assign(13, Y, 15+X,Y+1);
case FieldType(i) of
'F',
'N' : dBInput := New(PdBNumInputLine, Init(R, FieldLen(i)));
else dBInput := New(PdBInputLine, Init(R, FieldLen(i)));
end;
dbInput^.HelpCtx := hcDataField;
FldColl^.Insert(dBInput);
R.Assign(1,Y,12,Y+1);
dbInput^.FldLabel := New(PLabel, Init(R, Field(i), dBInput));
inc(y);
end;
end;
Y := 1;
for i := FirstField to FldsOnScrn+FirstField-1 do
begin
S := StringGetN(i);
dBInput := FldColl^.At(i-1);
if i = FirstField then FirstItem := dBInput;
dBInput^.SetData(S);
if ClrInp then
begin
dbInput^.GetBounds(R);
R.Assign(R.A.X,Y,R.B.X,Y+1);
dbInput^.SetBounds(R);
Insert(dBInput);
dbInput^.FldLabel^.GetBounds(R);
R.Assign(R.A.X,Y,R.B.X,Y+1);
dbInput^.FldLabel^.SetBounds(R);
insert(dbInput^.FldLabel);
end;
dBInput^.IsActive := true;
inc(Y);
end;
if Deleted then CBox := 1 else CBox := 0;
dBCheck^.SetData(CBox);
if dbStatic^.Text <> nil then DisposeStr(dbStatic^.Text);
Str(RecNo,S1);
Str(RecCount,S2);
S := 'Record '+S1+' of '+S2;
dbStatic^.Text := NewStr(S);
if Current^.HelpCtx = hcDataField then
PInputLine(Current)^.SelectAll(True);
ReDraw;
end;
procedure TdBDialog.SaveDialog(C : Word; ClrInp : boolean);
var
dBInput: PdBInputLine;
I : integer;
Chg : boolean;
S : string;
DFlg : word;
begin
Chg := false;
for i := 0 to FldColl^.Count-1 do
begin
dBInput := FldColl^.At(i);
if C <> cmCancel then
begin
if dBInput^.Changed then
begin
Chg := true;
dBInput^.GetData(S);
StringPutN(i+1,S);
end;
end;
if dBInput^.IsActive then
begin
if ClrInp then
begin
Delete(dBInput);
delete(dbInput^.FldLabel);
end;
dBInput^.IsActive := false;
end;
end;
if C <> cmCancel then
begin
dFLg := dBCheck^.Value;
if DFlg <> CBox then
begin
if DFlg = 0 then RecallRec else DeleteRec;
Chg := false;
end;
end;
if Chg then Replace;
end;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
