Delphi2007.net 首页

Mis系统中常用到新增，修改某一个条目的详细信息窗口。
定义一个这样的接口，给一个缺省的实现。
以后所有的类似窗口，Frame都要实现该接口。通过Delegate，可以实现类似多重继承的效果。
让Form或Frame类似于继承自那个缺省的实现。
效果：这种方法可极大地精简代码。使整个程序结构清晰。
1、接口和缺省实现的代码：
{<remark>
           单元名称=untItemUI ，
           作者=程龙华，
           日期=2005-03-14
           作用：定义接口IItemUI及其缺省实现TItemUI。
           一般情况下，实现IItemUI接口的类实用Delegate方式，通过
           TItemUI_Default来实现接口。
           注：接口IItemUI用作统一处理条目详细信息的界面显示和数据交互
<remark>}
unit untItemUI;

interface
  uses untCommon,DBclient,untDBRoutine,controls,db,Forms,Windows,Classes,sysutils;

  //接口：IDetailUI，用作统一处理条目详细信息的界面显示和数据交互。
  //注意：本接口只用于单条条目，未考虑多条条目
  type IItemUI=interface
  ['{4D587F58-F073-4AFA-81A1-41400AD51C32}']
        procedure NewRecord;                           //新建
        procedure LoadRecord(Key:string);              //读入
        procedure View;                                //查看
        function DeleteRecord:boolean;                 //删除

        //Get-Set 属性函数
        function GetDataSaved:boolean;
        function GetModified:boolean;
        function GetKey:string;
        function GetReadOnly:boolean;
        procedure SetReadOnly(Value:boolean);

        function GetTagObject:TObject;              //传递其他参数时使用
        procedure SetTagObject(Value:TObject);      //传递其他参数时使用
        function GetInsertionPending:boolean;

        function GetUI:TObject;
        procedure SetUI(Value:TObject);
       { function GetLoadingData:boolean;
        procedure SetLoadingData(Value:boolean);
        }
        //end of Get-Set 属性函数

        property DataSaved:boolean read GetDataSaved;//是否有数据保存到存储系统
        property Modified:boolean read GetModified;   //有否修改数据,需要保存到存储系统
        property Key:string read GetKey;              //主键值
        property ReadOnly:boolean read GetReadOnly write SetReadOnly; //界面是否可以编辑保存
        property InsertionPending:boolean read GetInsertionPending; //是否是正在新增记录
        property UI:TObject read GetUI write SetUI;
        property TagObject:TObject read GetTagObject write SetTagObject; //传入另外的参数时使用

        function CheckDataValid:boolean;              //检查输入的数据合法性
        function SaveData:boolean;                     //保存数据
        procedure CancelUpdate;                        //取消所作的修改。
        procedure DataToUI;                            //刷新界面显示
        procedure UIToData;                            //将数据从界面刷新到数据集

        function GetFieldValue(FieldName:string;ObjectName:string=''):Variant; //读取字段值
  end;

   {<remark>类：TItemUI，实现IItemUI接口的缺省实现，需要自定义时应该从该
     类继承。经常需要覆盖的函数是：
            1、GetCurrentErrStr(检查数据合法性)，
            2、NewRecord（提供新建记录的缺省值）
   </remark>}
   TItemUI=class(TInterfacedObject)
   protected
     FClientDataset:TClientDataset;
     FDatasaved:boolean;
     FLoadingData:boolean;
     FTableName:string;
     FKeyColName:string;
     FReadOnly:boolean;
     FUI:TComponent;
     FTagObject:TObject;
     FIsDestroying:boolean;
   public
     function GetCurrentErrStr:string;virtual;                  //当前数据合法性检查。
   //interface IItemUI
      procedure NewRecord;virtual;                            //新建
      procedure LoadRecord(Key:string);virtual;               //读入
      procedure View;virtual;                                 //查看
      function DeleteRecord:boolean;virtual;                  //删除记录
      function GetDataSaved:boolean;virtual;                  //参见接口中的声明
      function GetModified:boolean;virtual;                   //参见接口中的声明
      function GetKey:string;virtual;                         //参见接口中的声明
      function GetReadOnly:boolean;virtual;                   //参见接口中的声明
      procedure SetReadOnly(Value:boolean);virtual;           //参见接口中的声明
      function GetInsertionPending:boolean; virtual;
      function GetTagObject:TObject;
      procedure SetTagObject(Value:TObject);

      function GetUI:TObject;
      procedure SetUI(Value:TObject);

      function CheckDataValid:boolean;virtual;               //检查输入的数据合法性
      function SaveData:boolean;virtual;                     //保存数据
      procedure CancelUpdate;virtual;                        //取消所作的修改。
      procedure DataToUI;virtual;                            //刷新界面显示
      procedure UIToData;virtual;                            //将数据从界面刷新到数据集

      property DataSaved:boolean read GetDataSaved;//是否有数据保存到存储系统
      property Modified:boolean read GetModified;   //有否修改数据,需要保存到存储系统
      property Key:string read GetKey;              //主键值
      property ReadOnly:boolean read GetReadOnly write SetReadOnly; //界面是否可以编辑保存
      property InsertionPending:boolean read GetInsertionPending; //是否是正在新增记录
      property TagObject:TObject read GetTagObject write SetTagObject; //传入另外的参数时使用
      function GetFieldValue(FieldName:string;ObjectName:string=''):Variant;virtual; //读取字段值

      //end of interface IItemUI

     property LoadingData:boolean read FLoadingData write FLoadingData;//内部使用，是否正在读入数据。
     property ClientDataset:TClientdataset read FClientDataset write FClientDataset;
     property TableName:string read FTableName write FTableName;
     property KeyColName:string read FKeyColName write FKeyColName;
     property UI:TObject read GetUI write SetUI;
     constructor Create(aWinControl:TWinControl;ACDS:TClientDataset;ATableName:string;KeyColName:string='ID');overload;virtual;
     constructor Create; overload;virtual;
     destructor  Destroy;override;
     //防止被代理类循环调用对方的Destroy函数。
     procedure SafelyFree;
