Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.08.12;
Скачать: [xml.tar.bz2];

Вниз

TButton, inherited, Enabled   Найти похожие ветки 

 
Bbbbb...   (2007-07-14 19:35) [0]

Создал наследника кнопки с некоторыми изменениями. Просто приведу аналогичный код "цветной кнопки".

Проблема в том, что не знаю, как создать такое решение, которое бы при активной Enabled := True, кнопка была бы наследником обычной конпки - т.е. моя описанная кнопка. А если Enabled := False - то оставалась своим родителем, простой TButton.

Пытался использовать ....if Enabled <> True then Exit;.... но ничего хорошего. Подскажите примером что ли.

Спасибо.


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;


 
Anatoly Podgoretsky ©   (2007-07-14 19:45) [1]

> Bbbbb...  (14.07.2007 19:35:00)  [0]

Разберись с понятиями, что такое наследование и что такое родитель, свойство и поведение в рантайм.


 
_Mike_   (2007-07-14 22:27) [2]

Что-то после вот этого читать дальше код перехотелось

destructor TColorButton.Destroy;
begin
inherited Destroy;
FCanvas.Free;
end;



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.08.12;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.039 c
2-1184854845
Avokain
2007-07-19 18:20
2007.08.12
Числа вида 1,000,000


2-1184649833
Kolan
2007-07-17 09:23
2007.08.12
Записи в DBGrid e странным образом исчезают.


11-1150264932
MZUser
2006-06-14 10:02
2007.08.12
Создание DLL


15-1184214406
Riply
2007-07-12 08:26
2007.08.12
Владпута, Едрос.


2-1184682775
Knob
2007-07-17 18:32
2007.08.12
Две проги





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский