home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / WGBSP!.EXE / BSP22.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-05  |  5KB  |  196 lines
  1. program Beispiel22;
  2.  
  3. uses GDecl,
  4.      GDrivers,
  5.      GEvent,
  6.      GViews,
  7.      GDlg,
  8.      GApp,
  9.      Graph;
  10.  
  11.  
  12.  
  13. const cmErfassen  = 101;
  14.       cmBlaettern = 102;
  15.  
  16.       cmSaveData  = 21;
  17.       cmLeft      = 22;
  18.       cmRight     = 23;
  19.  
  20.  
  21. type TApplication=object(TApp)
  22.        procedure InitMenuBar; virtual;
  23.        procedure SetDialogData; virtual;
  24.        procedure HandleEvent; virtual;
  25.        procedure Erfassen(DInput:boolean);
  26.      end;
  27.  
  28.      PAdressWindow=^TAdressWindow;
  29.      TAdressWindow=object(TDlgWindow)
  30.        PosIndex:word;
  31.        constructor Init(var Bounds:TRect;ATitle:str80;AType:byte;DInput:boolean);
  32.        destructor Done; virtual;
  33.        procedure HandleEvent; virtual;
  34.      end;
  35.  
  36.      tAdressData=record
  37.                    Schalter : string[9];
  38.                    Firma    : string[40];
  39.                    Ort      : string[25];
  40.                    Strasse  : string[30];
  41.                    Telefon  : string[20];
  42.                  end;
  43.  
  44. var MyProg:TApplication;
  45.     Adresse:tAdressData;
  46.     Dat : file of tAdressData;
  47.  
  48. {Implementation TApplication}
  49.  
  50. procedure TApplication.InitMenuBar;
  51. begin
  52.   Palette[1]:=#14;
  53.   Palette[5]:=#14;
  54.   Palette[4]:=#4;
  55.   Palette[12]:=#4;
  56.   MainMenu('~F~enster',0);
  57.    SubMenu('~E~rfassen  F2',cmErfassen,0,kbF2,false,false);
  58.    SubMenu('~B~lättern  F3',cmBlaettern,0,kbF3,false,false);
  59.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  60. end;
  61.  
  62. procedure TApplication.SetDialogData;
  63. begin
  64.   with Adresse do
  65.    begin
  66.      Schalter:='TTTTLLLLS';
  67.      FillChar(Firma,SizeOf(Firma),' ');
  68.      FillChar(Ort,SizeOf(Ort),' ');
  69.      FillChar(Strasse,SizeOf(Strasse),' ');
  70.      FillChar(Telefon,SizeOf(Telefon),' ');
  71.    end;
  72. end;
  73.  
  74. procedure TApplication.HandleEvent;
  75. begin
  76.   Heap^.ShowHeapStatus(523,8,White);
  77.   TProgram.HandleEvent;
  78.   case Event.Command of
  79.    cmErfassen  : Erfassen(true);
  80.    cmBlaettern : Erfassen(false);
  81.   end; {case}
  82. end;
  83.  
  84.  
  85. procedure TApplication.Erfassen(DInput:boolean);
  86. var R:TRect;
  87.     Window:PAdressWindow;
  88. begin
  89.   R.Assign(60,80,440,350);
  90.   Window:=new(PAdressWindow, Init(R,'Beispiel 22 : Mini-Adressdatenbank',
  91.               winDouble+winPanel,DInput));
  92.   with Window^ do
  93.    begin
  94.      SetPushButton(150,220,80,22,'OK',cmCloseWindow);
  95.      SetPushButton(40,220,80,22,'Sichern',cmSaveData);
  96.       if not DInput then SetDisabled;
  97.      SetPushButton(260,220,40,22,'<<',cmLeft);
  98.       if DInput then SetDisabled;
  99.      SetPushButton(310,220,40,22,'>>',cmRight);
  100.       if DInput then SetDisabled;
  101.      SetInputLine(140,95,25,'~F~irma    :',40,ASCII);
  102.       if not DInput then SetDisabled;
  103.      SetInputLine(140,120,20,'~O~rt      :',25,ASCII);
  104.       if not DInput then SetDisabled;
  105.      SetInputLine(140,145,20,'~S~traße   :',30,ASCII);
  106.       if not DInput then SetDisabled;
  107.      SetInputLine(140,170,20,'~T~elefon  :',20,ASCII);
  108.       if not DInput then SetDisabled;
  109.      if DInput then SetStaticText(40,35,'Adressenerfassung',LeftText)
  110.       else SetStaticText(40,35,'Blättern in der Datei',LeftText);
  111.       SetTextParameters(TriplexFont,HorizDir,2);
  112.       ChangePalColor(10,Red);
  113.      SetData(Adresse);
  114.    end;
  115.   InsertDesktop(Window);
  116. end;
  117.  
  118. {Implementation TAdressWindow}
  119.  
  120. constructor TAdressWindow.Init(var Bounds:TRect;ATitle:str80;AType:byte;DInput:boolean);
  121. begin
  122.   TDlgWindow.Init(Bounds,ATitle,AType);
  123.   PosIndex:=0;
  124.   assign(Dat,'ADRESS.DAT');
  125.   reset(Dat);
  126.   if not DInput then
  127.    begin
  128.      read(Dat,Adresse);
  129.      SetData(Adresse);
  130.    end;
  131. end;
  132.  
  133. destructor TAdressWindow.Done;
  134. begin
  135.   TDlgWindow.Done;
  136.   close(Dat);
  137. end;
  138.  
  139. procedure TAdressWindow.HandleEvent;
  140. var k:word;
  141.  
  142. procedure DeleteDataRecord;
  143. begin
  144.   with Adresse do
  145.    begin
  146.      FillChar(Firma,SizeOf(Firma),' ');
  147.      FillChar(Ort,SizeOf(Ort),' ');
  148.      FillChar(Strasse,SizeOf(Strasse),' ');
  149.      FillChar(Telefon,SizeOf(Telefon),' ');
  150.    end;
  151. end;
  152.  
  153. procedure ReadDataRecord;
  154. begin
  155.   seek(Dat,PosIndex);
  156.   read(Dat,Adresse);
  157.   SetData(Adresse);
  158.   DrawMask;
  159.   Event.Command:=cmNothing;
  160. end;
  161.  
  162. begin
  163.   TDlgWindow.HandleEvent;
  164.   if Event.Command=cmSaveData then
  165.    begin
  166.      write(Dat,Adresse);
  167.      DeleteDataRecord;
  168.      SetData(Adresse);
  169.      DrawMask;
  170.      Event.Command:=cmNothing;
  171.      Exit;
  172.    end;
  173.   if Event.Command=cmRight then
  174.    if FilePos(Dat)<FileSize(Dat) then
  175.     begin
  176.       inc(PosIndex);
  177.       ReadDataRecord;
  178.       Exit;
  179.     end;
  180.   if Event.Command=cmLeft then
  181.    if PosIndex>0 then
  182.     begin
  183.       dec(PosIndex);
  184.       ReadDataRecord;
  185.       Exit;
  186.     end;
  187. end;
  188.  
  189.  
  190. {--- Hauptprogramm ---}
  191.  
  192. begin
  193.   MyProg.Init('Beispiel 22');
  194.   MyProg.Run;
  195.   MyProg.Done;
  196. end.