Форум программистов, компьютерный форум, киберфорум
Delphi
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.82/11: Рейтинг темы: голосов - 11, средняя оценка - 4.82
4 / 4 / 3
Регистрация: 09.10.2013
Сообщений: 42
1

Свойства компонента VLC в Design- и Run-Time

21.02.2014, 10:37. Показов 1942. Ответов 6
Метки нет (Все метки)

Доброго времени дня.
Пишу свой простенький компонент - цветную кнопку для VCL. По задумке кнопка должна иметь три состояния - обычное, нажатое и "мышь над кнопкой". Для каждого из состояний нужно задавать цвет фона, цвет шрифта и параметры границ. Чтобы не загружать инспектор свойств лишними строками, хочу сгруппировать эти параметры в три группы (NormalButtonStyle, HoverButtonStyle и DownButtonStyle). Для этого создаю соответствующий класс (TMyButtonStyle) и добавляю указанные свойства. В Design-time всё работает отлично - изменение этих свойств меняет внешний вид кнопки, но в Run-Time кнопка создаётся с цветами, заданными в конструкторе класса TMyButton, будто бы настройки цветов через инспектор свойств и не было. Разумеется, если назначать цвета в Run-time, всё хорошо работает. Если я убираю из конструктора присвоение значений по-умолчанию, все цвета приводятся к clBlack, т.е. установки Object Inspector'а также не сохраняются.
Подскажите, что я делаю не так для группировки свойств объекта, и как это исправить?

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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
unit MyButton;
 
interface
 
uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Graphics,
  Messages, Windows;
 
type
  TMyButtonStyle = class(TPersistent)
    private
      fBackgroundColor: TColor;
      fFontColor: TColor;
      FOnChange : TNotifyEvent;
      procedure SetColor(const Value: TColor);
      procedure SetFontColor(const Value: TColor);
    public
      constructor Create;
      property OnChange: TNotifyEvent read fOnChange write fOnChange;
    published
      property BackgroundColor: TColor read fBackgroundColor write SetColor;
      property FontColor: TColor read fFontColor write SetFontColor;
  end;
 
  TMyButton = class(TButton)
  private
    { Private declarations }
    FCanvas: TCanvas;
    IsFocused: Boolean;
    IsHovered: Boolean;
    fNormalButtonStyle: TMyButtonStyle;
    fHoverButtonStyle: TMyButtonStyle;
    fDownButtonStyle: TMyButtonStyle;
    procedure UpdateColors(Sender: TObject);
  protected
    { Protected declarations }
    procedure DrawButton(Rect: TRect; State: UINT);
    procedure WndProc(var Message : TMessage); override;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(Value: Boolean); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property NormalButtonStyle: TMyButtonStyle read fNormalButtonStyle write fNormalButtonStyle;
    property HoverButtonStyle: TMyButtonStyle read fHoverButtonStyle write fHoverButtonStyle;
    property DownButtonStyle: TMyButtonStyle read fDownButtonStyle write fDownButtonStyle;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TMyButton]);
end;
 
{ TMyButton }
 
procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Lock;
    try
      FCanvas.Handle := hDC;
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
end;
 
constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  fNormalButtonStyle := TMyButtonStyle.Create;
  fNormalButtonStyle.OnChange := UpdateColors;
  fNormalButtonStyle.BackgroundColor := clGray;
  fNormalButtonStyle.FontColor := clWhite;
  fHoverButtonStyle := TMyButtonStyle.Create;
  fHoverButtonStyle.OnChange := UpdateColors;
  fHoverButtonStyle.BackgroundColor := clSilver;
  fHoverButtonStyle.FontColor := clBlack;
  fDownButtonStyle := TMyButtonStyle.Create;
  fDownButtonStyle.OnChange := UpdateColors;
  fDownButtonStyle.BackgroundColor := clBlack;
  fDownButtonStyle.FontColor := clWhite;
end;
 
procedure TMyButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;
 
destructor TMyButton.Destroy;
begin
  FCanvas.Free;
  FreeAndNil(fNormalButtonStyle);
  FreeAndNil(fHoverButtonStyle);
  FreeAndNil(fDownButtonStyle);
  inherited Destroy;
