logo标签列表

Delphi：如何在Vista系统下绘制类似Windows 7 Aero效果的标题栏文本

delphiaerononclient
6
6个回答
4
在非客户区绘图会自动禁用玻璃效果。微软Office所做的是扩展客户区以覆盖边框。请参考this WPF article中“在具有玻璃效果的NC区域绘图”部分的建议。恐怕你需要自己将API调用转换为Delphi。
感谢您的支持， 对于我的工作，我需要这个 http://www.codeproject.com/KB/dialog/AeroNonClientAreaButtons.aspx 对于我的知识水平来说太复杂了非常感谢 - haidomingo
3

关键是API DwmExtendFrameIntoClientArea

您应该这样声明并获取它：

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

您已经在这里移植了代码：Aero 下的半透明窗口 要去除框架，请按以下方式调用：
DWM_ExtendFrameIntoClientArea(Form1.Handle, -1, -1, -1, -1);

通过这些，你应该能够轻松实现你想要的目标。

感谢。.. DWM_ExtendFrameIntoClientArea(Form3.Handle, -1, -1, -1, -1); Canvas.TextOut(80,10,'文本客户区'); Canvas.TextOut(80,-8,'文本非客户区');产生的结果如下：http://img11.imageshack.us/img11/697/immaginetxz.jpg我犯了什么错误？ - haidomingo
0

扩展框架是一回事，绘制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;
这对我没有起作用，它显示“调用操作系统函数失败”？ - Vasil Popov
我想知道为什么在没有任何IF语句的情况下调用RaiseLastOsError？ - Warren P
我正在使用 Delphi 7，我在哪里可以找到 TDTTOpts？ - Christopher Chase
Delphi 7单独不具备足够的主题支持来处理Win7 + glass，但是你可能可以在野外找到一些第三方“主题和Aero”代码。最简便的方法是升级您古老的Delphi 7。 - Warren P
0
感谢提供 DrawTextOnGlass 代码。但是为了使其正常工作，我需要在 DrawThemeTextEx 中替换 b.handle 和 b.canvas.handle。
0
0
在 Delphi 2009 中，TLabel 有一个名为 "GlowSize" 的新属性（请参阅帮助）。将此属性设置为正值的效果非常接近您所寻找的效果（标签文本周围发光）。
2
与 Windows Vista/7 实际产生的发光效果相比，此 GlowSize 属性产生的结果非常丑陋。 - anon271334
这个glowsize属性除了告诉Vista该做什么之外，没有任何作用。 - Warren P
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接