Тема: 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
MessagesSysUtilsClassesGraphicsControlsFormsDialogs
  
StdCtrlsButtonsExtCtrls

type 
  TDrawButtonEvent 
procedure(ControlTWinControl
  
RectTRectStateTOwnerDrawStateof object;

  
TColorButton = class(TButton)
  private 
    
FCanvasTCanvas
    
IsFocusedBoolean
    
FOnDrawButtonTDrawButtonEvent
  protected 
    
procedure CreateParams(var ParamsTCreateParams); override
    
procedure SetButtonStyle(ADefaultBoolean); override
    
procedure CMEnabledChanged(var MessageTMessage); message CM_ENABLEDCHANGED
    
procedure CMFontChanged(var MessageTMessage); message CM_FONTCHANGED
    
procedure CNMeasureItem(var MessageTWMMeasureItem); message CN_MEASUREITEM
    
procedure CNDrawItem(var MessageTWMDrawItem); message CN_DRAWITEM
    
procedure WMLButtonDblClk(var MessageTWMLButtonDblClk); message WM_LBUTTONDBLCLK
    
procedure DrawButton(RectTRectStateUINT); 
  public 
    
constructor Create(AOwnerTComponent); override
    
destructor Destroyoverride
    
property CanvasTCanvas 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(AOwnerTComponent); 
begin 
  inherited Create
(AOwner); 
  
FCanvas := TCanvas.Create
end

destructor TColorButton.Destroy
begin 
  inherited Destroy

  
FCanvas.Free
end

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

procedure TColorButton.SetButtonStyle(ADefaultBoolean); 
begin 
  
if ADefault <> IsFocused then 
  begin 
    IsFocused 
:= ADefault
    
Refresh
  
end
end

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

procedure TColorButton.CNDrawItem(var MessageTWMDrawItem); 
var 
  
SaveIndexInteger
begin 
  with Message
.DrawItemStruct^ do 
  
begin 
    SaveIndex 
:= SaveDC(hDC); 
    
FCanvas.Lock
    try 
      
FCanvas.Handle := hDC
      
FCanvas.Font := Font
      
FCanvas.Brush := Brush
      
DrawButton(rcItemitemState); 
    
finally 
      FCanvas
.Handle := 0
      
FCanvas.Unlock
      
RestoreDC(hDCSaveIndex); 
    
end
  
end
  
Message.Result := 1
end

procedure TColorButton.CMEnabledChanged(var MessageTMessage); 
begin 
  inherited

  
Invalidate
end

procedure TColorButton.CMFontChanged(var MessageTMessage); 
begin 
  inherited

  
Invalidate
end

procedure TColorButton.WMLButtonDblClk(var MessageTWMLButtonDblClk); 
begin 
  Perform
(WM_LBUTTONDOWNMessage.KeysLongint(Message.Pos)); 
end

procedure TColorButton.DrawButton(RectTRectStateUINT); 
var 
  
FlagsOldModeLongint
  
IsDownIsDefaultIsDisabledBoolean
  
OldColorTColor
  
OrgRectTRect
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.LeftRect.TopRect.RightRect.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.LeftRect.TopRect.RightRect.Bottom); 
    
InflateRect(Rect, - 1, - 1); 
  
end 
  
else 
    
DrawFrameControl(FCanvas.HandleRectDFC_BUTTONFlags); 

  if 
IsDown then OffsetRect(Rect11); 

  
OldColor := FCanvas.Brush.Color
  
FCanvas.Brush.Color := Color
  
FCanvas.FillRect(Rect); 
  
FCanvas.Brush.Color := OldColor
  
OldMode := SetBkMode(FCanvas.HandleTRANSPARENT); 
  
FCanvas.Font.Color := clBtnText
  if 
IsDisabled then 
    DrawState
(FCanvas.HandleFCanvas.Brush.HandlenilInteger(Caption), 0
    ((
Rect.Right Rect.Left) - FCanvas.TextWidth(Caption)) div 2
    ((
Rect.Bottom Rect.Top) - FCanvas.TextHeight(Caption)) div 2
      
00DST_TEXT or DSS_DISABLED
  else 
    
DrawText(FCanvas.HandlePChar(Caption), - 1Rect
      
DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
  
SetBkMode(FCanvas.HandleOldMode); 

  if 
Assigned(FOnDrawButtonthen 
    FOnDrawButton
(SelfRectTOwnerDrawState(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.HandleRect); 
  
end
end
end
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием