TopWare 18: Liquid/Image.iso/liquid/top1143/gepackt.exe/BSPQTSW.EXE/MINIDB.PAS

Pascal/Delphi Source File | 1993-06-28 | 9.7 KB | 399 lines

(***************************************
* WG-VISION 1.0   BEISPIELPROGRAMM     *
****************************************
*                                      *
* Mini-Adressdatenbank zur Demons-     *
* tration von Eingabemasken aus        *
* TInputLine-Objekten                  *
*                                      *
****************************************
* (c) 1993 Dipl.Phys. Mathias Scholz   *
***************************************)

{$I COMPILER.INC}

program Mini_Adressdatenbank;

uses WApp,
     WEvent,
     WDecl,
     WViews,
     WDriver,
     WDlg,
     WFileDlg,
     WUtils,
     WText,
     Dos,
     Graph;


const cmOpen      = 101;
      cmSave      = 102;
      cmErfassen  = 201;
      cmBlaettern = 202;
      cmBrowse    = 203;

      cmLeft      = 90;   {zum Blättern innerhalb des Anzeige-Fenster}
      cmRight     = 91;
      cmSaveData  = 92;

      msgDraw     = 100;

type TApplication=object(TApp)
       FName : PathStr;
       procedure InitMenuBar; virtual;
       procedure SetDialogData; virtual;
       procedure HandleEvent; virtual;
       procedure LoadFile;
       procedure NewFile;
       procedure BrowseWindow;
       procedure Erfassen(Mode:boolean);
     end;

     PNewScroller=^TNewScroller;

     PScrollWindow=^TScrollWindow;
     TScrollWindow=object(TWindow)
       Scroller:PNewScroller;
       procedure InitWindowScroller; virtual;
       procedure HandleEvent; virtual;
       destructor Done; virtual;
     end;

     TNewScroller=object(TScroller)
       procedure CreateData;
       procedure ScrollDraw; virtual;
     end;

     PErfassen=^TErfassen;
     TErfassen=object(TDlgWindow)
      PosIndex:word;
      constructor Init(DInput:boolean);
      destructor Done; virtual;
      procedure DeleteDataRecord;
      procedure HandleEvent; virtual;
     end;

{Datenrecord für Datei}

     tAdressData   =record
                      Firma    : string[40];
                      PLZ      : string[5];
                      Ort      : string[25];
                      Strasse  : string[30];
                      Telefon  : string[15]
                    end;

{Dialog-Record}

     tAdressDataRec=record
                      Schalter : string[9];
                      Adr      : tAdressData;
                    end;


var MyApp      : TApplication;
    AdressData : tAdressDataRec;      {Dialogrecord}
    Adresse    : tAdressData;         {Adressen-Record}
    dat        : file of tAdressData; {Datenbank-Datei}


{Implementation TApplication}

procedure TApplication.InitMenuBar;
begin
  MainMenu('~D~atei',0);
   SubMenu('~A~dressen laden',cmOpen,0,0,false,false);
   SubMenu('~N~eue Adreßdatei',cmSave,0,0,false,false);
   NewLine;
   SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  MainMenu('~B~earbeiten',0);
   SubMenu('~A~dressen Erfassen',cmErfassen,0,0,true,false);
   SubMenu('~B~lättern',cmBlaettern,0,0,true,false);
   SubMenu('B~r~owse',cmBrowse,0,0,true,false);
end;

procedure TApplication.SetDialogData;
begin
  with AdressData do
   begin
     Schalter:='TTTLLLLLS';
     FillChar(Adr.Firma,SizeOf(Adr.Firma),' ');
     FillChar(Adr.PLZ,SizeOf(Adr.PLZ),' ');
     FillChar(Adr.Ort,SizeOf(Adr.Ort),' ');
     FillChar(Adr.Strasse,SizeOf(Adr.Strasse),' ');
     FillChar(Adr.Telefon,SizeOf(Adr.Telefon),' ');
   end;
end;

procedure TApplication.HandleEvent;
var I:integer;
begin
  Heap^.ShowHeapStatus(523,8,White);
  TProgram.HandleEvent;
  case Event.Command of
   cmOpen      : LoadFile;
   cmSave      : NewFile;
   cmErfassen  : Erfassen(true);
   cmBlaettern : Erfassen(false);
   cmBrowse    : BrowseWindow;
  end; {case}
  if Event.Message=msgLoadFile then
   begin
     FName:=Event.InfoString;
     for I:=1 to 3 do MMenu[2]^.SbMenu[I]^.DeAktiviere;
     ClearMessage;
   end;
  if Event.Message=msgSaveFile then
   begin
     if Pos('.',Event.InfoString)=0 then FName:=Event.InfoString+'.DBS'
      else FName:=Event.InfoString;
     MMenu[2]^.SbMenu[1]^.DeAktiviere;
     ClearMessage;
   end;
  if WinAnz<>0 then
   begin
     MMenu[1]^.SbMenu[1]^.Aktiviere;
     MMenu[1]^.SbMenu[2]^.Aktiviere;
   end
   else
   begin
     MMenu[1]^.SbMenu[1]^.DeAktiviere;
     MMenu[1]^.SbMenu[2]^.DeAktiviere;
   end;
end;

procedure TApplication.LoadFile;
var Window:PInputDialog;
begin
  Window:=New(PInputDialog, Init('Dateiauswahl','*.DBS'));
  InsertDesktop(Window);
end;

procedure TApplication.NewFile;
var Window:POutputDialog;
begin
  Window:=New(POutputDialog, Init('Neue Adreß-Datei'));
  InsertDesktop(Window);
end;

procedure TApplication.BrowseWindow;
var R:TRect;
    Window:PScrollWindow;
begin
  R.Assign(20,60,616,446);
  Window:=New(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu+winKey));
  InsertDesktop(Window);
end;

procedure TApplication.Erfassen(Mode:boolean);
var Window:PErfassen;
    I:integer;
begin
  Window:=New(PErfassen, Init(Mode));
  InsertDesktop(Window);
  for I:=1 to 3 do MMenu[2]^.SbMenu[I]^.DeAktiviere;
end;

{Implementation TScrollWindow}

procedure TScrollWindow.InitWindowScroller;
var R:TRect;
    SBH1,SBV1:PScrollBar;
begin
  R:=Frame^.Area;
  SBH1:=New(PScrollBar, Init(R,HorizDir));
  SBV1:=New(PScrollBar, Init(R,VertDir));
  Scroller:=New(PNewScroller, Init(R,SBH1,SBV1));
  Scroller^.CreateData;
  List^.InsertItem(Scroller);
end;

procedure TScrollWindow.HandleEvent;
begin
  TWindow.HandleEvent;
  if Event.Message=msgDraw then
   begin
     with Scroller^ do
      begin
        CreateData;
        Draw;
      end;
     ClearMessage;
   end;
end;

destructor TScrollWindow.Done;
begin
  TWindow.Done;
  Dispose(Scroller, Done);
end;

{Implementation TNewScroller}

procedure TNewScroller.CreateData;
var LfdPtr:PLine;
begin
  SetFont(Wndw19);
  if Liste<>nil then Liste^.DeleteItems;
  Assign(dat,MyApp.FName);
  Reset(dat);
  while not Eof(dat) do
   begin
     LfdPtr:=New(PLine, Init);
     Read(dat,Adresse);
     with Adresse do
      LfdPtr^.Eintrag:=Firma+' │ '+PLZ+' │ '+Ort+' │ '+Strasse;
     Liste^.InsertItem(LfdPtr);
   end;
  SetLimit(25,Liste^.AnzElem,8,16);
  Close(dat);
end;

procedure TNewScroller.ScrollDraw;
var I:integer;
    LfdPtr:PGroup;

function Clip(P,N:byte;z:string):string;
begin
  Clip:=Copy(z,P,N);
end;

{------}

begin
  SetFontColor(White,Blue);
  Mouse.HideMouse;
  with Border do
   begin
     SetFillStyle(SolidFill,GetPalColor(1));
     SetColor(GetPalColor(2));
     for I:=Delta.Y to WDelta.Y do
      begin
        LfdPtr:=Liste^.GetItems(I);
        Bar(A.X,A.Y+(I-Delta.Y)*Py+10,B.X,A.Y+(I-Delta.Y)*Py+10+Py);
        WriteText(A.X+20,A.Y+(I-Delta.Y)*Py+10,Clip(Delta.X,
                  Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
      end;
     if VertiScrollBar<>nil then
      for I:=(WDelta.Y-Delta.Y)+1 to Zeilen do
       Bar(A.X,A.Y+I*Py+10,B.X,A.Y+I*Py+10+Py);
   end;
  Mouse.ShowMouse;
end;

{Implementation Erfassen}

constructor TErfassen.Init(DInput:boolean);
var RR:TRect;
begin
  PosIndex:=0;
  RR.Assign(60,80,440,350);
  Assign(dat,MyApp.FName);
  {$I-}
  Reset(dat);
  {$I+}
  if IOResult=0 then            {Existiert Datei ?}
   begin
     if not DInput then
      begin
        Read(dat,Adresse);
        AdressData.Adr:=Adresse;
        SetData(AdressData);
      end
      else
      begin
        DeleteDataRecord;
        Seek(dat,FileSize(dat));
      end;
   end
   else Rewrite(dat);
  TDlgWindow.Init(RR,'Erfassen von Adressen',winDouble+winPanel);
  SetPushButton(134,225,100,22,'OK',cmCloseWindow);
  SetPushButton(260,225,40,22,'<<',cmLeft);
   if DInput then SetDisabled;
  SetPushButton(310,225,40,22,'>>',cmRight);
   if DInput then SetDisabled;
  SetInputLine(140,90,25,'~F~irma    :',40,ASCII);
   if not DInput then SetDisabled;
  SetInputLine(140,115,5,'~P~LZ      :',5,ZIFFERN);
   if not DInput then SetDisabled;
  SetInputLine(140,140,20,'~O~rt      :',25,ASCII);
   if not DInput then SetDisabled;
  SetInputLine(140,165,20,'~S~traße   :',30,ASCII);
   if not DInput then SetDisabled;
  SetInputLine(140,190,15,'~T~elefon  :',15,ZIFFERN);
   if not DInput then SetDisabled;
   if DInput then SetStaticText(40,35,'Adressenerfassung',LeftText)
    else SetStaticText(40,35,'Blättern in der Datei',LeftText);
   SetTextParameters(TriplexFont,HorizDir,2);
   ChangePalColor(10,Red);
  SetData(AdressData);
end;

destructor TErfassen.Done;
begin
  Close(dat);
  TDlgWindow.Done;
end;

procedure TErfassen.DeleteDataRecord;
begin
  with AdressData do
   begin
     FillChar(Adr.Firma,SizeOf(Adr.Firma),' ');
     FillChar(Adr.PLZ,SizeOf(Adr.PLZ),' ');
     FillChar(Adr.Ort,SizeOf(Adr.Ort),' ');
     FillChar(Adr.Strasse,SizeOf(Adr.Strasse),' ');
     FillChar(Adr.Telefon,SizeOf(Adr.Telefon),' ');
   end;
  SetData(AdressData);
end;

procedure TErfassen.HandleEvent;

procedure ReadDataRecord;
begin
  Seek(dat,PosIndex);
  Read(dat,Adresse);
  AdressData.Adr:=Adresse;
  SetData(AdressData);
  DrawMask;
  Event.Command:=cmNothing;
end;

{------}

begin
  TDlgWindow.HandleEvent;
  if Event.Message=msgNewMask then
   begin
     Adresse:=AdressData.Adr;
     Write(dat,Adresse);
     DeleteDataRecord;
     DrawMask;
     Event.Message:=msgDraw;    {Mitteilung an das Browse-Fenster}
   end;
  if Event.Command=cmRight then
   if FilePos(dat)<FileSize(dat) then
    begin
      Inc(PosIndex);
      ReadDataRecord;
    end;
  if Event.Command=cmLeft then
   if PosIndex>0 then
    begin
      Dec(PosIndex);
      ReadDataRecord;
    end;
end;

{Hauptprogramm}

begin
  MyApp.Init('Adressen-Datenbank');
  MyApp.Run;
  MyApp.Done;
end.