大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

PerformEraseBackground 擦除背景(ThemeServices)

Posted on 2013-10-21 14:03  大悟还俗_2  阅读(491)  评论(0编辑  收藏  举报
PerformEraseBackground 擦除背景的简单方法(外带ThemeServices例子)
 
在查这个函数的时候,顺便看到了有趣的代码。
怎么使用 Themes 。

unit Unit2;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ExtCtrls;
type
  TForm2 = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TVSPanel = class(TCustomPanel)
  private
  protected
    procedure Paint; override;
  public
end;
var
  Form2: TForm2;
implementation
uses Themes,UxTheme;
{$R *.dfm}
{ TVSPanel }
procedure TVSPanel.Paint;
var
  Details: TThemedElementDetails;
begin
  inherited;
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(tbPushButtonHot);   {这里画个按钮处于 Hot 状态下的样子}
    PerformEraseBackground(Self, Canvas.Handle);      {擦除画按钮时的背景}
    ThemeServices.DrawElement(Canvas.Handle, Details, ClientRect);
    ThemeServices.DrawText(Canvas.Handle, Details, Caption, ClientRect,
      DT_EXPANDTABS or DT_VCENTER or DT_CENTER or DT_SINGLELINE, 0);
  end;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
  APanel: TVSPanel;
begin
  APanel := TVSPanel.Create(Application);
  APanel.Left := 100;
  APanel.Top := 100;
  APanel.Width := 200;
  APanel.Height := 30;
  APanel.Caption := '具有 Button 风格的 Panel';
  APanel.Parent := Self;
end;
View Code