示例:文档
说明:
考虑一个提供Application和Document类的应用框架。Application类负责打开一个已有的以外部形式存储的文档,如一个文件。一旦一个文档中的信息从该文件中读出后,它就由一个Document对象表示。
OpenDocument是一个模板方法,定义了打开一个文档的每一个主要步骤。
界面:
object Form2: TForm2
Left = 192
Top = 110
Width = 285
Height = 212
Caption = 'Form2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 24
Top = 16
Width = 233
Height = 113
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object btnDocOpen: TButton
Left = 16
Top = 144
Width = 113
Height = 25
Caption = 'btnDocOpen'
TabOrder = 1
OnClick = btnDocOpenClick
end
object btnDocClose: TButton
Left = 160
Top = 144
Width = 99
Height = 25
Caption = 'btnDocClose'
TabOrder = 2
OnClick = btnDocCloseClick
end
object OpenDialog1: TOpenDialog
Left = 112
Top = 64
end
end
代码:
unit uDocument;
interface
uses
Windows, SysUtils, Classes, Controls,Dialogs, StdCtrls, Contnrs;
type
TApplication1 = class;
TDocument = class
private
FFileHandle: integer;
FFileName: string;
FContent: string;
FParent: TApplication1;
function IsOpen: Boolean;
public
procedure Open();
procedure Close();
procedure Save();
procedure DoRead(); virtual; abstract;
procedure DoWrite(); virtual; abstract;
//---
property FileName: string read FFileName write FFileName;
property Parent: TApplication1 read FParent write FParent;
end;
TMyDocument = class(TDocument)
public
procedure DoRead; override;
procedure DoWrite; override;
end;
TApplication1 = class
private
FDocs: TObjectList;
FMemo: TMemo;
function GetCount: Integer;
function GetItems(Index: Integer): TDocument;
function GetLast: TDocument;
protected
function CanOpenDocument(const AName: string): Boolean; virtual;
function DoCreateDocument(const AName: string): TDocument; virtual;
procedure AboutToOpenDocument(ADoc: TDocument); virtual;
//---
procedure AboutToCloseDocument(ADoc: TDocument); virtual;
public
constructor Create(AMemo: TMemo);
destructor Destroy; override;
//---
procedure AddDocument(ADoc: TDocument);
procedure OpenDocument(const AName: string);
procedure CloseDocument();
//---
property Count: Integer read GetCount;
property Items[Index: Integer]: TDocument read GetItems;
property Last: TDocument read GetLast;
property Memo: TMemo read FMemo;
end;
TMyApplication = class(TApplication1)
protected
procedure AboutToOpenDocument(ADoc: TDocument); override;
function CanOpenDocument(const AName: string): Boolean; override;
function DoCreateDocument(const AName: string): TDocument; override;
//---
procedure AboutToCloseDocument(ADoc: TDocument); override;
end;
implementation
procedure TApplication1.AboutToOpenDocument(ADoc: TDocument);
{文档何时将被打开}
begin
end;
procedure TApplication1.AddDocument(ADoc: TDocument);
begin
ADoc.Parent := self;
FDocs.Add(ADoc);
end;
function TApplication1.CanOpenDocument(const AName: string): Boolean;
{检查一个文档是否能够被打开}
begin
Result := False;
end;
constructor TApplication1.Create(AMemo: TMemo);
begin
FDocs := TObjectList.Create;
FMemo := AMemo;
end;
destructor TApplication1.Destroy;
//---
procedure _CloseDocs;
var
i: Integer;
begin
for i := 0 to self.Count - 1 do
self.Items[i].Close;
end;
begin
FDocs.Free;
//---
inherited;
end;
function TApplication1.DoCreateDocument(const AName: string): TDocument;
begin
Result := nil;
end;
function TApplication1.GetItems(Index: Integer): TDocument;
begin
Result := TDocument(FDocs[Index]);
end;
function TDocument.IsOpen: Boolean;
begin
Result := FFileHandle >= 0;
end;
procedure TDocument.Open;
begin
if FileExists(FFileName) then
FFileHandle := FileOpen(FFileName, fmOpenReadWrite)
else
FFileHandle := -1;
end;
procedure TDocument.Close;
begin
if Self.IsOpen then
FileClose(FFileHandle);
FFileHandle := -1;
end;
procedure TDocument.Save;
begin
if Self.IsOpen then
begin
FileSeek(FFileHandle, 0, soFromBeginning);
FileWrite(FFileHandle, PChar(FContent)^, Length(FContent));
//---
SetEndOfFile(FFileHandle);
end;
end;
procedure TMyDocument.DoRead;
var
AFileLen: integer;
begin
if Self.IsOpen then
begin
AFileLen := FileSeek(FFileHandle, 0, soFromEnd);
if AFileLen > 0 then
begin
SetLength(FContent,AFileLen);
//---
FileSeek(FFileHandle, 0, soFromBeginning);
FileRead(FFileHandle, PChar(FContent)^, Length(FContent));
end
else
FContent := '';
//---
if Assigned(FParent) then
FParent.Memo.Text := FContent;
end;
end;
procedure TMyDocument.DoWrite;
begin
if Assigned(FParent) then
FContent := FParent.Memo.Text
else
FContent := '';
end;
function TApplication1.GetCount: Integer;
begin
Result := FDocs.Count;
end;
procedure TApplication1.OpenDocument(const AName: string);
var
ADoc: TDocument;
begin
if not CanOpenDocument(AName) then
exit;
//---
ADoc := DoCreateDocument(AName);
if ADoc <> nil then
begin
FDocs.Add(ADoc);
//---
AboutToOpenDocument(ADoc);
//---
ADoc.Open();
ADoc.DoRead();
end;
end;
procedure TMyApplication.AboutToCloseDocument(ADoc: TDocument);
begin
ShowMessage('正在关闭文档:' + ADoc.FileName);
end;
procedure TMyApplication.AboutToOpenDocument(ADoc: TDocument);
begin
ShowMessage('正在打开文档:' + ADoc.FileName);
end;
function TMyApplication.CanOpenDocument(const AName: string): Boolean;
begin
Result := FileExists(AName);
end;
function TMyApplication.DoCreateDocument(const AName: string): TDocument;
begin
Result := TMyDocument.Create;
with Result do
begin
Parent := Self;
FileName := AName;
end;
end;
procedure TApplication1.CloseDocument;
var
ADoc: TDocument;
begin
ADoc := Self.Last;
if ADoc <> nil then
begin
AboutToCloseDocument(ADoc);
//---
ADoc.DoWrite;
ADoc.Save;
ADoc.Close;
//---
FDocs.Remove(ADoc);
end;
end;
function TApplication1.GetLast: TDocument;
begin
Result := TDocument(FDocs.Last);
end;
procedure TApplication1.AboutToCloseDocument(ADoc: TDocument);
begin
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uDocument, StdCtrls;
type
TForm2 = class(TForm)
Memo1: TMemo;
btnDocOpen: TButton;
OpenDialog1: TOpenDialog;
btnDocClose: TButton;
procedure btnDocCloseClick(Sender: TObject);
procedure btnDocOpenClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FApp: TApplication1;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
FApp := TMyApplication.Create(self.Memo1);
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FApp.Free;
end;
procedure TForm2.btnDocOpenClick(Sender: TObject);
begin
with OpenDialog1 do
begin
if Execute then
FApp.OpenDocument(FileName);
end;
end;
procedure TForm2.btnDocCloseClick(Sender: TObject);
begin
FApp.CloseDocument;
end;
end.