VPF::BS_OWNERDRAW + Icon + Text - Форум программистов

navodri

Дата 28.6.2010, 15:49 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1

Мне удалось на чистом API отобразить кнопку с текстом и иконкой. Но ее вид не такой, как обычная кнопка, она даже визуально не нажимается.
Как можно отобразить на диалоговом окне обычную кнопку (BUTTON) со своим значком (или другим изображением) и текстом?

Представляю свой код:

Код


program imgbutton;

uses
  Windows, Messages;

{$R dialog.res}

const
  WindowName = 'Draw Icon and Text sample';
  ID_BTNICONTEXT = 300;

var
  WindowClass: TWndClass;
  hWindow: HWND;
  hIconTextButton: HWND;
  AMessage: TMsg;

function WindowProc(Window: HWnd; Message: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
 p: array [0..256] of char;
begin
 Result := 0;
  case Message of

   WM_CREATE:
     begin
      hIconTextButton  := CreateWindow('BUTTON', 'Icon and Text', BS_OWNERDRAW or WS_CHILD or WS_VISIBLE or WS_TABSTOP,
          20, 20, 190, 40, Window, ID_BTNICONTEXT, HInstance, nil);
      SendMessage(Window, WM_SETICON, ICON_SMALL, LoadIcon(hInstance, 'MAINICON'));
     end;

   WM_DRAWITEM:
    with PDRAWITEMSTRUCT(lParam)^ do
      case CtlID of
       ID_BTNICONTEXT:
         begin
          FrameRect(hDC, rcItem, GetStockObject(WHITE_BRUSH));
          DrawIconEx(hDC,4, 4, LoadIcon(hInstance, 'MAINICON'), 32, 32, 0, 0, DI_NORMAL);

          SetTextColor(hDC, RGB($00, $00, $FF));
          GetWindowText(hIconTextButton, p, 255);
          DrawText(hDC, p, - 1, rcItem, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
          SetBkMode(hDC, TRANSPARENT);
          // if (itemState and ODS_SELECTED) <> 0 then
         end;
       end;

    WM_DESTROY:
     begin
      PostQuitMessage(0);
      Exit;
     end;

   else Result := DefWindowProc(Window, Message, wParam, lParam);
 end;
end;

begin
  with WindowClass do
    begin
      lpszClassName := WindowName;
      lpfnWndProc := @WindowProc;
      cbClsExtra := 0;
      cbWndExtra := 0;
      hInstance := 0;
      lpszMenuName := nil;
      hIcon := LoadIcon(0, IDI_APPLICATION);
      hCursor := LoadCursor(0, IDC_ARROW);
      hbrBackground := GetStockObject(WHITE_BRUSH);
    end;

  if RegisterClass(WindowClass) = 0 then Exit;

  hWindow := CreateWindow(WindowName, WindowName, WS_OVERLAPPEDWINDOW, (GetSystemMetrics(SM_CXSCREEN) - 500) div 2,
      (GetSystemMetrics(SM_CYSCREEN) - 300) div 2, 500, 300, 0, 0, HInstance, nil);

  ShowWindow(hWindow, SW_SHOWNORMAL);
  UpdateWindow(hWindow);
  while GetMessage(AMessage, 0, 0, 0) do
    begin
      TranslateMessage(AMessage);
      DispatchMessage(AMessage);
    end;
end.

Maks1509

Дата 28.6.2010, 23:03 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 54
Регистрация: 22.8.2007
Где: г. Тольятти

Репутация: 3
Всего: 5

Держи, думаю вполне достаточно. Правда код нестабильный и неотлаженный. Проект заброшен.

Присоединённый файл ( Кол-во скачиваний: 19 )

BCM_SETIMAGELIST.rar 22,47 Kb

navodri

Дата 29.6.2010, 09:20 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1

Спасибо огромное!

P.S.
Приятно, что хоть кто-то еще пишет на API..

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »