Delphi: Draw a text in a caption form for vista with aero like windows 7

Question

How does one draw text (with onClick event) in a caption bar on vista with aero Like Windows 7 ?

alt text http://img529.imageshack.us/img529/3643/immaginembl.jpg

The example at delphi.about.com doesn't work on Vista with aero. Do you have any ideas?

Thanks to all.

Sorry for my bad english.

Answer 1

Drawing in the nonclient region causes glass to be disabled automatically. What MS Office does is expand the client region to cover the borders. Look at the "Drawing in the NC area with glass" section of this WPF article for suggestions. You'll have to convert the API calls to Delphi yourself, I'm afraid.

Answer 2

The key is the API DwmExtendFrameIntoClientArea

You shoud declare it and get it like this:

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

You also have the code already ported here: Translucent Windows with Aero

To have not frame you call it like:

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

With all this it should not be to hard to achieve what you want.

Answer 3

In Delphi 2009 TLabel has a new property called "GlowSize" ( see help ). The effect of setting a positive value for this property is very close to what you seem to be looking for (a glow around label's text).

Answer 4

Extending the frame is one thing and drawing Vista themed (glowing) text is another. With Canvas.TextOut or DrawText the output has messed up alpha which will give the effect you got. You need to use DrawThemeTextEx. Heres the correct procedure for drawing text on glass:

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

Thanks for DrawTextOnGlass code. But to work as expected, I needed to replace b.handle b.canvas.handle in DrawThemeTextEx

Answer 6

You need a single call to DwmSetWindowAttribute, after that everything is quite simple. Check this article and especially comments :) http://delphihaven.wordpress.com/2010/04/22/setting-up-a-custom-title-bar-reprise/