end;

implementation

{ TDefItemDetalUI }

procedure TItemUI.CancelUpdate;
begin
  FClientDataset.CancelUpdates;
end;

function TItemUI.CheckDataValid: boolean;
var sErr:string;
begin
  sErr:=GetCurrentErrStr;
  result:=(sErr='');
  if not Result then
     Application.MessageBox(PAnsiChar(sErr),'操作提示'
          ,mb_ICONinformation+mb_OK)
end;

constructor TItemUI.Create(aWinControl: TWinControl;
  ACDS: TClientDataset; ATableName:string;KeyColName:string='ID');
begin
  FClientDataset:=ACDS;
  FTableName:=ATableName;
  FKeyColName:=KeyColName;
  FUI:=aWinControl;
  FIsDestroying:=false;
end;

constructor TItemUI.Create;
begin
  FIsDestroying:=false;
end;

procedure TItemUI.DataToUI;
begin

end;

function TItemUI.DeleteRecord: boolean;
begin
  FClientDataset.Delete;
  Result:=saveCDSData(FClientDataset);
end;


destructor TItemUI.Destroy;
begin
  //由于TItemUI_Default实现了_Release函数（继承自TinterfacedObject），
  //所以接口释放时调用本类中的Destroy。不会调用被代理（Delegate,Implemnts）类的Destroy函数。
  //所以，FUI需要在本函数中释放。
  { TODO : 这里的代码可能会有问题 }
  FIsDestroying:=true;
  if assigned(FUI) then
  begin
    if (not (csDestroying  in FUI.ComponentState)) then
      FUI.Free;
  end;

  {Application.MessageBox('Destroy of TItemUI','操作提示。'
              ,mb_ICONINFORMATION+MB_OK);
   }
  inherited;
end;

function TItemUI.GetCurrentErrStr: string;
begin
  result:='';
end;

function TItemUI.GetDataSaved: boolean;
begin
  result:=FDatasaved;
end;

function TItemUI.GetFieldValue(FieldName,
  ObjectName: string): Variant;
begin
  Result:=FClientDataset.fieldbyName(FieldName).Value;
end;