end;
 
procedure TMyButton.DrawButton(Rect: TRect; State: UINT);
var
  IsDown, IsDefault: Boolean;
  OriginalRect: TRect;
begin
  OriginalRect := Rect;
  IsDown := State and ODS_SELECTED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;
  FCanvas.Brush.Style := bsClear;
  FCanvas.FillRect(Rect);
  InflateRect(Rect, -2, -2);
  if IsDown then begin
    FCanvas.Brush.Color := DownButtonStyle.BackgroundColor;
    FCanvas.Font.Color := DownButtonStyle.FontColor;
  end else begin
    if IsHovered then begin
      FCanvas.Brush.Color := HoverButtonStyle.BackgroundColor;
      FCanvas.Font.Color := HoverButtonStyle.FontColor;
    end else begin
      FCanvas.Brush.Color := NormalButtonStyle.BackgroundColor;
      FCanvas.Font.Color := NormalButtonStyle.FontColor;
    end;
  end;
  FCanvas.Brush.Style := bsSolid;
  FCanvas.FillRect(Rect);
  DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  if IsFocused and IsDefault then begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Style := bsClear;
    DrawFocusRect(FCanvas.Handle, OriginalRect);
  end;
end;
 
procedure TMyButton.SetButtonStyle(Value: Boolean);
begin
  if Value <> IsFocused then
  begin
    IsFocused := Value;
    Invalidate;
  end;
end;
 
procedure TMyButton.UpdateColors(Sender: TObject);
begin
  Invalidate;
end;
 
procedure TMyButton.WndProc(var Message: TMessage);
begin
  if (Message.Msg = CM_MOUSELEAVE) then begin
    IsHovered := false;
    invalidate;
  end;
  if (Message.Msg = CM_MOUSEENTER) then begin
    IsHovered := true;
    invalidate;
  end;
  inherited;
end;
 
{ TMyButtonStyle }
 
constructor TMyButtonStyle.Create;
begin
  fBackgroundColor := clBtnFace;
  fFontColor := clBtnText;
end;
 
procedure TMyButtonStyle.SetColor(const Value: TColor);
begin
  if fBackgroundColor = Value then Exit;
  fBackgroundColor:= Value;
  if Assigned(fOnChange) then fOnChange(Self);
end;
 
procedure TMyButtonStyle.SetFontColor(const Value: TColor);
begin
  if fFontColor = Value then Exit;
  fFontColor:= Value;
  if Assigned(fOnChange) then fOnChange(Self);
end;
 
end.
Добавлено через 7 часов 48 минут
Разобрался сам.
Для исправления ошибки достаточно переопределить в классе TMyButtonStyle процедуру Assign(Source: TPersistent), в которой произвести ручное присвоение свойств передаваемого объекта полям класса. После этого всё начинает замечательно работать.

Delphi
1
2
3
4
5
6
7
procedure TMyButtonStyle.Assign(Source: TPersistent);
begin
  if (Source is TMyButtonStyle) then begin
    BackgroundColor := (Source as TMyButtonStyle).BackgroundColor;
    FontColor := (Source as TMyButtonStyle).FontColor;
  end else inherited;
end;
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
21.02.2014, 10:37
Ответы с готовыми решениями:

Разница в координатах в run-time и design-time
Может кто-нибудь объяснить почему координаты любого объекта(например Tshape) отличаются во время...

Разница в координатах в run-time и design-time
Может кто-нибудь объяснить почему координаты любого объекта(например Tshape) отличаются во время...

Создание компонента и события в run time
pnl : TPanel; begin inherited; pnl := TPanel.Create(self); pnl.Parent :=...

Run-time error '7777' неправильное использование свойства ListIndex
Добрый день. Возникает вышеприведенная ошибка при попытке выделять строку listbox. Не могу...

