Delphi OwnerDraw页面控件自定义_Delphi

Delphi OwnerDraw页面控件自定义

delphi

Delphi OwnerDraw页面控件自定义,delphi,Delphi,我有一个项目有一个OwnerDrawPageControl。我需要按如下方式对其进行自定义：因此，我编写了以下代码： unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Std

我有一个项目有一个

OwnerDraw

PageControl

。我需要按如下方式对其进行自定义：

因此，我编写了以下代码：

unit Unit1;

interface

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

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  protected
    procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
  end;


type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
  Color: TColor;
  Rect: TRect;
  Rgn: HRGN;
  SaveIndex: Integer;
  Caption:string;
  Size   :TSize;
  x,y    :integer;
begin
  Color := clBlack;
  case Message.DrawItemStruct.itemID of
    0: Color := $008000FF;
    1: Color := $00FF0080;
    2: Color := $00408000;
  end;
  SetDCBrushColor(Message.DrawItemStruct.hDC, Color);

  SelectClipRgn(Message.DrawItemStruct.hDC, 0);

  Rect := Message.DrawItemStruct.rcItem;
  if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
    Inc(Rect.Left, 2);
    Dec(Rect.Right, 2);
    Dec(Rect.Bottom, 3);
  end else begin
    Dec(Rect.Left, 2);
    Dec(Rect.Top, 2);
    Inc(Rect.Right, 2);
    Inc(Rect.Bottom);
  end;
  FillRect(Message.DrawItemStruct.hDC, Rect, GetStockObject(DC_BRUSH));

  Rgn := CreateRectRgn(0, 0, 0, 0);
  SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
  DeleteObject(Rgn);

  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    Canvas.Lock;
    try
      Canvas.Handle:=hDC;
      Canvas.Font  :=Font;
      Canvas.Brush :=Brush;
      Caption:=Self.Tabs.Strings[ItemID];
      Size:=Canvas.TextExtent(Caption);
      x:=rcItem.Left+(rcItem.Right-rcItem.Left-Size.cx) div 2;
      y:=rcItem.Top +(rcItem.Bottom-rcItem.Top-Size.cy) div 2+1;
      if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then dec(y);
      Canvas.TextRect(rcItem,x,y,Caption);
    finally
      Canvas.Handle := 0;
      Canvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.Ctl3D:=False;
end;

end.

但在编译之后，我得到如下结果：

如何解决这个问题

我的要求如下：
1.应从

页面控件中删除三维边框

2.表单背景色应从PageControl
中删除

3.所选的选项卡
颜色和高度应不同。

4. <代码>选项卡页
背景应可自定义
之后，我尝试了以下代码：
unit Unit1;

interface

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

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    { Private procedure }
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  protected
    { protected procedure }
    procedure WndProc(var Message:TMessage); override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public procedure }

  published
    { published procedure }
  end;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TPageControl.WndProc(var Message:TMessage);
begin
  if Message.Msg=TCM_ADJUSTRECT then
  begin
    Inherited WndProc(Message);
    if Fborder=bsNone then
    begin
      PRect(Message.LParam)^.Left:=0;
      PRect(Message.LParam)^.Right:=ClientWidth;
      PRect(Message.LParam)^.Top:=PRect(Message.LParam)^.Top-4;
      PRect(Message.LParam)^.Bottom:=ClientHeight;
    end;
  end
  else
    Inherited WndProc(Message);
end;

procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
  Color: TColor;
  Rect: TRect;
  Rgn: HRGN;
  SaveIndex: Integer;
  Caption:string;
  Size   :TSize;
  x,y    :integer;
begin
  Color := 0;
  case Message.DrawItemStruct.itemID of
    0: Color := $008000FF;
    1: Color := $00FF0080;
    2: Color := $00408000;
  end;
  SetDCBrushColor(Message.DrawItemStruct.hDC, Color);

  SelectClipRgn(Message.DrawItemStruct.hDC, 0);

  Rect := Message.DrawItemStruct.rcItem;
  if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
    Inc(Rect.Left, 2);
    Dec(Rect.Right, 2);
    Dec(Rect.Bottom, 3);
  end else begin
    Dec(Rect.Left, 2);
    Dec(Rect.Top, 2);
    Inc(Rect.Right, 2);
    Inc(Rect.Bottom);
  end;
  FillRect(Message.DrawItemStruct.hDC, Rect, GetStockObject(DC_BRUSH));

  Rgn := CreateRectRgn(0, 0, 0, 0);
  SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
  DeleteObject(Rgn);

  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    Canvas.Lock;
    try
      Canvas.Handle:=hDC;
      Canvas.Font  :=Font;
      Canvas.Brush :=Brush;
      Caption:=Self.Tabs.Strings[ItemID];
      Size:=Canvas.TextExtent(Caption);
      x:=rcItem.Left+(rcItem.Right-rcItem.Left-Size.cx) div 2;
      y:=rcItem.Top +(rcItem.Bottom-rcItem.Top-Size.cy) div 2+1;
      if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then dec(y);
      Canvas.TextRect(rcItem,x,y,Caption);
    finally
      Canvas.Handle := 0;
      Canvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
  inherited;
end;

procedure TPageControl.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style:=Params.Style or TCS_OWNERDRAWFIXED;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.Ctl3D:=False;
end;

end.  

但它不是编译。
为了防止有人遇到这个老问题，TCM\u ADJUSTRECT和TCS\u OWNERDRAWFIXED在Winapi.CommCtrl中定义。TPageControl及其任何祖先都没有边界属性或FBorder成员。如果您觉得需要一个控件，您应该通过从TCustomTabControl或TPageControl派生来创建一个新控件。
万一有人遇到这个老问题，TCS_ADJUSTRECT和TCS_OWNERDRAWFIXED在Winapi.CommCtrl中定义。TPageControl及其任何祖先都没有边界属性或FBorder成员。如果您觉得需要一个控件，您应该通过从TCustomTabControl或TPageControl派生来创建一个新控件。
它不是编译的
-它到底在哪里失败，错误是什么？我收到以下错误：[dcc32 error]Unit1.pas（16）：E2065未满足的转发或外部声明：“TPageControl.WndProc”
[dcc32 Error]Unit1.pas（17）：E2065未满足的转发或外部声明：“TPageControl.CreateParams”

[dcc32 Fatal Error]Project1.dpr（5）：F2063无法编译使用过的单元“Unit1.pas”[dcc32 Fatal Error]Project1.dpr（5）：F2063无法编译使用过的单元“Unit1.pas”`我正在获取

未声明的标识符：“TCM\u ADJUSTRECT”、Fborder和TCS\u OWNERDRAWFIXED

。任何反馈都很好：）我也尝试过，但无法编译。相同的错误。

它没有编译

-它到底在哪里失败，错误是什么？我得到了以下错误：

[dcc32 error]Unit1.pas（16）：E2065未满足的转发或外部声明：“TPageControl.WndProc”

[dcc32 error]Unit1.pas（17）：E2065未满足的正向或外部声明：“TPageControl.CreateParams”[dcc32致命错误]项目1.dpr（5）：F2063无法编译使用过的单元“Unit1.pas”[dcc32致命错误]项目1.dpr（5）：F2063无法编译使用过的单元“Unit1.pas”`我正在获取

未声明的标识符：“TCM\u ADJUSTRECT”，Fborder和TCS_OWNERDRAWFIXED

。任何反馈都很好：）我也尝试过，但无法编译。同样的错误。