function TItemUI.GetInsertionPending: boolean;
begin
  result:= (FClientDataset.State=dsInsert)
           or (FClientDataset.UpdateStatus=usInserted) ;
end;

function TItemUI.GetKey: string;
begin
  result:=FClientDataset.fieldbyname(FKeyColName).asstring;
end;


function TItemUI.GetModified: boolean;
begin
  Result:=(FClientDataset.State in [dsEdit,dsInsert])
            or (FClientDataset.ChangeCount>0);
end;

function TItemUI.GetReadOnly: boolean;
begin
  result:=FReadOnly;
end;

function TItemUI.GetTagObject: TObject;
begin
  result:=FTagObject;
end;

function TItemUI.GetUI: TObject;
begin
  result:=FUI;
end;

procedure TItemUI.LoadRecord(Key: string);
var
  sql:string;
begin
  sql:=format('select * from %s where %s=%s',[FTableName,FKeyColName,Key]);
  OpenCDS(sql,FClientDataset);
end;

procedure TItemUI.NewRecord;
begin
  LoadRecord('-1');
  FClientDataset.Append;
  FClientDataset.Post;
end;

procedure TItemUI.SafelyFree;
begin
  if not FIsDestroying then
     inherited Free;
end;

function TItemUI.SaveData: boolean;
begin
  UIToData;
  PostDataset(FClientDataset);
  if CheckDataValid then
  begin
    AssignKeyForNewRecord(FClientDataset,FTableName,FKeyColName);
    Result:=SaveCdsData(FClientDataset);
    FDataSaved:=true;
  end
  else
    result:=false;
end;


procedure TItemUI.SetReadOnly(Value: boolean);
begin
  FReadOnly:=Value;
  SetContainerReadOnly(FUI as TWinControl,FReadOnly);
end;

procedure TItemUI.SetTagObject(Value: TObject);
begin
  FTagObject:=Value;
end;

procedure TItemUI.SetUI(Value: TObject);
begin
  FUI:=Value as TComponent;
end;

procedure TItemUI.UIToData;
begin

end;

procedure TItemUI.View;
begin
  DataToUI;
  if FUI is TForm then
    (FUI as TForm).ShowModal
  else if (FUI is TWinControl) then
    (FUI as TWinControl).Visible:=true;
end;

end.
2、一个窗口的实例：（使用了Delegate技术）
unit ufFileDetail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Provider, ActnList, DB, Mask,
  DBCtrls, DBClient, dxCntner, dxEditor, dxEdLib, dxDBELib,untCommon,
  untDBRoutine,untItemUI;

type
  TParam_Inner=class  //对接口传递参数专用
    public
      ProjID:integer;
      FileType:string;
  end;

  TItemUI_FileDetail=class(TItemUI,IItemUI)
    procedure NewRecord;override;

    procedure DataToUI;override;
    function GetCurrentErrStr:string;override;
  end;
  TfmFileDetail = class(TForm,IItemUI)
    Panel1: TPanel;
    cdsFile: TClientDataSet;
    DataSource1: TDataSource;
    DataSetProvider1: TDataSetProvider;
    Panel2: TPanel;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Label4: TLabel;
    ActionList1: TActionList;
    actOK: TAction;
    actCancel: TAction;
    Label3: TLabel;
    Label5: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    dxDBEdit2: TdxDBEdit;
    dxDBEdit3: TdxDBEdit;
    dxDBEdit4: TdxDBEdit;
    dxDBEdit5: TdxDBEdit;
    BitBtn3: TBitBtn;
    Label6: TLabel;
    dxDBEdit6: TdxDBEdit;
    edtProjCode: TdxEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure actOKExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure ActionList1Update(Action: TBasicAction;
      var Handled: Boolean);
  private
    { Private declarations }
     FItemUI:TItemUI_Default;
  public
    { Public declarations }
    property ItemUI :TItemUI_Default read FItemUI implements IItemUI;
  end;

var
  fmFileDetail: TfmFileDetail;

implementation

{$R *.dfm}

procedure TfmFileDetail.FormCreate(Sender: TObject);
begin
  FItemUI:=TItemUI_FileDetail.Create(self,cdsFile,'TProjectFile');
  desktopfont:=true;  
