德爾福：用類似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/