Wizard Frame Delphi implementation

zhaozj2021-02-16  56

Example picture

Design goals

Each page that can be purchased convenient design wizard will not be very cumbersome

?

Download Example WizardFramework

Way of use

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 {è ?? μ} showmes Sage (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} {TBA seFrame} 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]; 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 (Filterclass.create; end; end; procedure tfilterlist.register (AfilterClass: tfilterclassItem); var index: integer; begin index: = FIIT ems.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) .Index;

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: TBASE FrameClass; 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 .Pa canelframe; FFRA me.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] ); function tframechain.getframe (aname: string): TBASEFrame; var index: integer; begin result: = nil; index: = fitems.indexof (aname); if index <> -1 the 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 the begin fcursor: = false end -1; result: = false end else begin result: = true; gwizardmain.btncel.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.enab LED: = 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; Fonfinish: tnotifyeent; 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 FF rameChain.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

转载请注明原文地址:https://www.9cbs.com/read-19814.html

New Post(0)