Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 1 944

/ вопрос открыт /

Здрасьте, уважаемые эксперты!
Можно ли изменить цвеет кнопки ? Свойства Button.Color я не нашел вроде. Или она всегда имеет цвет формы, на которой расположена ?

Яуген Таляныч Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Яуген Таляныч (статус: Посетитель)
Вопрос отправлен: 28 сентября 2008, 11:25
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Гена Гутницкий!
Ловите в Приложении два компонента на основе TButton:
1. ColorButton;
2. ColorBtn.

P.S. Желаю удачи.

Приложение:
  1. ColorButton.
  2. {
  3. You cannot change the color of a standard TButton,
  4. since the windows button control always paints itself with the
  5. button color defined in the control panel.
  6. But you can derive derive a new component from TButton and handle
  7. the and drawing behaviour there.
  8. }
  9.  
  10.  
  11. unit ColorButton;
  12.  
  13. interface
  14.  
  15. uses
  16. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17. StdCtrls, Buttons, ExtCtrls;
  18.  
  19. type
  20. TDrawButtonEvent = procedure(Control: TWinControl;
  21. Rect: TRect; State: TOwnerDrawState) of object;
  22.  
  23. TColorButton = class(TButton)
  24. private
  25. FCanvas: TCanvas;
  26. IsFocused: Boolean;
  27. FOnDrawButton: TDrawButtonEvent;
  28. protected
  29. procedure CreateParams(var Params: TCreateParams); override;
  30. procedure SetButtonStyle(ADefault: Boolean); override;
  31. procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  32. procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  33. procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  34. procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  35. procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  36. procedure DrawButton(Rect: TRect; State: UINT);
  37. public
  38. constructor Create(AOwner: TComponent); override;
  39. destructor Destroy; override;
  40. property Canvas: TCanvas read FCanvas;
  41. published
  42. property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
  43. property Color;
  44. end;
  45.  
  46. procedure Register;
  47.  
  48. implementation
  49.  
  50. procedure Register;
  51. begin
  52. RegisterComponents('Samples', [TColorButton]);
  53. end;
  54.  
  55. constructor TColorButton.Create(AOwner: TComponent);
  56. begin
  57. inherited Create(AOwner);
  58. FCanvas := TCanvas.Create;
  59. end;
  60.  
  61. destructor TColorButton.Destroy;
  62. begin
  63. inherited Destroy;
  64. FCanvas.Free;
  65. end;
  66.  
  67. procedure TColorButton.CreateParams(var Params: TCreateParams);
  68. begin
  69. inherited CreateParams(Params);
  70. with Params do Style := Style or BS_OWNERDRAW;
  71. end;
  72.  
  73. procedure TColorButton.SetButtonStyle(ADefault: Boolean);
  74. begin
  75. if ADefault <> IsFocused then
  76. begin
  77. IsFocused := ADefault;
  78. Refresh;
  79. end;
  80. end;
  81.  
  82. procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
  83. begin
  84. with Message.MeasureItemStruct^ do
  85. begin
  86. itemWidth := Width;
  87. itemHeight := Height;
  88. end;
  89. end;
  90.  
  91. procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
  92. var
  93. SaveIndex: Integer;
  94. begin
  95. with Message.DrawItemStruct^ do
  96. begin
  97. SaveIndex := SaveDC(hDC);
  98. FCanvas.Lock;
  99. try
  100. FCanvas.Handle := hDC;
  101. FCanvas.Font := Font;
  102. FCanvas.Brush := Brush;
  103. DrawButton(rcItem, itemState);
  104. finally
  105. FCanvas.Handle := 0;
  106. FCanvas.Unlock;
  107. RestoreDC(hDC, SaveIndex);
  108. end;
  109. end;
  110. Message.Result := 1;
  111. end;
  112.  
  113. procedure TColorButton.CMEnabledChanged(var Message: TMessage);
  114. begin
  115. inherited;
  116. Invalidate;
  117. end;
  118.  
  119. procedure TColorButton.CMFontChanged(var Message: TMessage);
  120. begin
  121. inherited;
  122. Invalidate;
  123. end;
  124.  
  125. procedure TColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  126. begin
  127. Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
  128. end;
  129.  
  130. procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
  131. var
  132. Flags, OldMode: Longint;
  133. IsDown, IsDefault, IsDisabled: Boolean;
  134. OldColor: TColor;
  135. OrgRect: TRect;
  136. begin
  137. OrgRect := Rect;
  138. Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  139. IsDown := State and ODS_SELECTED <> 0;
  140. IsDefault := State and ODS_FOCUS <> 0;
  141. IsDisabled := State and ODS_DISABLED <> 0;
  142.  
  143. if IsDown then Flags := Flags or DFCS_PUSHED;
  144. if IsDisabled then Flags := Flags or DFCS_INACTIVE;
  145.  
  146. if IsFocused or IsDefault then
  147. begin
  148. FCanvas.Pen.Color := clWindowFrame;
  149. FCanvas.Pen.Width := 1;
  150. FCanvas.Brush.Style := bsClear;
  151. FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  152. InflateRect(Rect, - 1, - 1);
  153. end;
  154.  
  155. if IsDown then
  156. begin
  157. FCanvas.Pen.Color := clBtnShadow;
  158. FCanvas.Pen.Width := 1;
  159. FCanvas.Brush.Color := clBtnFace;
  160. FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  161. InflateRect(Rect, - 1, - 1);
  162. end
  163. else
  164. DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
  165.  
  166. if IsDown then OffsetRect(Rect, 1, 1);
  167.  
  168. OldColor := FCanvas.Brush.Color;
  169. FCanvas.Brush.Color := Color;
  170. FCanvas.FillRect(Rect);
  171. FCanvas.Brush.Color := OldColor;
  172. OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
  173. FCanvas.Font.Color := clBtnText;
  174. if IsDisabled then
  175. DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
  176. ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
  177. ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
  178. 0, 0, DST_TEXT or DSS_DISABLED)
  179. else
  180. DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
  181. DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  182. SetBkMode(FCanvas.Handle, OldMode);
  183.  
  184. if Assigned(FOnDrawButton) then
  185. FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo));
  186.  
  187. if IsFocused and IsDefault then
  188. begin
  189. Rect := OrgRect;
  190. InflateRect(Rect, - 4, - 4);
  191. FCanvas.Pen.Color := clWindowFrame;
  192. FCanvas.Brush.Color := clBtnFace;
  193. DrawFocusRect(FCanvas.Handle, Rect);
  194. end;
  195. end;
  196. end.
  197.  
  198.  
  199. ColorBtn
  200. unit colorbtn;
  201.  
  202. interface
  203.  
  204. uses
  205.  
  206. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  207. StdCtrls, Buttons;
  208.  
  209. type
  210.  
  211. TColorBtn = class(TButton)
  212. private
  213. FCanvas: TCanvas;
  214. IsFocused: Boolean;
  215. F3DFrame: boolean;
  216. FButtonColor: TColor;
  217. procedure Set3DFrame(Value: boolean);
  218. procedure SetButtonColor(Value: TColor);
  219. procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  220. procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message
  221. WM_LBUTTONDBLCLK;
  222. procedure DrawButtonText(const Caption: string; TRC: TRect; State:
  223. TButtonState; BiDiFlags: Longint);
  224. procedure CalcuateTextPosition(const Caption: string; var TRC: TRect;
  225. BiDiFlags: Longint);
  226. protected
  227. procedure CreateParams(var Params: TCreateParams); override;
  228. procedure SetButtonStyle(ADefault: Boolean); override;
  229. public
  230. constructor Create(AOwner: TComponent); override;
  231. destructor Destroy; override;
  232. published
  233. property ButtonColor: TColor read FButtonColor write SetButtonColor default
  234. clBtnFace;
  235. property Frame3D: boolean read F3DFrame write Set3DFrame default False;
  236. end;
  237.  
  238. procedure Register;
  239.  
  240. implementation
  241.  
  242. { TColorBtn }
  243.  
  244. constructor TColorBtn.Create(AOwner: TComponent);
  245. begin
  246. inherited Create(AOwner);
  247. Height := 21;
  248. FCanvas := TCanvas.Create;
  249. FButtonColor := clBtnFace;
  250. F3DFrame := False;
  251. end;
  252.  
  253. destructor TColorBtn.Destroy;
  254. begin
  255. FCanvas.Free;
  256. inherited Destroy;
  257. end;
  258.  
  259. procedure TColorBtn.CreateParams(var Params: TCreateParams);
  260. begin
  261. inherited CreateParams(Params);
  262. with Params do
  263. Style := Style or BS_OWNERDRAW;
  264. end;
  265.  
  266. procedure TColorBtn.Set3DFrame(Value: boolean);
  267. begin
  268. if F3DFrame <> Value then
  269. F3DFrame := Value;
  270. end;
  271.  
  272. procedure TColorBtn.SetButtonColor(Value: TColor);
  273. begin
  274. if FButtonColor <> Value then
  275. begin
  276. FButtonColor := Value;
  277. Invalidate;
  278. end;
  279. end;
  280.  
  281. procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  282. begin
  283. Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
  284. end;
  285.  
  286. procedure TColorBtn.SetButtonStyle(ADefault: Boolean);
  287. begin
  288. if IsFocused <> ADefault then
  289. IsFocused := ADefault;
  290. end;
  291.  
  292. procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem);
  293. var
  294. RC: TRect;
  295. Flags: Longint;
  296. State: TButtonState;
  297. IsDown, IsDefault: Boolean;
  298. DrawItemStruct: TDrawItemStruct;
  299. begin
  300. DrawItemStruct := Message.DrawItemStruct^;
  301. FCanvas.Handle := DrawItemStruct.HDC;
  302. RC := ClientRect;
  303. with DrawItemStruct do
  304. begin
  305. IsDown := ItemState and ODS_SELECTED <> 0;
  306. IsDefault := ItemState and ODS_FOCUS <> 0;
  307. if not Enabled then
  308. State := bsDisabled
  309. else if IsDown then
  310. State := bsDown
  311. else
  312. State := bsUp;
  313. end;
  314. Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  315. if IsDown then
  316. Flags := Flags or DFCS_PUSHED;
  317. if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then
  318. Flags := Flags or DFCS_INACTIVE;
  319. if IsFocused or IsDefault then
  320. begin
  321. FCanvas.Pen.Color := clWindowFrame;
  322. FCanvas.Pen.Width := 1;
  323. FCanvas.Brush.Style := bsClear;
  324. FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
  325. InflateRect(RC, -1, -1);
  326. end;
  327. if IsDown then
  328. begin
  329. FCanvas.Pen.Color := clBtnShadow;
  330. FCanvas.Pen.Width := 1;
  331. FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
  332. InflateRect(RC, -1, -1);
  333. if F3DFrame then
  334. begin
  335. FCanvas.Pen.Color := FButtonColor;
  336. FCanvas.Pen.Width := 1;
  337. DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
  338. end;
  339. end
  340. else
  341. DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
  342. FCanvas.Brush.Color := FButtonColor;
  343. FCanvas.FillRect(RC);
  344. InflateRect(RC, 1, 1);
  345. if IsFocused then
  346. begin
  347. RC := ClientRect;
  348. InflateRect(RC, -1, -1);
  349. end;
  350. FCanvas.Font := Self.Font;
  351. if IsDown then
  352. OffsetRect(RC, 1, 1);
  353. DrawButtonText(Caption, RC, State, 0);
  354. if IsFocused and IsDefault then
  355. begin
  356. RC := ClientRect;
  357. InflateRect(RC, -4, -4);
  358. FCanvas.Pen.Color := clWindowFrame;
  359. Windows.DrawFocusRect(FCanvas.Handle, RC);
  360. end;
  361. FCanvas.Handle := 0;
  362. end;
  363.  
  364. procedure TColorBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect;
  365. BiDiFlags: Integer);
  366. var
  367. TB: TRect;
  368. TS, TP: TPoint;
  369. begin
  370. with FCanvas do
  371. begin
  372. TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom);
  373. DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or
  374. BiDiFlags);
  375. TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top);
  376. TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2;
  377. TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2;
  378. OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top);
  379. TRC := TB;
  380. end;
  381. end;
  382.  
  383. procedure TColorBtn.DrawButtonText(const Caption: string; TRC: TRect; State:
  384. TButtonState; BiDiFlags: Integer);
  385. begin
  386. with FCanvas do
  387. begin
  388. CalcuateTextPosition(Caption, TRC, BiDiFlags);
  389. Brush.Style := bsClear;
  390. if State = bsDisabled then
  391. begin
  392. OffsetRect(TRC, 1, 1);
  393. Font.Color := clBtnHighlight;
  394. DrawText(Handle, PChar(Caption), Length(Caption), TRC,
  395. DT_CENTER or DT_VCENTER or BiDiFlags);
  396. OffsetRect(TRC, -1, -1);
  397. Font.Color := clBtnShadow;
  398. DrawText(Handle, PChar(Caption), Length(Caption), TRC,
  399. DT_CENTER or DT_VCENTER or BiDiFlags);
  400. end
  401. else
  402. DrawText(Handle, PChar(Caption), Length(Caption), TRC,
  403. DT_CENTER or DT_VCENTER or BiDiFlags);
  404. end;
  405. end;
  406.  
  407. procedure Register;
  408. begin
  409. RegisterComponents('Controls', [TColorBtn]);
  410. end;
  411.  
  412. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 29 сентября 2008, 13:37
Оценка за ответ: 4


Мини-форум вопроса

Всего сообщений: 9; последнее сообщение — 30 сентября 2008, 08:37; участников в обсуждении: 5.
Dron

Dron (статус: Студент), 28 сентября 2008, 12:48 [#1]:

У стандартных кнопок изменить цвет не получится, т.к. они отрисовываются средствами Windows. Используйте сторонние компоненты. Найти разные кнопочки - не проблема. Загляните сюда.
С уважением.
Яуген Таляныч

Яуген Таляныч (статус: Посетитель), 29 сентября 2008, 16:46 [#2]:

Что-то я не совсем разобрался в двіжке этого форума - ответов вроде 2, а пищет : 1, или это 2 части одного ответа ? Ну ладно, спасибо, приму к сведеию. Мы пойдем другим путем : добавлю прогресс-бар, тем более что я его почти освоил. В том месте, где изменяю значение переменной, буду двигать полоску бара. А вот возможно ли автоматически отслежимвать изменение какой-нибудь переменной и генерировать событие, так сказать, пользовательское ? 2 метода я придумал : а) по таймеру б) созать невидимый Edit, туда кидать изменившееся значение и по Edit1.Change на это реагировать ?
Достаточно ли сумбурно я выразился, чтоб запутать дело ? :-)
Вадим К

