Delphi: изменение цвета кнопки с помощью помощника класса

Question

Мне нужно изменить визуальный стиль элементов управления delphi формы, чтобы показать их из среды .NET. Для этого мне нужно изменить цвета элементов управления delphi на синий ($ 00FCF5EE). Я использовал элементы управления «TButton», которые не имеют свойства «Цвет». Поэтому вместо изменения кнопок на кнопки скорости я пробовал другой подход, введя родительскую форму и наследуя все остальные формы от этого родителя форма. В родительской форме у меня есть помощник класса для изменения цвета кнопок. Вот код: (я использую Delphi 2007)

TButtonHelper=class helper for TButton 
private 
    procedure doChangeColor; 
public 
    procedure DrawChangeColor; 
end; 

TParentForm = class(TForm) 
public 
    procedure AfterConstruction; override; 
end; 

И в секции реализации, у меня есть

procedure TButtonHelper.doChangeColor; 
    var 
     SaveIndex: Integer; 
     FCanvas:TCanvas; 
     rect:TRect; 
    begin 
     if csDestroying in ComponentState then exit; 
     FCanvas:=TCanvas.Create; 

     SaveIndex := SaveDC(Self.Handle); 
     FCanvas.Lock; 
     try 
      FCanvas.Handle := Handle; 
      FCanvas.Font := Font; 
      FCanvas.Brush := self.Brush; 
      FCanvas.Brush.Color:=$00FCF5EE; 
      FCanvas.FillRect(BoundsRect);//Omitting the code to draw the text 
     finally 
      FCanvas.Handle := 0; 
      FCanvas.Unlock; 
      RestoreDC(handle, SaveIndex); 
      FCanvas.Free; 
     end; 
    end; 


    procedure TButtonHelper.DrawChangeColor; 
    begin 
     doChangeColor; 
     self.Repaint; 
    end; 

procedure TParentForm.AfterConstruction; 
    var 
    i : Integer; 
    wc: TControl; 
    begin 
     inherited; 
     for i := 0 to self.ControlCount - 1 do begin 
     wc:=Controls[i]; 
     if wc is TButton then 
      TButton(wc).DrawChangeColor; 
     end; 
    end; 

Но это не работает. Хотя метод doChangeColor выполняется, он не меняет цвет кнопки. Пожалуйста, дайте мне знать, чего я здесь не вижу.

Поблагодарив всех вас,

Прадипом

Answer 1

вот класс, который добавляет свойства цвета к стандартному TButton:

unit u_class_colorbutton; 

interface 

uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls; 

type 
    TColorButton = class(TButton) 
    private 
    ShowBackColor : Boolean; 
    FCanvas  : TCanvas; 
    IsFocused  : Boolean; 
    FBackColor  : TColor; 
    FForeColor  : TColor; 
    FHoverColor : TColor; 
    procedure SetBackColor(const Value: TColor); 
    procedure SetForeColor(const Value: TColor); 
    procedure SetHoverColor(const Value: TColor); 
    protected 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure WndProc(var Message : TMessage); override; 

    procedure SetButtonStyle(Value: Boolean); override; 
    procedure DrawButton(Rect: TRect; State: UINT); 

    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; 
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; 
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    published 
    property BackColor : TColor read FBackColor write SetBackColor default clBtnFace; 
    property ForeColor : TColor read FForeColor write SetForeColor default clBtnText; 
    property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace; 
    end; 

procedure Register; 

implementation 

constructor TColorButton.Create(AOwner: TComponent); 
begin 
inherited Create(AOwner); 
ShowBackColor := True; 
FCanvas := TCanvas.Create; 
BackColor := clBtnFace; 
ForeColor := clBtnText; 
HoverColor := clBtnFace; 
end; 

destructor TColorButton.Destroy; 
begin 
FreeAndNil(FCanvas); 
inherited Destroy; 
end; 

procedure TColorButton.WndProc(var Message : TMessage); 
begin 
if (Message.Msg = CM_MOUSELEAVE) then 
    begin 
    ShowBackColor := True; 
    Invalidate; 
    end; 
if (Message.Msg = CM_MOUSEENTER) then 
    begin 
    ShowBackColor := False; 
    Invalidate; 
    end; 
inherited; 
end; 

