Delphi: Нарисуйте текст в форме заголовка для Vista с Aero, как Windows 7

Как нарисовать текст (с событием onClick) в строке заголовка на Vista с Aero Like Windows 7?

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

Пример на http://delphi.about.com/ не работает в Vista с aero. Есть ли у вас какие-либо идеи?

Спасибо всем.

Извините за мой плохой английский.

Источник

6 ответов

Рисование в неклиентской области приводит к автоматическому отключению стекла. Что MS Office делает, так это расширяет область клиента, чтобы покрыть границы. Посмотрите на раздел "Рисование в области NC со стеклом" этой статьи WPF для предложений. Боюсь, вам придется конвертировать вызовы API в Delphi самостоятельно.

Источник

Ключом является API DwmExtendFrameIntoClientArea

Вы должны заявить об этом и получить это так:

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

У вас также есть код, уже перенесенный сюда: прозрачная Windows с Aero

Чтобы не кадр, вы называете это как:

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

При этом не должно быть трудно добиться того, чего вы хотите.

Источник

Спасибо за код DrawTextOnGlass. Но чтобы работать как положено, мне нужно было заменить b.handleb.canvas.handle в DrawThemeTextEx

Источник

Расширение рамки - это одно, а рисование текста в стиле Vista (светящееся) - другое. С Canvas.TextOut или DrawText выходной сигнал испортил альфа, что даст вам полученный эффект. Вам нужно использовать 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;
Источник

Вам нужен один вызов DwmSetWindowAttribute, после этого все довольно просто. Проверьте эту статью и особенно комментарии:) http://delphihaven.wordpress.com/2010/04/22/setting-up-a-custom-title-bar-reprise/

Источник

В Delphi 2009 TLabel имеет новое свойство под названием "GlowSize" ( см. Справку). Эффект установки положительного значения для этого свойства очень близок к тому, что вы, похоже, ищете (свечение вокруг текста метки).

Источник
Другие вопросы по тегам