end;

{ TItemUI_FileDetail }

procedure TItemUI_FileDetail.DataToUI;
var
  sql:String;
begin
  sql:=format('select Code from TProject where ID=%d',[FClientDataset.FieldByName('ProjectID').AsInteger]);
  (FUI as TfmFileDetail).edtProjCode.Text:=untDBRoutine.ExecuteScalar(sql);
end;

function TItemUI_FileDetail.GetCurrentErrStr: string;
begin
  if FClientDataset.FieldByName('Name').AsString='' then
    result:='请输入名称。';
  if FClientDataset.FieldByName('Location').AsString='' then
    result:='请输入文件位置。';
  if not FileExists(FClientDataset.FieldByName('Location').AsString) then
    result:='指定的文件不存在。';
end;

procedure TItemUI_FileDetail.NewRecord;
var
  sql,FileType:string;
  OrderNo,ProjID:integer;
begin
  ProjID:= (FTagObject as ufFileDetail.TParam_Inner).ProjID;
  FileType:=(FTagObject as ufFileDetail.TParam_Inner).FileType;
  sql:=format('select count(*) from TProjectFile where ProjectID=%d and Type=%s',
           [ProjID,quotedstr(FileType)]);
  OrderNo:=untDBRoutine.ExecuteScalar(sql)+1;
  inherited;
  EditDataset(FClientDataset);
  FClientDataset['ProjectID']:=ProjID;
  FClientDataset['Type']:=FileType;
  FClientDataset['OrderNo']:=OrderNo;
  FClientDataset.Post;
end;

procedure TfmFileDetail.actOKExecute(Sender: TObject);
begin
  if   FItemUI.SaveData then
  begin
    close;
    ModalResult:=mrOK;
  end;
end;

procedure TfmFileDetail.actCancelExecute(Sender: TObject);
begin
  close;
  ModalResult:=mrCancel;
end;

procedure TfmFileDetail.BitBtn3Click(Sender: TObject);
var
  sql:string;
begin
  sql:=format('select DisplayText from TsysBasicData where Type=%s and Code=%s'
     ,[quotedstr('FolderType'),quotedstr(cdsFile.fieldbyname('Type').AsString)]);
  OpenDialog1.Filter:=untDBRoutine.ExecuteScalar(sql);
  if OpenDialog1.Execute then
  begin
    EditDataset(cdsFile);
    cdsFile.fieldbyname('Location').asstring:=OpenDialog1.FileName;
    if cdsFile.fieldbyname('Name').asstring='' then
       cdsFile.fieldbyname('Name').asstring:=ExtractFileNameWithoutExt(OpenDialog1.FileName);
  end;
end;

procedure TfmFileDetail.ActionList1Update(Action: TBasicAction;
  var Handled: Boolean);
begin
  actOK.Enabled := FItemUI.Modified;
end;

end.

3、调用
procedure TfmMain.actViewExecute(Sender: TObject);
var
  FileID:integer;
  aItem:IItemUI;
begin
  if assigned(lvwList.Selected) then
  begin
    FileID:=integer(lvwList.selected.Data);
    aItem:=TfmFileDetail.Create(self);
    aItem.LoadRecord(inttostr(FileID));
    aItem.View;
    if aItem.DataSaved then
       RefreshUI_List;
  end;
end;

procedure TfmMain.actNewExecute(Sender: TObject);
var
  FileType:string;
  ProjID:integer;
  AParam:ufFileDetail.TParam_Inner;
  aItem:IItemUI;
begin
  if Assigned(tvwProj.Selected)
     and (tvwProj.Selected.Level=2) then
  begin
    FileType:=tvwProj.Selected.Text;
    ProjID:=GetProjID(tvwProj.Selected.Parent);
    AParam:=ufFileDetail.TParam_Inner.Create;
    AParam.ProjID:=ProjID;
    AParam.FileType:=FileType;
    aItem:=TfmFileDetail.Create(self);
    aItem.TagObject:=AParam;
    aItem.NewRecord;
    aItem.View;
    if aItem.DataSaved then
      RefreshUI_List;
    { TODO : Don't refresh all the list }
    AParam.free;
  end;
end;