说明:此程序是在Delphi 10.3.3上编写和测试.

复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109unit uMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, RzButton, RzTabs, uBaseFrame; type TRzTabSheet = class(RzTabs.TRzTabSheet) public FrameClassName: String; Frame: TBaseFrame; end; TMainForm = class(TForm) PageControl: TRzPageControl; TabSheet1: TRzTabSheet; TabSheet2: TRzTabSheet; TabSheet3: TRzTabSheet; ButtonRun: TRzButton; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure PageControlChange(Sender: TObject); procedure ButtonRunClick(Sender: TObject); procedure PageControlPaintCardBackground(Sender: TObject; ACanvas: TCanvas; ARow: Integer; const ARect: TRect; var Handled: Boolean); procedure PageControlPaintTabBackground(Sender: TObject; ACanvas: TCanvas; ATabIndex: Integer; const ARect: TRect; var Handled: Boolean); private procedure WmAfterShow(var Msg: TMessage); message WM_USER; public { Public declarations } end; var MainForm: TMainForm; implementation {$R *.dfm} procedure TMainForm.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutDown := True; TabSheet1.FrameClassName := 'TFrame1'; TabSheet2.FrameClassName := 'TFrame2'; TabSheet3.FrameClassName := 'TFrame3'; end; procedure TMainForm.FormShow(Sender: TObject); begin OnShow := nil; PostMessage(Handle, WM_USER, 0, 0); end; procedure TMainForm.WmAfterShow(var Msg:TMessage); begin PageControlChange(nil); end; procedure TMainForm.PageControlChange(Sender: TObject); var Frame: TBaseFrame; FrameClass: TBaseFrameClass; TabSheet: TRzTabSheet; begin TabSheet := TRzTabSheet(PageControl.ActivePage); Frame := TabSheet.Frame; if not Assigned(Frame) then begin FrameClass := TBaseFrame.GetFrameClass(TabSheet.FrameClassName); Frame := FrameClass.Create(TabSheet); Frame.Parent := TabSheet; TabSheet.Frame := Frame; end; if Frame.RunCount = 0 then Frame.Run; end; procedure TMainForm.ButtonRunClick(Sender: TObject); begin TRzTabSheet(PageControl.ActivePage).Frame.Run; end; procedure TMainForm.PageControlPaintCardBackground(Sender: TObject; ACanvas: TCanvas; ARow: Integer; const ARect: TRect; var Handled: Boolean); begin ACanvas.Brush.Color := clRed; ACanvas.FillRect(ARect); Handled := True; end; procedure TMainForm.PageControlPaintTabBackground(Sender: TObject; ACanvas: TCanvas; ATabIndex: Integer; const ARect: TRect; var Handled: Boolean); begin if ATabIndex = PageControl.ActivePage.TabIndex then begin ACanvas.Brush.Color := clAqua; ACanvas.FillRect(ARect); Handled := True; end; end; end.
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71object MainForm: TMainForm Left = 0 Top = 0 Caption = 'MainForm' ClientHeight = 273 ClientWidth = 489 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate OnShow = FormShow DesignSize = ( 489 273) PixelsPerInch = 96 TextHeight = 13 object PageControl: TRzPageControl Left = 8 Top = 8 Width = 476 Height = 260 Hint = '' ActivePage = TabSheet1 Anchors = [akLeft, akTop, akRight, akBottom] Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = #24494#36719#38597#40657 Font.Style = [] ParentFont = False TabIndex = 0 TabOrder = 0 TabStyle = tsDoubleSlant OnChange = PageControlChange OnPaintCardBackground = PageControlPaintCardBackground OnPaintTabBackground = PageControlPaintTabBackground ExplicitWidth = 804 ExplicitHeight = 438 FixedDimension = 25 object TabSheet1: TRzTabSheet Caption = 'TabSheet1' ExplicitWidth = 669 ExplicitHeight = 353 end object TabSheet2: TRzTabSheet ImageIndex = 1 Caption = 'TabSheet2' ExplicitWidth = 992 ExplicitHeight = 562 end object TabSheet3: TRzTabSheet ImageIndex = 2 Caption = 'TabSheet3' ExplicitWidth = 992 ExplicitHeight = 562 end end object ButtonRun: TRzButton Left = 339 Top = 5 Caption = 'Run' HotTrack = True TabOrder = 1 OnClick = ButtonRunClick end end
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48unit uBaseFrame; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs; type TBaseFrameClass = class of TBaseFrame; TBaseFrame = class(TFrame) public class function GetFrameClass(aClassName: String): TBaseFrameClass; public RunCount: Integer; procedure Run; virtual; constructor Create(aComponent : TComponent); override; end; implementation {$R *.dfm} constructor TBaseFrame.Create; begin inherited; RunCount := 0; end; procedure TBaseFrame.Run; begin Inc(RunCount); end; class function TBaseFrame.GetFrameClass(aClassName: String): TBaseFrameClass; var MetaClass: TClass; begin Result := nil; MetaClass := FindClass(aClassName); if MetaClass.InheritsFrom(TBaseFrame) then Result := TBaseFrameClass(MetaClass) else Exception.Create(aClassName + '不是TBaseFrame的子类'); end; end.
复制代码
1
2
3
4
5
6
7
8object BaseFrame: TBaseFrame Left = 0 Top = 0 Width = 320 Height = 240 Align = alClient TabOrder = 0 end
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36unit uFrame1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uBaseFrame, Vcl.StdCtrls; type TFrame1 = class(TBaseFrame) Label1: TLabel; private { Private declarations } public procedure Run; override; end; var Frame1: TFrame1; implementation {$R *.dfm} procedure TFrame1.Run; begin inherited; ShowMessage('Frame1的工作任务已运行' + RunCount.ToString + '次'); end; initialization RegisterClass(TFrame1); end.
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15inherited Frame1: TFrame1 object Label1: TLabel Left = 128 Top = 112 Width = 67 Height = 24 Caption = 'Frame1' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -20 Font.Name = 'Tahoma' Font.Style = [] ParentFont = False end end
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36unit uFrame2; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uBaseFrame, Vcl.StdCtrls; type TFrame2 = class(TBaseFrame) Label1: TLabel; private { Private declarations } public procedure Run; override; end; var Frame2: TFrame2; implementation {$R *.dfm} procedure TFrame2.Run; begin inherited; ShowMessage('Frame2的工作任务已运行' + RunCount.ToString + '次'); end; initialization RegisterClass(TFrame2); end.
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15inherited Frame2: TFrame2 object Label1: TLabel Left = 128 Top = 112 Width = 67 Height = 24 Caption = 'Frame2' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -20 Font.Name = 'Tahoma' Font.Style = [] ParentFont = False end end
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36unit uFrame3; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uBaseFrame, Vcl.StdCtrls; type TFrame3 = class(TBaseFrame) Label1: TLabel; private { Private declarations } public procedure Run; override; end; var Frame3: TFrame3; implementation {$R *.dfm} procedure TFrame3.Run; begin inherited; ShowMessage('Frame3的工作任务已运行' + RunCount.ToString + '次'); end; initialization RegisterClass(TFrame3); end.
复制代码
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15inherited Frame3: TFrame3 object Label1: TLabel Left = 128 Top = 112 Width = 67 Height = 24 Caption = 'Frame3' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -20 Font.Name = 'Tahoma' Font.Style = [] ParentFont = False end end
最后
以上就是精明画板最近收集整理的关于【Delphi Frame 使用示范】的全部内容,更多相关【Delphi内容请搜索靠谱客的其他文章。
本图文内容来源于网友提供,作为学习参考使用,或来自网络收集整理,版权属于原作者所有。
发表评论 取消回复