CSDN博客

img mario1114

向导框架 delphi实现

发表于2004/6/27 11:18:00  865人阅读

例子图片
 
 
设计目标
 
能购方便的设计向导的每一页又不会非常的繁琐
 
?
 
下载例子源码WizardFrameWork
 
使用方式
gWizardMain.Execute; 
 
TestMain.pas

unit  Unit1;

interface

uses
 
  Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,
   Dialogs,  DB,   uWizardMain,  uWizardFrame,  StdCtrls;

type
 
  TForm1  =  class(TForm)
     Button1:  TButton;
     procedure  FormCreate(Sender:  TObject);
     procedure  Button1Click(Sender:  TObject);
   private
 
  public
 
    procedure  OnInit(Sender:  TObject);
     procedure  OnFinish(Sender:  TObject);
   end;

var
 
  Form1:  TForm1;

implementation



{$R *.dfm}

procedure  TForm1.FormCreate(Sender:  TObject);
begin
 
  gWizardMain.OnInit    :=  OnInit;
   gWizardMain.OnFinish  :=  OnFinish;
end;

procedure  TForm1.Button1Click(Sender:  TObject);
begin
 
  gWizardMain.Execute;
end;

procedure  TForm1.OnInit(Sender:  TObject);
begin
{
éè??3?ê??μ
}
 
  
gWizardMain.FrameChain.Frames['F1'].ControlValues['Edit1']  :=  'CloudQQ';
   gWizardMain.FrameChain.Frames['F2'].ControlValues['Edit1']  :=  'Mario';
end;

procedure  TForm1.OnFinish(Sender:  TObject);
begin
{
è??μ
}
 
  
ShowMessage(gWizardMain.FrameChain.Frames['F1'].ControlValues['Edit1']);
   ShowMessage(gWizardMain.FrameChain.Frames['F2'].ControlValues['Edit1']);
end;

end.

 

 

uBaseFrame.pas

 

 

 


unit  uBaseFrame;

interface

uses
 
  Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,
   Dialogs,  StdCtrls;

type
 
  TBaseFrameClass  =  class  of  TBaseFrame;

   TBaseFrame  =  class(TFrame)
   private
 
    FTitle  :   string;
     function   GetControl(AName:  string):  TComponent;
   public
 
    procedure  DoBeforeNext;  virtual;
     procedure  DoAfterNext    virtual;

     procedure  DoBeforePrev;  virtual;
     procedure  DoAfterPrev    virtual;
     procedure  DoHelp         virtual;

     procedure  DoInit         virtual;
   public
 
    function   GetItemValue(const  AName:  string):  Variant;
     procedure  SetItemValue(const  AName:  string;  const  AValue:  Variant);
     property   Title  :  string  read  FTitle  write  FTitle;
     property   ControlValues[const  AName:  string]:  Variant  read  GetItemValue  write  SetItemValue;
     constructor  Create(AOnwer:  TComponent);  override;

   end;

implementation

uses 
 uFilters;

{$R *.dfm}

{ TBaseFrame }

constructor  TBaseFrame.Create(AOnwer:  TComponent);
begin
 
  inherited  Create(AOnwer);
   DoInit;
end;

procedure  TBaseFrame.DoAfterNext;
begin

end
;

procedure  TBaseFrame.DoAfterPrev;
begin

end
;

procedure  TBaseFrame.DoBeforeNext;
begin

end
;

procedure  TBaseFrame.DoBeforePrev;
begin

end
;

procedure  TBaseFrame.DoHelp;
begin

end
;

procedure  TBaseFrame.DoInit;
begin

end
;

function  TBaseFrame.GetControl(AName:  string):  TComponent;
var
 
  I:Integer;
begin
 
  Result:=  nil;
   for  I:=  0  to  Self.ComponentCount  -1  do
 
  begin
 
    if  CompareText(AName,  Components[I].Name)  =  0  then
 
    begin
 
      Result  :=  Components[I];
       Exit;
     end;
   end;
end;

function  TBaseFrame.GetItemValue(const  AName:  string):  Variant;
var
 
  AComponent:  TComponent;
   AFilter    :  TControlFilter;