procedure TColorButton.CreateParams(var Params: TCreateParams); 
begin 
inherited CreateParams(Params); 
    with Params do 
    Style := Style or BS_OWNERDRAW; 
end; 

procedure TColorButton.SetButtonStyle(Value: Boolean); 
begin 
if Value <> IsFocused then 
    begin 
    IsFocused := Value; 
    Invalidate; 
    end; 
end; 

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem); 
begin 
with Message.MeasureItemStruct^ do 
    begin 
    itemWidth := Width; 
    itemHeight := Height; 
    end; 
end; 

procedure TColorButton.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; 

procedure TColorButton.CMEnabledChanged(var Message: TMessage); 
begin 
inherited; 
Invalidate; 
end; 

procedure TColorButton.CMFontChanged(var Message: TMessage); 
begin 
inherited; 
Invalidate; 
end; 

procedure TColorButton.SetBackColor(const Value: TColor); 
begin 
if FBackColor <> Value then 
    begin 
    FBackColor:= Value; 
    Invalidate; 
    end; 
end; 

procedure TColorButton.SetForeColor(const Value: TColor); 
begin 
if FForeColor <> Value then 
    begin 
    FForeColor:= Value; 
    Invalidate; 
    end; 
end; 

procedure TColorButton.SetHoverColor(const Value: TColor); 
begin 
if FHoverColor <> Value then 
    begin 
    FHoverColor:= Value; 
    Invalidate; 
    end; 
end; 

procedure TColorButton.DrawButton(Rect: TRect; State: UINT); 

var Flags, OldMode: Longint; 
    IsDown, IsDefault, IsDisabled: Boolean; 
    OldColor: TColor; 
    OrgRect: TRect; 
    NewCaption : string; 

begin 
NewCaption := Caption; 
OrgRect := Rect; 
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
IsDown := State and ODS_SELECTED <> 0; 
IsDisabled := State and ODS_DISABLED <> 0; 
IsDefault := State and ODS_FOCUS <> 0; 

if IsDown then Flags := Flags or DFCS_PUSHED; 
if IsDisabled then Flags := Flags or DFCS_INACTIVE; 

if (IsFocused or IsDefault) then 
    begin 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Style := bsClear; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
    end; 

    if IsDown then 
    begin 
    FCanvas.Pen.Color := clBtnShadow; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Color := clBtnFace; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
    end 
else 
    begin 
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 
    end; 

    if IsDown then OffsetRect(Rect, 1, 1); 

    OldColor := FCanvas.Brush.Color; 
    if ShowBackColor then 
    FCanvas.Brush.Color := BackColor 
    else 
    FCanvas.Brush.Color := HoverColor; 
    FCanvas.FillRect(Rect); 
    FCanvas.Brush.Color := OldColor; 
    OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
    FCanvas.Font.Color := ForeColor; 
    if IsDisabled then 
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(NewCaption), 0, 
      ((Rect.Right - Rect.Left) - FCanvas.TextWidth(NewCaption)) div 2, 
      ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(NewCaption)) div 2, 
      0, 0, DST_TEXT or DSS_DISABLED) 
    else 
    begin 
    InflateRect(Rect, -4, -4); 
    DrawText(FCanvas.Handle, PChar(NewCaption), - 1, Rect, DT_WORDBREAK or DT_CENTER); 
    end; 

    SetBkMode(FCanvas.Handle, OldMode); 

if (IsFocused and IsDefault) then 
    begin 
    Rect := OrgRect; 
    InflateRect(Rect, - 4, - 4); 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Brush.Color := clBtnFace; 
    DrawFocusRect(FCanvas.Handle, Rect); 
    end; 
end; 

procedure Register; 
begin 
    RegisterComponents('Standard', [TColorButton]); 
end; 

initialization 
    RegisterClass(TColorButton); // needed for persistence at runtime 


end. 

Вы можете взломать его в приложение легко: найти/заменить все TButton ссылается на TColorButton внутри ваших .pas и .dfm файлов. Вы можете установить отдельные цвета для фона, шрифта и зависания.

Если вы хотите добавить приложение для стилизации широким, возможно, лучше создать графический интерфейс с библиотекой, которая имеет встроенную поддержку, такую ​​как DevExpress, TMS, ... Лично мне больше нравится DevExpress, но это вопрос личного вкуса ,