PC-X 1998 March/pcx19_9803.iso/PC-XUSER/PC-XUSER.10/OOP/PELDA02.PAS

Pascal/Delphi Source File | 1997-10-15 | 12.6 KB | 488 lines

{*********************************************************}
{                                                         }
{   A program forráskódja az IDG - PCX szerkesztôségének, }
{   és Bérczi László-nak a tulajdona.                     }
{   A forráskód a kereskedelmi célokat kivéve szabadon    }
{                    terjeszthetô !                       }
{                                                         }
{   PC-X User (c) 1997, november                          }
{*********************************************************}
program Pelda_Dialogus_tervezesre_II_with_Validating;

uses App, Objects, Menus, Drivers, Views, Dialogs, Editors, Memory, StdDlg, Validate;

type
  PAdatok = ^TAdatok;
  TAdatok = record
    VNev,
    KNev,
    Varos     : String[16];
    Irszam    : String[4];
    Utca      : String[16];
    HazSzam   : String[3];
    EgyebHossz: Word;
    Egyeb     : Array[1..16] of Char;
    Tel       : String[16];
    NoteHossz : Word;
    Note      : Array[1..80] of Char;
  end;

  PProbaDialog = ^TProbaDialog;
  TProbaDialog = Object(TDialog)
    Vezetek, Kereszt,
    Varos,Iranytszam, Utca, Hazszam,
    Tel          : PInputLine;
    Egyeb, Note  : PMemo;
    Adatok       : TAdatok;
    constructor Init;
    destructor  Done; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  private
    AdatFile    : File of TAdatok;
    MelyikRekord: Word;
    procedure FileOpen;
    procedure ReadRecord(var x: Word); {Read to Adatok variable}
    procedure SaveRecordToLastPos;
    procedure FileClose;
  end;

  TMyApp = Object(TApplication)
    constructor Init;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure NewWindow;
    procedure OpenWindow;
    procedure About;
    procedure SaveDesktop;
    procedure LoadDesktop;
    procedure OpenProbaDialog;
  private
    ClipboardWindow: PEditWindow;
    ProbaDialog    : PProbaDialog;
  end;

const
  cmAbout       = 1000;
  cmClipShow    = 1001;
  cmSaveDsk     = 1002;
  cmLoadDsk     = 1003;
  cmTHatra      =  247;
  cmTElore      =  248;
  cmSaveUj      =  249;
  cmUjAdat      =  250;
  cmProbaDialog =  251;
  cmProbaDialogLetezel = 1004;
  hcProbaDialog = $F000;
  hcWindow      = $1F00;

  WinNo: Word = 1;

constructor TProbaDialog.Init;
var R    : TRect;
begin
  R.Assign(0,0,63,20);
  Inherited Init(R, 'Próba dialógus');
  Options := Options or OfCentered;
  HelpCtx := hcProbaDialog;

  R.Assign(16, 2, 28, 3);
  New(Vezetek, Init(R, 16));
  Insert(Vezetek);
  R.Assign(2, 2, 14, 3);
  Insert(New(PLabel, Init(R, 'Ve~z~etéknév:', Vezetek)));

  R.Assign(47, 2, 59, 3);
  New(Kereszt, Init(R, 16));
  Insert(Kereszt);
  R.Assign(33, 2, 45, 3);
  Insert(New(PLabel, Init(R, 'Ke~r~esztnév:', Kereszt)));

  R.Assign(11, 4, 28, 5);
  New(Varos, Init(R, 16));
  Insert(Varos);
  R.Assign(2, 4, 9, 5);
  Insert(New(PLabel, Init(R, 'Vár~o~s:', Varos)));

  R.Assign(50, 4, 59, 5);
  New(Iranytszam, Init(R, 4));
  if CommandEnabled(cmUjAdat) {and not Valid(cmClose)} then
    Iranytszam^.SetValidator(New(PRangeValidator, Init(1000, 9999)));
  Insert(Iranytszam);
  R.Assign(33, 4, 47, 5);
  Insert(New(PLabel, Init(R, '~I~rányítószám:', Iranytszam)));

  R.Assign(11, 6, 28, 7);
  New(Utca, Init(R, 16));
  Insert(Utca);
  R.Assign(2, 6, 9, 7);
  Insert(New(PLabel, Init(R, '~U~tca:', Utca)));

  R.Assign(50, 6, 59, 7);
  New(Hazszam, Init(R, 3));
  if CommandEnabled(cmUjAdat) {and not Valid(cmClose)} then
    Hazszam^.SetValidator(New(PRangeValidator, Init(1, 999)));
  Insert(Hazszam);
  R.Assign(33, 6, 47, 7);
  Insert(New(PLabel, Init(R, 'Ház~s~zám:', Hazszam)));

