Вечер добрый. Имеется программа. Где используются пакеты BPL. Они вызываются в основной программе и их много. Так суть в том, что в каждом пакете, есть по паре PageControl и в них надо во всех сделать жирный шрифт у заголовком
Кликните здесь для просмотра всего текста
| Delphi |
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
| procedure TPageControl.DrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
var
S: string;
ThisRect: TRect;
begin
with Control.Canvas do begin
if Active then
begin
Font.Style := [fsBold];
Font.Size:=30;
end;
ThisRect:= Rect;
DrawText(Handle, PWideChar((Control As TPageControl).Pages[TabIndex].Caption),
Length((Control As TPageControl).Pages[TabIndex].Caption),
ThisRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER );
end;
end;
end. |
|
Делаю, я это с помощью события DrawTab у PageControl, и все бы хорошо, но добавлять код в каждом пакете не очень. Как это можно сделать через наследование классов. Сделать класс наследник от TPageControl и у него изменить событие. Но я не понимаю как его потом вызвать
Добавлено через 23 часа 52 минуты
Решено.
Кликните здесь для просмотра всего текста
| Delphi |
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
109
110
111
112
| unit SGPageControl;
interface
uses Classes, Windows, ComCtrls, Graphics;
type
PageCon = class (TPageControl)
private
protected
procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); override;
published
property ActivePage;
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HotTrack;
property Images;
property MultiLine;
property OwnerDraw;
property ParentBiDiMode;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RaggedRight;
property ScrollOpposite;
property ShowHint;
property Style;
property TabHeight;
property TabIndex stored False;
property TabOrder;
property TabPosition;
property TabStop;
property TabWidth;
property Visible;
property OnChange;
property OnChanging;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnDrawTab;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnGetSiteInfo;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Kom', [PageCon]);
end;
{
Процедура изменения толщины текста.
}
procedure PageCon.DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
ThisRect: TRect;
begin
inherited;
with self.Canvas do
begin
if TabIndex >= 0 then
begin
if Active then
begin
//У активного таба делаем текст bold и уменьшаем размер шрифта т.к он не помещается в него
Font.Style := [fsBold];
Font.Size := 11;
end
else
begin
//Делаем текст обычным
Font.Style := [];
end;
ThisRect:= Rect;
DrawText(Handle, PWideChar((self As TPageControl).Pages[TabIndex].Caption),
Length((self As TPageControl).Pages[TabIndex].Caption),
ThisRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER );
end;
end;
end;
end. |
|
(
