开发者

How can I change the background color of my TTabSheets?

Im Designing a Form with Delphi 2009, and Im trying to figure out the TPageControl element. Im trying to make separate dialogs for each tab. I can make the TTabSheets, and I can place my elements on the TabSheets, but my problem is that they are barley visible, as the default background for a TTabSheet appears to be white. Ive tried to place a panel on the TabSheet, but for whatever reason, the panel always appears behind the TabSheet. So my question: Is t开发者_运维百科here any way to change the color of a tab sheet to the standard windows beige, or is their a way to place a TPanel on the tab page, accomplishing the same goal?


Set the style property to tsFlatButtons
The background ~colour~ will revert to beautiful clBtnFace


The standard Windows colour for a tab sheet is white. That standard came into being when XP themes were introduced. If a user switches back to Windows Classic then they will get a grey background. [You do mean grey rather than beige don't you? Beige would be truly vile!]

A panel inside a tab sheet can never be behind the page since it is inside the page. What is actually happening is that the panel is being drawn transparently so that the standard tab sheet colour prevails.


Use this unit in your Form at the interface:

unit MSCtrlsStyleHook;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Themes,
  Winapi.CommCtrl;

type
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;

  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
  end;

implementation

{ TPageControl }

procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
  inherited;
  if Msg.WParam = 0 then
    InflateRect(PRect(Msg.LParam)^, 3, 3)
  else
    InflateRect(PRect(Msg.LParam)^, -3, -3);
end;

{ TTabSheet }

procedure TTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LRect  : TRect;
  LCanvas: TCanvas;
begin
  if (PageControl <> nil) and StyleServices.Enabled and
     ((PageControl.Style = tsTabs) or TStyleManager.IsCustomStyleActive) then
  begin
    //Get the bounds of the Tabsheet
    GetWindowRect(Handle, LRect);
    OffsetRect(LRect, -LRect.Left, -LRect.Top);
    //create a TCanvas for erase the background, using the DC of the message
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := Message.DC;
      LCanvas.Brush.Color:= $fafafa;// Color You need;
      LCanvas.FillRect(LRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;

    Message.Result := 1;
  end
  else
    inherited;
end;

end.


Not liking either solution much, this is what I'm doing to thwart the problem you're having. You don't need to sacrifice windows themes to make it work:

just check:

if ThemeServices.ThemesEnabled then
  FormBGColor := clBtnHighlight
else
  FormBGColor := clBtnFace;

and set the color of the form before you show it on your tabs.

(personally, I never liked this solution, but it's how a major part of the program I work on was programmed before I started, so to make it not look like crap on my compuer XOR terminal servers that's what I had to do)


ThemeServices is in themes.pas


If you wish to preserve the PageControl Style property as tsTabs then you'll need to hack the TTabSheet class ...

Just above your form's type declaration add the following ...

  TTabSheet = class(ComCtrls.TTabSheet)
  protected
    procedure PaintWindow(DC: HDC); override;
  end;

Then in the unit's implementation section ...

  var brushBtnFace: HBrush;

  procedure TTabSheet.PaintWindow(DC: HDC);
  var
    rec: TRect;
  begin
    rec := ClientRect;
    windows.FillRect(DC, rec, brushBtnFace);
  end;

And finally create and destroy your brush in the unit's initialization and finalization sections ...

  initialization
    brushBtnFace := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
  finalization
    DeleteObject(brushBtnFace);
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