begin
 
  AComponent:=  GetControl(AName);
   AFilter    :=  gFilterList.GetFilter(AComponent);
   if  AFilter  =  nil  then  raise  Exception.Create('TBaseFrame.GetItemValue:: Error AFilter is nil');
   try
 
    Result:=  AFilter.GetValue(AComponent);
   finally
 
    FreeAndNil(AFilter);
   end;
end;

procedure   TBaseFrame.SetItemValue(const  AName:  string;
   const   AValue:  Variant);
var
 
  AComponent:  TComponent;
   AFilter    :  TControlFilter;
begin
 
  AComponent  :=  GetControl(AName);
   AFilter     :=  gFilterList.GetFilter(AComponent);
   if  AFilter  =  nil  then  raise  Exception.Create('TBaseFrame.SetItemValue:: AFilter is nil');
   try
 
    AFilter.SetValue(AComponent,  AValue);
   finally
 
    FreeAndNil(AFilter);
   end;
end;

end.

uFilters.pas

 

{
unit: uFilters
desc: control the method of read. write frame control
author: mario
create date:
modify history:
}
unit  uFilters;

interface
uses 
 Classes  ,SysUtils,  Variants,  Controls,  StdCtrls;

type

 
 TControlFilterClass  =  class  of  TControlFilter;
  TFilterClassItem  =  class(TObject)
  private
 
   FName        :  string;
    FFilterClass:  TControlFilterClass;
  public
 
   constructor  Create(AName:  string;  AClass:  TControlFilterClass);
    destructor   Destroy;  override;
    property     Name        :  string  read  FName;
    property     FilterClass:  TControlFilterClass  read  FFilterClass;
  end;

  TControlFilter  =  class(TObject)
   public
 
    procedure  SetValue(AComponent:  TComponent;  AValue:  Variant);  virtual;
     function   GetValue(AComponent:  Tcomponent):  Variant;  virtual;
   end;

   TFilterList  =  class(TObject)
   private
 
    FItems:  TStringList;
   public
 
    procedure    Register(AFilterClass:  TFilterClassItem);
     function     GetFilter(ACompoent:  TComponent):  TControlFilter;
     constructor  Create;
     destructor   Destroy;  override;
   end;

   // TEdit Filter
 
  
TEditFilter  =  class(TControlFilter)
   public
 
    procedure  SetValue(AComponent:  TComponent;  AValue:  Variant);override;
     function   GetValue(AComponent:  TComponent):  Variant;  override;
   end;


   // TComboBox Filter
 
  
TComboBoxFilter  =  class(TControlFilter)
   public
 
    procedure  SetValue(AComponent:  TComponent;  AValue:  Variant);  override;
     function   GetValue(AComponent:  TComponent):  Variant;  override;
   end;

   // you can define other filter

function  gFilterList    :  TFilterList;

implementation

uses 
 ConvUtils;
var
 
  g_FilterList     :  TFilterList;

function  gFilterList:  TFilterList;
begin
 
  if  not  Assigned(g_filterList)  then  g_FilterList  :=  TFilterList.Create;
   Result  :=  g_FilterList;
end;


function  TControlFilter.GetValue(AComponent:  Tcomponent):  Variant;
begin
 
  Result  :=  unAssigned;
end;

procedure  TControlFilter.SetValue(AComponent:  TComponent;
   AValue:  Variant);
begin
 
  
end;

{ TFilterList }

constructor  TFilterList.Create;
begin
 
  FItems:=  TStringList.Create;
end;

destructor  TFilterList.Destroy;
begin
 
  FreeAndNil(FItems);
   inherited  Destroy;
end;

function  TFilterList.GetFilter(ACompoent:  TComponent):  TControlFilter;
var
 
  Index:  Integer;
begin
 
  Result  :=  nil;
   Index  :=  FItems.IndexOf(ACompoent.ClassName);
   if  Index  <>  -1   then
 
  begin
 
    Result  :=  TFilterClassItem(FItems.Objects[Index]).FilterClass.Create;
   end;
end;

procedure  TFilterList.Register(AFilterClass:  TFilterClassItem);
var
 
  Index:  Integer;
begin
 
  Index  :=  FItems.IndexOf(AFilterClass.Name);
   if  Index  <>  -1  then  raise  Exception.Create('TFilterList.Register:: Error component have been registered');
   FItems.AddObject(AFilterClass.Name,  AFilterClass  );
end;

{ TEditFilter }

function  TEditFilter.GetValue(AComponent:  TComponent):  Variant;
begin
 
  Result  :=  (AComponent  as  TEdit).Text;
end;

procedure  TEditFilter.SetValue(Acomponent:  TComponent;
   AValue:  Variant);
begin
 
  try
 
    (AComponent  as  TEdit).Text  :=  AValue;
   except
 
  end;
end;

{ TComboBoxFilter }

function  TComboBoxFilter.GetValue(AComponent:  TComponent):  Variant;
begin
 
  Result  :=  (AComponent  as  TComboBox).ItemIndex;
end;

procedure  TComboBoxFilter.SetValue(AComponent:  TComponent;
   AValue:  Variant);
begin
 
  try
 
    (AComponent  as  TComboBox).ItemIndex  :=  Avalue;
   except
 
  end;
end;

{ TFilterClassItem }

constructor  TFilterClassItem.Create(AName:  string;  AClass:  TControlFilterClass);
begin
 
  FName          :=  AName;
   FFilterClass   :=  AClass;
end;

destructor  TFilterClassItem.Destroy;
begin
 
  inherited;
end;

initialization
 
  gFilterList.Register(TFilterClassItem.Create(TEdit.ClassName     ,TEditFilter));
   gFilterList.Register(TFilterClassItem.Create(TComboBox.ClassName,  TComboBoxFilter));
finalization
 
  if  Assigned(g_FilterList    )  then  FreeAndNil(g_FilterList);
end.

uWizardFramework.pas

{
unit: uWizardFrame
desc: Wizard Framework
author: mario
create date: 2004/06/23
modify history:
}
unit  uWizardFrame;

interface
uses 
 Classes,  SysUtils,  uBaseFrame,  Controls,  Variants;

type
 
  TFrameRegistry  =  class;

   TFrameChain  =  class(TObject)
   private
 
    FItems   :  TStringList;
     FCursor  :  Integer;
     function     GetFrame(AName:  string):  TBaseFrame;
     function     GetFrameCount  :  Integer;
   public
 
    procedure    SetVisable(FCursor:  Integer);
     function     Prev:  Boolean;
     function     Next:  Boolean;
     function     GetCurrentFrame:  TBaseFrame;
     function     IsEnd:  Boolean;

     constructor  Create(ARegistry:  TFrameRegistry);
     destructor   Destroy;  override;
     property     Frames[AName:  string]:  TBaseFrame  read  GetFrame;
     property     FrameCount:  Integer  read  GetFrameCount;
   end;

   TFrameRegistry  =  class(TObject)
   private
 
    FItems   :    TStringList;
     function     GetFrame(AName:  string):  TBaseFrameClass;
     function     GetItems:  TStringList;
   public
 
    procedure    Register(AName:  string;  AFrameClass:  TBaseFrameClass);
     constructor  Create;
     destructor   Destroy;  override;

     property     Frame[AName:  string]:  TBaseFrameClass  read  GetFrame;
     property     Items:  TStringList  read  GetItems;
   end;




function  gFrameRegistry:  TFrameRegistry;


implementation
uses 
 uWizardMain;

var
 
  g_FrameRegistry  :  TFrameRegistry;

function  gFrameRegistry:  TFrameRegistry;
begin
 
  if  not  Assigned(g_FrameRegistry)  then  g_FrameRegistry  :=  TFrameRegistry.Create;
   Result  :=  g_FrameRegistry;
end;



{ TFrameRegistry }
constructor  TFrameRegistry.Create;
begin
 
  FItems  :=  TStringList.Create;
end;

destructor  TFrameRegistry.Destroy;
begin
 
  FreeAndNil(FItems);
   inherited  Destroy;
end;

function  TFrameRegistry.GetFrame(AName:  string):  TBaseFrameClass;
var
 
  Index:  Integer;
begin
 
  Result:=  nil;
   Index  :=  FItems.IndexOf(AName);
   if  Index  <>  -1  then
 
  begin
 
    Result  :=  TBaseFrameClass(FItems.Objects[Index]);
   end;
end;

function  TFrameRegistry.GetItems:  TStringList;
begin
 
  Result:=  FItems;
end;

procedure  TFrameRegistry.Register(AName:  string;
   AFrameClass:  TBaseFrameClass);
begin
 
  FItems.AddObject(AName,  TObject(AFrameClass));
end;

{ TFrameChain }

constructor  TFrameChain.Create(ARegistry:  TFrameRegistry);
var
 
  I      :  Integer;
   FFrame:  TBaseFrame;
begin
 
  FItems   :=  TStringList.Create;
   FCursor  :=  0;

   for  I:=  0  to  ARegistry.Items.Count  -1  do
 
  begin
 
    FFrame         :=  TBaseFrameClass(ARegistry.Items.Objects[I]).Create(gWizardMain);
     FFrame.Parent  :=  gWizardMain.PanelFrame;
     FFrame.Align   :=  alClient;
     FFrame.Visible:=  True;

     //FItems.Add(FFrame);
 
    
FItems.AddObject(ARegistry.Items.Strings[I],  FFrame);
   end;
end;

destructor  TFrameChain.Destroy;
begin
 
  FreeAndNil(FItems);
   inherited  Destroy;
end;

function  TFrameChain.GetFrameCount:  Integer;
begin
 
  Result:=  FItems.Count;
end;

function  TFrameChain.GetCurrentFrame:  TBaseFrame;
begin
 
  SetVisable(FCursor);
   Result  :=  TBaseFrame(FItems.Objects[FCursor]);
end;

function  TFrameChain.GetFrame(AName:  string):  TBaseFrame;
var
 
  Index:  Integer;
begin
 
  Result  :=  nil;
   Index   :=  FItems.IndexOf(AName);
   if  Index  <>  -1  then
 
  begin
 
    Result  :=  TBaseFrame(FItems.Objects[Index]);
   end;
end;


function  TFrameChain.IsEnd:  Boolean;
begin
 
  Result  :=  FCursor  =  FItems.Count  -1;
end;

function  TFrameChain.Next:  Boolean;
begin
 
  Inc(FCursor);
   if  FCursor  >=  FItems.Count  then
 
  begin
 
    FCursor  :=  FItems.Count  -1;
     Result  :=  False
   end  else  begin
 
    Result  :=  True;
     gWizardMain.BtnCancel.Caption  :=  'è???';
     gWizardMain.BtnPrev.Enabled  :=  True;
     if  FCursor  >  FItems.Count  -2  then
 
    begin
 
      gWizardMain.BtnCancel.Caption  :=  '?áê?';
       gWizardMain.BtnNext.Enabled    :=  False;
     end;
   end;
end;

function  TFrameChain.Prev:  Boolean;
begin
 
  Dec(FCursor);
   if  FCursor  <  0  then
 
  begin
 
    gWizardMain.BtnPrev.Enabled    :=  False;

     FCursor  :=  0;
     Result  :=  False
   end  else  begin
 
    Result  :=  True;
     gWizardMain.BtnNext.Enabled  :=  True;
     gWizardMain.BtnCancel.Caption  :=  'è???';
     if  FCursor  =  0  then  gWizardMain.BtnPrev.Enabled  :=  False;
   end;
end;

{ TControlFilter }



procedure  TFrameChain.SetVisable(FCursor:  Integer);
var
 
  I:Integer;
begin
 
  for  I:=0  to  FItems.Count  -1  do
 
  begin
 
    TBaseFrame(FItems.Objects[I]).Visible  :=  False;
   end;
   TBaseFrame(FItems.Objects[FCursor]).Visible  :=  True;
end;

initialization
finalization
 
  if  Assigned(g_FrameRegistry)  then  FreeAndNil(g_FrameRegistry);

end.

uWizardMain.pas

 

{
unit: uWizardMain
desc: Wizard Main Form , the container
author: mario
create date: 2004/06/23
modify history:
}

unit  uWizardMain;

interface

uses
 
  Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,
   Dialogs,  StdCtrls,  ExtCtrls,  jpeg,  uBaseFrame,  uWizardFrame;

