[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

{
>Really like to see is a Real world example.  In particular a
>collection of Filenames in the current directory sorted and  the
>ability to scroll these Strings vertically.  I don't want to go

I don't know if this will help that much, but it does what you requested
<g>...  This Compiled in Real mode under BP7 and ran without problems. Although
untested in TP6, it should run fine.
}
Program Example;

Uses
  App,
  Dialogs,
  Drivers,
  Menus,
  MsgBox,
  Objects,
  StdDlg,
  Views;

Const
  cmAbout       = 101;

Type
  TExampleApp = Object(TApplication)
    Procedure CM_About;
    Procedure CM_Open;
    Procedure HandleEvent(Var Event: TEvent); Virtual;
    Constructor Init;
    Procedure InitStatusLine; Virtual;
  end;

Procedure TExampleApp.CM_About;
begin
  MessageBox(
    ^C'Example O-O Program' + #13 + #13 +
    ^C'by Bill Himmelstoss (1:112/57)', nil, mfInFormation + mfOkButton
  );
end;

Procedure TExampleApp.CM_Open;
Var
  FileDialog: PFileDialog;
  Filename: FNameStr;
  Result: Word;
begin
  FileDialog := New(PFileDialog, Init('*.*', 'Open a File', '~N~ame',
    fdOpenButton, 100));
  {$ifDEF VER70}
  Result := ExecuteDialog(FileDialog, @Filename);
  {$endif}
  {$ifDEF VER60}
  Result := cmCancel;
  if ValidView(FileDialog) <> nil then
    Result := Desktop^.ExecView(FileDialog);
  if Result <> cmCancel then
    FileDialog^.GetFilename(Filename);
  Dispose(FileDialog, Done);
  {$endif}
  if Result <> cmCancel then
    MessageBox(^C'You chose '+Filename+'.', nil, mfInFormation + mfOkButton);
end;

Procedure TExampleApp.HandleEvent(Var Event: TEvent); begin
  {$ifDEF VER60}
  TApplication.HandleEvent(Event);
  {$endif}
  {$ifDEF VER70}
  inherited HandleEvent(Event);
  {$endif}

  Case Event.What of
    evCommand:
    begin
      Case Event.Command of
        cmAbout: CM_About;
        cmOpen: CM_Open;
      else
        Exit;
      end;
      ClearEvent(Event);
    end;
  end;
end;

Constructor TExampleApp.Init;
Var
  Event: TEvent;
begin
  {$ifDEF VER60}
  TApplication.Init;
  {$endif}
  {$ifDEF VER70}
  inherited Init;
  {$endif}

  ClearEvent(Event);
  Event.What := evCommand;
  Event.Command := cmAbout;
  PutEvent(Event);
end;

Procedure TExampleApp.InitStatusLine;
Var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef($0000, $FFFF,
      NewStatusKey('~F3~ Open', kbF3, cmOpen,
      NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit,
    nil)),
  nil)));
end;

Var
  ExampleApp: TExampleApp;

begin
  ExampleApp.Init;
  ExampleApp.Run;
  ExampleApp.Done;
end.

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]