Вадим К (статус: Академик), 29 сентября 2008, 17:09 [#3]:

Цитата:


А вот возможно ли автоматически отслежимвать изменение какой-нибудь переменной и генерировать событие, так сказать, пользовательское

нет.

Цитата:

а и б варианты

плохие варианты. Первый вообще ужасный.
Обычно это делается так.
Создаем свою процедуру, которая будет обновлять прогресс. и вместо присваивания переменной вызываем процедуру. и всех делов.
Только если надо смотреть аккуратно, а то можно затормозить программу, если диапазон прогресса плохо выбрать
Галочка "подтверждения прочтения" - вселенское зло.
Ерёмин А.А.

Ерёмин А.А. (статус: *Администратор), 29 сентября 2008, 17:13 [#4]:

Цитата:

Что-то я не совсем разобрался в двіжке этого форума - ответов вроде 2, а пищет : 1

Где вы увидели, что 2 ответа? Ответ единственный, эксперт Feniks. Ниже идёт мини-форум.
Вадим К

Вадим К (статус: Академик), 29 сентября 2008, 17:17 [#5]:

наверно слева:)
Хотя что то я сейчас уже не понимаю, как реплика в минифоруме относиться к вопросу...
Галочка "подтверждения прочтения" - вселенское зло.
Ерёмин А.А.

Ерёмин А.А. (статус: *Администратор), 29 сентября 2008, 18:05 [#6]:

Цитата:

наверно слева:)

Слева показывается статистика за весь день. Там ведь написано: "Статистика за сегодня:".

Да, к вопросу не относится, но раз люди спрашивают, стараюсь отвечать, чтобы не оставалось непоняток.
Вадим К

Вадим К (статус: Академик), 29 сентября 2008, 18:10 [#7]:

я имел ввиду реплику от "Гена Гутницкий"
Галочка "подтверждения прочтения" - вселенское зло.
Яуген Таляныч

Яуген Таляныч (статус: Посетитель), 29 сентября 2008, 18:21 [#8]:

Теперь понял. В других форумах, где я тусуюсь, немного не такая система, потому слегка запутался. Всем еще раз спасибо, а за то, что чайника не пинаете - особо. А то бывают ответы типа "Ну ты и тупой! RTFM !" :-(
min@y™

min@y™ (статус: Доктор наук), 30 сентября 2008, 08:37 [#9]:

Автору вопроса следует заглянуть вот сюда.

Там слева вверху будет такой список ссылок:

  1. Speed Buttons
  2. MS Style Buttons
  3. Other Buttons
  4. Buttons
  5. Buttons with dialogs
  6. Animated Buttons
  7. Non-standard form
  8. Check Boxes
  9. Radio Buttons
  10. Gradient Buttons
  11. Packs
  12. Power Buttons
  13. Groups and Group Boxes


      Потыкай на них и посмотри. Всё уже придумано до нас.
      Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 22 сентября 2017, 19:50
Выполнено за 0.09 сек.
Рейтинг@Mail.ru