德尔福：用类似windows 7的aero为vista绘制一个标题形式的文本

Question

如何使用aero Like Windows 7在vista的标题栏中绘制文本（使用onClick事件）？

替代文字http://img529.imageshack.us/img529/3643/immaginembl.jpg

delphi.about.com上的示例无法在带有aero的Vista上运行。 你有什么想法？

谢谢大家。

对不起，我的英语不好。

Answer 1

在非客户区域中绘图会导致玻璃自动禁用。 MS Office所做的是扩展客户区域以覆盖边界。 请查看此WPF文章中的“在玻璃的NC区域绘图”部分以获取建议。 你担心，你必须自己将API调用转换为Delphi。

Answer 2

关键是API DwmExtendFrameIntoClientArea

你应该声明它，然后像这样：

DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall; 
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea'); 

您还可以在此处移植代码： 带有Aero的半透明Windows

要没有框架，你可以这样称呼：

DWM_ExtendFrameIntoClientArea(Form1.Handle, -1, -1, -1, -1);

有了这一切，不应该很难实现你想要的。

Answer 3

在Delphi 2009中，TLabel有一个名为“GlowSize”的新属性（ 请参阅帮助 ）。 为此属性设置正值的效果非常接近您所寻找的值（标签文本周围的光晕）。

Answer 4

扩展框架是一回事，绘制Vista主题（发光）文本是另一回事。 使用Canvas.TextOut或DrawText，输出已经搞砸了alpha，这将产生你得到的效果。 您需要使用DrawThemeTextEx。 下面是在玻璃上绘制文字的正确程序：

uses Themes, UxTheme;

procedure DrawTextOnGlass(Canvas: TCanvas; Text: String; R: TRect);
var
  memoryHdc: HDC;
  b: TBitmap;
  dttOpts: TDTTOpts;
  DR: TRect;
  bf: TBlendFunction;
begin
  b := TBitmap.Create;
  try
    memoryHdc := CreateCompatibleDC(Canvas.Handle);

    b.Handle := memoryHdc;
    b.HandleType := bmDIB;
    b.PixelFormat := pf32bit;
    b.SetSize(R.Right - R.Left, R.Top - R.Bottom);
    b.Canvas.Font := Canvas.Font;

    DR := R;
    OffsetRect(DR, -DR.Left, -DR.Top);
    Inflaterect(dr, -5, -5);
    b.Canvas.Brush.Color := clBlack;
    b.Canvas.FillRect(DR);

    dttOpts.dwSize := SizeOf(TDTTOpts);
    dttOpts.iGlowSize := 8;
    dttOpts.dwFlags := DTT_COMPOSITED or DTT_GLOWSIZE or DTT_TEXTCOLOR;

    DrawThemeTextEx(ThemeServices.Theme[teWindow], b.Handle, WP_CAPTION, CS_ACTIVE, Text, -1,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, DR, dttOpts);
  if GetLastError <> 0 then
        RaiseLastOSError;


    bf.BlendOp := AC_SRC_OVER;
    bf.BlendFlags := 0;
    bf.SourceConstantAlpha := 255;
    bf.AlphaFormat := AC_SRC_ALPHA;

    AlphaBlend(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
      b.Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top, bf);
  finally
    b.Free;
  end;
end;

Answer 5

感谢DrawTextOnGlass代码。 但是为了按预期工作，我需要在DrawThemeTextEx替换b.handle b.canvas.handle

Answer 6

你需要一次调用DwmSetWindowAttribute，之后一切都很简单。 查看这篇文章，特别是评论:) http://delphihaven.wordpress.com/2010/04/22/setting-up-a-custom-title-bar-reprise/