6
пофигист широкого профиля
4305 / 2823 / 798
Регистрация: 15.07.2013
Сообщений: 16,355
21.02.2014, 11:13 2
Цитата Сообщение от Phantomouse Посмотреть сообщение
Для исправления ошибки достаточно переопределить в классе TMyButtonStyle процедуру Assign
А может правильнее было написать свою процедуру Loaded?
0
4 / 4 / 3
Регистрация: 09.10.2013
Сообщений: 42
21.02.2014, 11:17  [ТС] 3
Не совсем понимаю как в Loaded попадёт информация об установленных в Object Inspector'е параметрах.
0
Модератор
3475 / 2599 / 740
Регистрация: 19.09.2012
Сообщений: 7,966
21.02.2014, 15:31 4
Можно так сделать:
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
unit MyButton;
 
interface
 
{...}
 
  TMyButton = class(TButton)
  private
    {...}
    fArrButtonStyle: array[0..3] of TMyButtonStyle;
  protected
    {...}
    procedure ChangeButtonStyle(Index: Integer; Value: TMyButtonStyle);
  public
    {...}
  published
    property NormalButtonStyle: TMyButtonStyle Index 0 read fArrButtonStyle[0] write ChangeButtonStyle;
    property HoverButtonStyle: TMyButtonStyle Index 1 read fArrButtonStyle[1] write ChangeButtonStyle;
    property DownButtonStyle: TMyButtonStyle Index 2 read fArrButtonStyle[2] write ChangeButtonStyle;
  end;
 
{...}
 
procedure TMyButton.ChangeButtonStyle(Index: Integer; Value: TMyButtonStyle);
begin
  fArrButtonStyle[Index].BackgroundColor := Value.BackgroundColor;
  fArrButtonStyle[Index].FontColor := Value.FontColor;
end;
 
constructor TMyButton.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  for i := 0 to 3 do
  begin
    fArrButtonStyle[i] := TMyButtonStyle.Create;
    fArrButtonStyle[i].OnChange := UpdateColors;
    fArrButtonStyle[i].BackgroundColor := clGray;
    fArrButtonStyle[i].FontColor := clWhite;
  end;
end;
 
destructor TMyButton.Destroy;
var
  i: Integer;
begin
  FCanvas.Free;
  for i := 0 to 3 do
    FreeAndNil(fArrButtonStyle[i]);
  inherited Destroy;
end;
 
{...}
 
end.
0
4 / 4 / 3
Регистрация: 09.10.2013
Сообщений: 42
21.02.2014, 15:48  [ТС] 5
Можно, но будет ли перебор свойств по индексу работать быстрее прямого обращения?
0
Модератор
3475 / 2599 / 740
Регистрация: 19.09.2012
Сообщений: 7,966
21.02.2014, 16:34 6
Там нет никакого перебора св-в по индексу.
Index - это просто константа, которую можно передать в ф-цию чтения/записи в качестве параметра.
0
480 / 253 / 51
Регистрация: 30.06.2010
Сообщений: 651
22.02.2014, 14:42 7
Мне почему-то думается, что пропущен RegisterClass для TMyButtonStyle. Из-за этого стриминговая система просто не инициализирует объект при построении из файла, он остаётся дефолтно-настроенным. А Assign уже костыль, имхо.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
22.02.2014, 14:42

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Compile-time и run-time методы и функции
Добрый день. Есть две функции, которые делают идентичную работу: template&lt;bool leftShift,...

Нет формы в design-time
Здравствуйте! Странная штука произошла с проектом. В редакторе пропала форма. То есть код видно, а...

Переключение TabControl в Design-Time
Доброго времени суток! Перетащил проект на РАД10, выпустил уже пару новых версий проги, и...

Design-Time Errors in the Windows Forms Designer
Программа с формами работает, появляется картинка в последней форме, закрываю и снова открываю окно...

Имеют ли Design-time controls в MSInterDev широкое применение?
Имеют ли Design-time controls в MSInterDev широкое применение? Или народ предпочитает вручную? -...

Изменение свойства у CheckBox в Design
Глупый вопрос. :) Есть CheckBox. &lt;CheckBox Name=&quot;TSSetMaterial&quot; Grid.Row=&quot;0&quot;...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.