Блог

Я пытаюсь (безуспешно) скопировать / воспроизвести градиент фона строки меню Windows на растровое изображение.

В приведенной ниже функции IconToBitmap fillRect (желаемое за действительное) использует GetSysColorBrush(COLOR_MENU) в попытке нарисовать фон меню таким, какой он есть в Windows (неудивительно, что кисть не является градиентом, но попробовать стоило.)

Приведенный ниже фрагмент текста является попыткой «обмануть». Возьмите часть уже нарисованной строки меню и используйте ее. Это тоже не сработало, и я подозреваю, что причина может быть в том, что функция IconToBitmap вызывается во время WM_CREATE главного окна (я не уверен, что строка меню существует так рано при создании окна.) Мне действительно нужен фон перед тем, как окно впервые станет видимым, вот почему функция вызывается при обработке WM_CREATE (но любой другой способ, который работает до того, как окно станет видимым, идеален.)

На данный момент у меня закончились идеи.

Если кто-нибудь знает, как либо захватить этот фон меню, либо воспроизвести его на растровом изображении, это было бы здорово.

Спасибо.

PS: жестко заданные значения в функции будут удалены в окончательной рабочей версии (надеюсь, таковая будет). Кроме того, для Delphi тип данных ptrint должен быть изменен на NativeInt .

 function IconToBitmap(Wnd : HWND; Icon : HICON) : HBITMAP;
var
  Bitmap      : HBITMAP;
  BitmapDc    : HDC;
  BitmapRect  : TRECT;

  OldBitmap   : HBITMAP;

  dc          : HDC;

  MenuHeight  : ptrint;
  MenuY       : ptrint;

  WindowDc    : HDC;

begin
  Bitmap      := 0;
  BitmapDc    := 0;
  OldBitmap   := 0;
  dc          := 0;

  MenuY       := 0;
  MenuHeight  := 0;

  WindowDc    := 0;


  MenuY       := GetSystemMetrics(SM_CYSIZEFRAME)  
                 GetSystemMetrics(SM_CYCAPTION);
  MenuHeight  := GetSystemMetrics(SM_CYMENUSIZE);

  WindowDc    := GetWindowDC(Wnd);


  dc          := GetDC(0);
  BitmapDc    := CreateCompatibleDC(dc);

  Bitmap      := CreateCompatibleBitmap(dc, 16, 16);
  OldBitmap   := SelectObject(BitmapDc, Bitmap);

  with BitmapRect do
  begin
    Left      := 0;
    Top       := 0;
    Right     := 16;
    Bottom    := 16;
  end;

  FillRect(BitmapDc, BitmapRect, GetSysColorBrush(COLOR_MENU));
  BitBlt(BitmapDc, 0, 0, 16, 16, WindowDc, 20, MenuY, SRCCOPY);

  DrawIconEx(BitmapDc,
             0,
             0,
             Icon,
             16,
             16,
             0,
             0,
             DI_NORMAL);

  SelectObject(BitmapDc, OldBitmap);
  DeleteDC(BitmapDc);
  ReleaseDC(0, dc);

  IconToBitmap := Bitmap;
end;
  

Используйте Visual styles API для рисования частей темы. Приведенный ниже пример рисует фон строки меню в верхней части клиентской области формы. Вы можете адаптировать его для рисования на растровом холсте.

 uses
  uxtheme, types;

procedure TForm1.FormPaint(Sender: TObject);
var
  Theme: HTHEME;
  Size: TSize;
  Rect: TRect;
begin
  Theme := OpenThemeData(Handle, VSCLASS_MENU);
  GetThemePartSize(Theme, Canvas.Handle, MENU_BARBACKGROUND, MB_ACTIVE, nil,
      TS_TRUE, Size);
  Rect.Create(0, 0, ClientWidth, Size.cy);
  DrawThemeBackground(Theme, Canvas.Handle, MENU_BARBACKGROUND, MB_ACTIVE,
      Rect, nil);
  CloseThemeData(Theme);
end;
  

В WM_PAINT обработчике это может выглядеть следующим образом.

 procedure TForm1.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;

  Theme: HTHEME;
  Size: TSize;
  Rect: TRect;
begin
  if Message.DC = 0 then
    DC := BeginPaint(Handle, PS)
  else
    DC := Message.DC;

  Theme := OpenThemeData(Handle, VSCLASS_MENU);
  GetThemePartSize(Theme, DC, MENU_BARBACKGROUND, MB_ACTIVE, nil,
      TS_TRUE, Size);
  Rect.Create(0, 0, ClientWidth, Size.cy);
  DrawThemeBackground(Theme, DC, MENU_BARBACKGROUND, MB_ACTIVE,
      Rect, nil);
  CloseThemeData(Theme);

  if Message.DC = 0 then begin
    Message.DC := DC;
    inherited;
    EndPaint(Handle, PS);
  end else
    inherited;
end;