Тема: TButton
Показать сообщение отдельно
  #6  
Старый 03.01.2011, 11:07
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 663
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Если вопрос о потомке TButton, которому можно задать цвет, то:
PHP код:
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
('DelphiSources', [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. 
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием