Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 8 мая!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Изменить цвет TButton


 {
   You cannot change the color of a standard TButton,
   since the windows button control always paints itself with the
   button color defined in the control panel.
   But you can derive derive a new component from TButton and handle
   the and drawing behaviour there.
 }
 
 
 unit ColorButton;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Buttons, ExtCtrls;
 
 type
   TDrawButtonEvent = procedure(Control: TWinControl;
     Rect: TRect; State: TOwnerDrawState) of object;
 
   TColorButton = class(TButton)
   private
     FCanvas: TCanvas;
     IsFocused: Boolean;
     FOnDrawButton: TDrawButtonEvent;
   protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure SetButtonStyle(ADefault: Boolean); override;
     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;
     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
     procedure DrawButton(Rect: TRect; State: UINT);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property Canvas: TCanvas read FCanvas;
   published
     property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
     property Color;
   end;
 
 procedure Register;
 
 implementation
 
 procedure Register;
 begin
   RegisterComponents('Samples', [TColorButton]);
 end;
 
 constructor TColorButton.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FCanvas := TCanvas.Create;
 end;
 
 destructor TColorButton.Destroy;
 begin
   inherited Destroy;
   FCanvas.Free;
 end;
 
 procedure TColorButton.CreateParams(var Params: TCreateParams);
 begin
   inherited CreateParams(Params);
   with Params do Style := Style or BS_OWNERDRAW;
 end;
 
 procedure TColorButton.SetButtonStyle(ADefault: Boolean);
 begin
   if ADefault <> IsFocused then
   begin
     IsFocused := ADefault;
     Refresh;
   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.WMLButtonDblClk(var Message: TWMLButtonDblClk);
 begin
   Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
 end;
 
 procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
 var
   Flags, OldMode: Longint;
   IsDown, IsDefault, IsDisabled: Boolean;
   OldColor: TColor;
   OrgRect: TRect;
 begin
   OrgRect := Rect;
   Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
   IsDown := State and ODS_SELECTED <> 0;
   IsDefault := State and ODS_FOCUS <> 0;
   IsDisabled := State and ODS_DISABLED <> 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
     DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
 
   if IsDown then OffsetRect(Rect, 1, 1);
 
   OldColor := FCanvas.Brush.Color;
   FCanvas.Brush.Color := Color;
   FCanvas.FillRect(Rect);
   FCanvas.Brush.Color := OldColor;
   OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
   FCanvas.Font.Color := clBtnText;
   if IsDisabled then
     DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
     ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
     ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
       0, 0, DST_TEXT or DSS_DISABLED)
   else
     DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
       DT_SINGLELINE or DT_CENTER or DT_VCENTER);
   SetBkMode(FCanvas.Handle, OldMode);
 
   if Assigned(FOnDrawButton) then
     FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo));
 
   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;
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS