[pivovaroffroman]

Всем привет! Вновь обращаюсь к вам =) Объясните пожалуйста как сменить цвет кнопки Button или BitBin на чёрный, чтоб она всегда была черная

[lmikle]

Если темы винды поддерживаются - то, по большому счету, никак. В этом случае отрисовка выполняется, условно говоря, виндой. Если темы отключить, то стандартное св-во Color.

[Alegun]

Самое простое в случае BitBtn, это установить чёрный рисунок в глиф, с обычным баттоном намного сложнее, проще внедрить в среду самописный компонент, типа как из drkb

Код:

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.

[pivovaroffroman]

Спасибо большое! Еще вопрос не по теме намного, у меня разрешение на экране 1920х1080, а на компах на учебе 1024х768. Как сделать чтоб окна, картинки и кнопки в делфи при запуске программы настраивались под разрешение рабочего стола?

[NumLock]

Сообщение от pivovaroffroman

Спасибо большое! Еще вопрос не по теме намного, у меня разрешение на экране 1920х1080, а на компах на учебе 1024х768. Как сделать чтоб окна, картинки и кнопки в делфи при запуске программы настраивались под разрешение рабочего стола?

надо делать программу под размеры экрана 1024*768, а не масштабировать. ведь Microsoft Office работает на любых разрешениях. 1920*1080 это 16:9, а 1024*768 это 4:3. жаль не все телеканалы еще об этом знают.