{  R.Assign(21, 8, 40, 11);
  Insert(New(PR4sFrame3D, Init(R, ' ', HalfGraphFrame, FrameWhite)));}

  R.Assign(22, 9, 39, 10);
  New(Egyeb, Init(R, nil, nil, nil, 16));
  Insert(Egyeb);
  R.Assign(22, 8, 30, 9 );
  Insert(New(PLabel, Init(R, 'E~g~yéb:', Egyeb)));

  R.Assign(29, 12, 46, 13);
  New(Tel, Init(R, 16));
  if CommandEnabled(cmUjAdat) then Tel^.SetValidator(New(PPXPictureValidator, Init('##-##-###-###[#]', True)));
    Insert(Tel);
  R.Assign(20, 12, 27, 13);
  Insert(New(PLabel, Init(R, '~T~el:', Tel)));

  {R.Assign(2, 13, 60, 17);
  Insert(New(PR4sFrame3D, Init(R, ' ', HalfGraphFrame, FrameWhite)));}
  R.Assign(3, 14, 59, 16);
  New(Note, Init(R, nil, nil, nil, 80));
  Insert(Note);
  R.Assign(1, 13, 17, 14);
  Insert(New(PLabel, Init(R, ' Meg~j~egyzés: ', Note)));

  R.Assign(3 , 17, 13, 19);
  Insert(New(PButton, Init(R, 'ú~j~', cmUjAdat, bfDefault)));
  R.Assign(14, 17, 24, 19);
  Insert(New(PButton, Init(R, 'Elme~n~t', cmSaveUj, bfNormal)));
  R.Assign(25, 17, 35, 19);
  Insert(New(PButton, Init(R, '~M~égsem', cmClose, bfNormal)));
  R.Assign(36, 17, 49, 19);
  Insert(New(PButton, Init(R, '~K~övetkezô', cmTElore, bfNormal)));
  R.Assign(50, 17, 59, 19);
  Insert(New(PButton, Init(R, 'E~l~ôzô', cmTHatra, bfNormal)));

  MelyikRekord:=0;
  FileOpen;
  ReadRecord(MelyikRekord);
  SetData(Adatok);
end;

destructor TProbaDialog.Done;
begin
  Inherited Done;
  FileClose;
end;

procedure TProbaDialog.HandleEvent(var Event: TEvent);
var B: Boolean;
begin
  B:=True;
  Inherited HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmProbaDialogLetezel)
  then ClearEvent(Event);
  if (Event.What = evCommand) then
  begin
    case Event.Command of
      cmClose : Close;
      cmTHatra: begin
                  if MelyikRekord <> 0 then Dec(MelyikRekord);
                  ReadRecord(MelyikRekord);
                  SetData(Adatok);
                end;
      cmTElore: begin
                  Inc(MelyikRekord);
                  ReadRecord(MelyikRekord);
                  SetData(Adatok);
                end;
      cmSaveUj: begin GetData(Adatok); SaveRecordToLastPos; end;
      cmUjAdat: begin
                  ClearEvent(Event);
                  Event.What:=evKeyDown;
                  Event.KeyCode:=kbAltZ;
                  PutEvent(Event);
                  FillChar(Adatok, SizeOf(Adatok), 0);
                  SetData(Adatok);
                  B:=False;
                end;
    end;
    if B then ClearEvent(Event);
  end;
end;

procedure TProbaDialog.FileOpen;
begin
  MelyikRekord:=0;
  Assign(AdatFile, 'adatok.dat');
  Reset(AdatFile);
end;

procedure TProbaDialog.ReadRecord(var x: Word);
begin
  if Word(FileSize(AdatFile)-1) >= x then
  begin
    Seek(AdatFile, x);
    Read(AdatFile, Adatok);
  end                                 else Dec(x);
end;

procedure TProbaDialog.SaveRecordToLastPos;
begin
  Seek(AdatFile, FileSize(AdatFile));
  Write(AdatFile, Adatok);
end;

procedure TProbaDialog.FileClose;
begin
  System.Close(AdatFile);
end;

procedure TMyStreamError(var S: TStream); far;
var ErrorMessage: String;
begin
  case S.Status of
    stError: ErrorMessage := 'Stream access error';
    stInitError: ErrorMessage := 'Cannot initialize stream';
    stReadError: ErrorMessage := 'Read beyond end of stream';
    stWriteError: ErrorMessage := 'Cannot expand stream';
    stGetError: ErrorMessage := 'Unregistered type read from stream';
    stPutError: ErrorMessage := 'Unregistered type written to stream';
    end;
  DoneVideo;
  PrintStr('Error: ' + ErrorMessage);
  Halt(Abs(S.Status));
end;

constructor TMyApp.Init;
var
  R: TRect;
begin
  MaxHeapSize := 8192;
  EditorDialog := StdEditorDialog;
  StreamError := @TMyStreamError;
  RegisterObjects;
  RegisterViews;
  RegisterApp;
  RegisterEditors;
  Inherited Init;
  Desktop^.GetExtent(R);
  ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  if ValidView(ClipboardWindow) <> nil then
  begin
    ClipboardWindow^.Hide;
    InsertWindow(ClipboardWindow);
    Clipboard := ClipboardWindow^.Editor;
    Clipboard^.CanUndo := False;
  end;
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
var R: TRect;
begin
  Inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmNew:
      begin
        NewWindow;
        ClearEvent(Event);
      end;

      cmOpen:
      begin
        OpenWindow;
        ClearEvent(Event);
      end;

      cmAbout:
      begin
        About;
        ClearEvent(Event);
      end;

      cmClipShow:
        with ClipboardWindow^ do
        begin
          Select;
          Show;
          ClearEvent(Event);
        end;
      cmSaveDsk:
      begin
        SaveDesktop;
        ClearEvent(Event);
      end;
      cmLoadDsk:
      begin
        LoadDesktop;
        ClearEvent(Event);
      end;
      cmProbaDialog:
      begin
        OpenProbaDialog;
        ClearEvent(Event);
      end;

      {cmXXXX:
      begin
        ClearEvent(Event);
      end;}
    end;
  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(
      StdFileMenuItems(nil)),
    NewSubMenu('~E~dit', hcNoContext, NewMenu(
      StdEditMenuItems(
       NewLine(
      NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
      nil)))),
    NewSubMenu('O~p~tions', hcNoContext, NewMenu(
      NewItem('~S~ave desktop', '', kbNoKey, cmSaveDsk, hcNoContext,
      NewItem('~L~oad desktop', '', kbNoKey, cmLoadDsk, hcNoContext,
      nil))),
    NewSubMenu('~W~indow', hcNoContext, NewMenu(
      NewItem('~P~róbaDialog', '', kbNoKey, cmProbaDialog, hcNoContext,
      StdWindowMenuItems(nil))),
    NewSubMenu('~H~elp', hcNoContext, NewMenu(
      NewItem('~H~elp', '', kbNoKey, cmHelp, hcNoContext,
       NewLine(
      NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
      nil)))),
    nil))))))));
end;

procedure TMyApp.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  New(StatusLine, Init(R,
    NewStatusDef(0, $0FFF,
      NewStatusKey('~F3~ Open dialog', kbF5, cmNew,
      NewStatusKey('~ALT-X~ Exit', kbALTX, cmQuit,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      StdStatusKeys(nil)))),
    NewStatusDef($1F00, $FFFF,
      NewStatusKey('~F2~ Save', kbF2, cmSave,
      NewStatusKey('~ALT-F3~ Close', kbALTF3, cmClose,
      NewStatusKey('~PgUp~ Elôre', kbPgUp, cmTElore,
      NewStatusKey('~PgDown~ Hátra', kbPgDn, cmTHatra,
      StdStatusKeys(nil))))),
    nil))));
end;

procedure TMyApp.About;
var
  R     : TRect;
  Dialog: PDialog;
begin
  R.Assign(0, 0, 49, 11);
  New(Dialog, Init(R, 'PC-X User'));
  with Dialog^ do
  begin
    Options:=Options or OfCentered;
    R.Assign(20, 5, 30, 7);
    Insert(New(PButton, Init(R, '~O~k', cmOk, bfDefault)));
    HelpCtx:=hcWindow;
  end;
  DeskTop^.ExecView(Dialog);
end;

procedure TMyApp.OpenWindow;
var
  R     : TRect;
  Window: PEditWindow;

  FileDialog: PFileDialog;
  TheFile   : FNameStr;
const
  FDOptions: Word = fdOKButton or fdOpenButton;
begin

  TheFile:='*.TXT';
  New(FileDialog, Init(TheFile, 'Open file', '~F~ile name', FDOptions, 1));
  if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  begin
    R.Assign(0, 0, 75, 20);
    New(Window, Init(R, TheFile, WinNo));
    with Window^ do
    begin
      Options:=Options or OfCentered;
      HelpCtx:=hcWindow;
    end;
    Inc(WinNo);
    InsertWindow(Window);
  end;
end;

procedure TMyApp.NewWindow;
var
  R     : TRect;
  Window: PEditWindow;
begin
  R.Assign(0, 0, 75, 20);
  New(Window, Init(R, '', WinNo));
  with Window^ do
  begin
    Options:=Options or OfCentered;
    HelpCtx:=hcWindow;
  end;
  Inc(WinNo);
  InsertWindow(Window);
end;

procedure TMyApp.SaveDesktop;
var SaveDsk: PBufStream;
begin
  Desktop^.Delete(ClipboardWindow);
  New(SaveDsk, Init('PELDAS.DSK', stCreate, 2048));
  SaveDsk^.Put(Desktop);
  Dispose(SaveDsk, Done);
  InsertWindow(ClipboardWindow);
end;

procedure TMyApp.LoadDesktop;
var
  LoadDsk    : PBufStream;
  TempDesktop: PDesktop;
  R          : TRect;
begin
  New(LoadDsk, Init('PELDAS.DSK', stOpenRead, 2048));
  TempDesktop := PDesktop(LoadDsk^.Get);
  Dispose(LoadDsk, Done);
  if ValidView(TempDesktop) <> nil then
  begin
    Desktop^.Delete(ClipboardWindow);
    Delete(Desktop);
    Dispose(Desktop, Done);
    Desktop := TempDesktop;
    Insert(Desktop);
    GetExtent(R);
    R.Grow(0, -1);
    Desktop^.Locate(R);
    InsertWindow(ClipboardWindow);
  end;
end;

procedure TMyApp.OpenProbaDialog;
begin
  New(ProbaDialog, Init);
  InsertWindow(ProbaDialog);
end;


var MyApp: TMyApp;

BEGIN
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
END.