type
 
  TF_WizardMain  =  class(TForm)
     Panel1:  TPanel;
     Panel2:  TPanel;
     Panel3:  TPanel;
     Panel4:  TPanel;
     Panel6:  TPanel;
     BtnNext:  TButton;
     BtnCancel:  TButton;
     BtnHelp:  TButton;
     Image1:  TImage;
     BtnPrev:  TButton;
     Panel5:  TPanel;
     PanelFrame:  TPanel;
     PanelTitle:  TPanel;
     CaptionTitle:  TLabel;
     procedure  FormDestroy(Sender:  TObject);
     procedure  BtnNextClick(Sender:  TObject);
     procedure  BtnPrevClick(Sender:  TObject);
     procedure  BtnCancelClick(Sender:  TObject);
     procedure  BtnHelpClick(Sender:  TObject);
   private
 
    FOnInit        :  TNotifyEvent;
     FOnFinish      :  TNotifyEvent;
     FOnCancel      :  TNotifyEvent;
     FOnHelp        :  TNotifyEvent;
     FFrameChain    :  TFrameChain;
     function         GetFrameChain:  TFrameChain;
     procedure      ShowCurrentFrame;
     constructor    Create(AOwner:  TComponent);  override;
   public
 
    procedure  Execute;
     property   OnInit     :  TNotifyEvent   read  FOnInit    write  FOnInit;
     property   OnFinish   :  TNotifyEvent   read  FOnFinish  write  FOnFinish;
     property   OnCancel   :  TNotifyEvent   read  FOnCancel  write  FOnCancel;
     property   OnHelp     :  TNotifyEvent   read  FOnHelp    write  FOnHelp;
     property   FrameChain:  TFrameChain    read  GetFrameChain;
   end;

var
 
  g_WizardMain  :  TF_WizardMain;
   function  gWizardMain:  TF_WizardMain;

implementation
{$R *.dfm}
function  gWizardMain  :  TF_WizardMain;
begin
 
  if  not  Assigned(g_WizardMain)  then  g_WizardMain  :=  TF_WizardMain.Create(nil);
   Result  :=  g_WizardMain;
end;

{ TF_WizardMain }

procedure  TF_WizardMain.Execute;
begin
 
  if  not  Assigned(FFrameChain)  then
 
  begin
 
     FFrameChain  :=  TFrameChain.Create(gFrameRegistry);
      if  Assigned(FOnInit)  then
 
     begin
 
       FOnInit(Self);
      end;
   end;
   FFrameChain.Prev;
   FFrameChain.SetVisable(0);
   ShowCurrentFrame;
   ShowModal;
end;

procedure  TF_WizardMain.FormDestroy(Sender:  TObject);
begin
 
  if  Assigned(FFrameChain)  then  FreeAndNil(FFrameChain);
end;

procedure  TF_WizardMain.BtnNextClick(Sender:  TObject);
begin
 
  with  FFrameChain.GetCurrentFrame  do
 
  begin
 
    DoBeforeNext;
     if  FFrameChain.Next  then
 
      ShowCurrentFrame;
     DoAfterNext;
   end;
end;

procedure  TF_WizardMain.BtnPrevClick(Sender:  TObject);
begin
 
  with  FFrameChain.GetCurrentFrame  do
 
  begin
 
    DoBeforePrev;
     if  FFrameChain.Prev  then
 
      ShowCurrentFrame;
     DoAfterPrev;
   end;
end;

procedure  TF_WizardMain.BtnCancelClick(Sender:  TObject);
begin
 
  if  FFrameChain.IsEnd  then
 
  begin
 
    if  Assigned(FOnFinish)  then
 
    begin
 
      FOnFinish(Self);
     end;
     Close;
   end  else  begin
 
    if  Assigned(FOnCancel)  then
 
    begin
 
      FOnCancel(Self);
     end;
   end;
end;

function  TF_WizardMain.GetFrameChain:  TFrameChain;
begin
 
  Result:=  FFrameChain;
end;

procedure  TF_WizardMain.BtnHelpClick(Sender:  TObject);
begin
 
  gWizardMain.FrameChain.GetCurrentFrame.DoHelp;
end;

procedure  TF_WizardMain.ShowCurrentFrame;
begin
 
  FFrameChain.GetCurrentFrame.Visible  :=  True;
   CaptionTitle.Caption  :=  FFrameChain.GetCurrentFrame.Title;
end;

constructor  TF_WizardMain.Create(AOwner:  TComponent);
begin
 
  inherited  Create(AOwner);
end;

end.
0 0

相关博文

我的热门文章

img
取 消
img