Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Вывести bmp-рисунок на окно на API [D7, WinXP]


Max_2006 ©   (2006-11-14 17:40:00) 

Создаю окно на API и хочу на нем разместить рисунок в качестве фона, почему-то рисунок не появляется.. Почему? Что не так?

uses
 Windows,
 Messages;

const
 WindowName = 'MyForm';

var
 WindowClass: TWndClass;
 hWindow: HWnd;
 AMessage: TMsg;
 hBmp: HBitmap;

function WindowProc(Window: HWnd; Message: Word; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
 Result := 0;
   case Message of
     WM_ERASEBKGND: begin
                      BitBlt(wParam, 0, 0, 283, 149, hBmp, 0, 0, SRCCOPY);
                      Result := 1;
                    end;
     WM_DESTROY: PostQuitMessage(0);
   else
     Result := DefWindowProc(Window, Message, wParam, lParam);
   end;
end;

begin
 with WindowClass do
   begin
     lpszClassName := WindowName;
     lpfnWndProc := @WindowProc;
     cbClsExtra := 0;
     cbWndExtra := 0;
     hInstance := 0;
     hbrBackground := COLOR_WINDOW;
   end;

 if RegisterClass(WindowClass) = 0 then Exit;
 hWindow := CreateWindow(WindowName, WindowName, ws_OverlappedWindow, cw_UseDefault, cw_UseDefault, 283, 149, 0, 0, HInstance, nil);

 hBmp := LoadImage(0, 'MyBmp.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);

 ShowWindow(hWindow, CmdShow);
 UpdateWindow(hWindow);

 while GetMessage(AMessage, 0, 0, 0) do
   begin
     TranslateMessage(AMessage);
     DispatchMessage(AMessage);
   end;
end.

DVM   (2006-11-17 16:24:00) [1]


> Dmitry_177   (17.11.06 15:09) [17]

второе


> Max_2006   (14.11.06 17:40)  

Вот можно еще так битмап отрисовать на DC

procedure DrawBitmap(dc: HDC; hBitmap: HBITMAP; xStart, yStart: integer); stdcall;
var
 bm: BITMAP;
 hdcMem: HDC;
 ptSize, ptOrg: TPoint;
begin
 if dc <> 0 then
   begin
     hdcMem := CreateCompatibleDC(dc);
     if (hdcMem <> 0) and (hBitmap <> 0) then
       begin
         SelectObject(hdcMem, hBitmap);
         SetMapMode(hdcMem, GetMapMode(dc));
         GetObject(hBitmap, sizeof(BITMAP), @bm);
         ptSize.x := bm.bmWidth;
         ptSize.y := bm.bmHeight;
         DPtoLP(dc, ptSize, 1);
         ptOrg.x := 0;
         ptOrg.y := 0;
         DPtoLP(hdcMem, ptOrg, 1);
         BitBlt(dc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, ptOrg.x, ptOrg.y, SRCCOPY);
         DeleteDC(hdcMem);
       end;
   end;
end;

Dmitry_177   (2006-11-17 15:09:00) [2]

Интересно, а где лучше выполнить загрузку битмапа? в программе после создания окна, как в Max_2006   (14.11.06 17:40)или в обработке сообщения WM_CREATE?

Rouse_   (2006-11-15 10:57:00) [3]

Я обычно рисую вот так:

function PictureSize: TSize;
var
 ResHandle: HWND;
 ResData: HWND;
 BMI: PBitmapInfo;
begin
 Result.cx := 0;
 Result.cy := 0;
 ResHandle := FindResource(HInstance,
   MAKEINTRESOURCE(200), RT_BITMAP);
 if ResHandle <> 0 then
 begin
   ResData := LoadResource(HInstance, ResHandle);
   if ResData <> 0 then
   try
     BMI := LockResource(ResData);
     if Assigned(BMI) then
     try
       Result.cx := BMI.bmiHeader.biWidth;
       Result.cy := BMI.bmiHeader.biHeight;
     finally
       UnlockResource(ResData);
     end;
   finally
     FreeResource(ResData);
   end;
 end;
end;

procedure ShowPicture;

 function Rect(Left, Top, Right, Bottom: Integer): TRect;
 begin
   Result.Left := Left;
   Result.Top := Top;
   Result.Right := Right;
   Result.Bottom := Bottom;
 end;

var
 Bitmap: HBITMAP;
 BitmapSize: TSize;
 DC, BitmapDC, OldDC: HDC;
 bLeft, bTop: Cardinal;
 _Rect: TRect;
 S: String;
 Pen: HPEN;
begin
 Bitmap := LoadBitmap(HInstance, MAKEINTRESOURCE(200));
 if Bitmap <> 0 then
 try
   BitmapSize := PictureSize;
   DC := GetDC(Handle);
   try
     BitmapDC := CreateCompatibleDC(DC);
     try
       OldDC := SelectObject(BitmapDC, Bitmap);
       try
         bLeft := (Width - BitmapSize.cx);
         bTop := 0;
         StretchBlt(DC, 0, 0, bLeft, BitmapSize.cy, BitmapDC, 0, 0, 1, BitmapSize.cy, SRCCOPY);
         BitBlt(DC, bLeft, bTop, BitmapSize.cx, BitmapSize.cy, BitmapDC, 0, 0, SRCCOPY);

         SetBkMode(DC, OPAQUE);
         if hFontBold <> 0 then
           SelectObject(DC, hFontBold);
         S := INFO1;
         _Rect := Rect(10, 6, 230, 31);
         DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK);

         if hFontNormal <> 0 then
           SelectObject(DC, hFontNormal);
         S := INFO2;
         _Rect := Rect(10, 40, 280, 70);
         DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK + DT_NOCLIP);
         S := INFO3;
         _Rect := Rect(10, 55, 280, 100);
         DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK + DT_NOCLIP);

         Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
         try
           SelectObject(DC, Pen);
           MoveToEx(DC, 6, 127, nil);
           LineTo(DC, 349, 127);
         finally
           DeleteObject(Pen);
         end;

         Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
         try
           SelectObject(DC, Pen);
           MoveToEx(DC, 348, 128, nil);
           LineTo(DC, 5, 128);
         finally
           DeleteObject(Pen);
         end;

       finally
       SelectObject(OldDC, Bitmap);
       end;
     finally
       DeleteDC(BitmapDC);
     end;
   finally
     ReleaseDC(Handle, DC);
   end;
 finally
   DeleteObject(Bitmap);
 end;
end;

Ketmar   (2006-11-14 20:37:00) [4]

>[14] Max_2006 14-Nov-2006, 20:33
>потом если рекомендуют не уничтожать
молодец. до этих слов дочитал. попробуй остаток текста осилить. там немного. помедитируй также на тему "как вернуть DC с выбраным (моим) битмапом в начальное состояние".

Max_2006   (2006-11-14 20:33:00) [5]

просто каждый раз тоже в WM_ERASEBKGND зачем создавать DC? Утечка памяти будет... Значит надо создать один раз, вот и я показал где, потом если рекомендуют не уничтожать, то как оно уничтожится само?

Ketmar   (2006-11-14 20:22:00) [6]

>[9] Max_2006 14-Nov-2006, 19:41
ты бы попробовал почитать [8]. помедитировать. найти у меня там хоть что-то, что относится к твоему [9]. а? найдешь -- скажи где, мне самому интересно.

Anatoly Podgoretsky   (2006-11-14 19:44:00) [7]

> Max_2006  (14.11.2006 18:54:06)  [6]

Но ведь никто не запрещает посмотреть как у людей сделано.

Max_2006   (2006-11-14 19:42:00) [8]

в WM_ERASEBKGND строка т.е. так: BitBlt(wParam, 0, 0, 283, 149, memDC, 0, 0, SRCCOPY);

Eraser   (2006-11-14 19:41:00) [9]

> [6] Max_2006   (14.11.06 18:54)


> но я не использую VCL

зря. интересно по какой причине?

Max_2006   (2006-11-14 19:41:00) [10]

т.е. создать DC после загрузки hBmp из файла, т.е. так?

var
winDC, MemDC: HDC;
..
function WindowProc(..)
..
    WM_ERASEBKGND: begin
                     BitBlt(wParam, 0, 0, 283, 149, DC, 0, 0, SRCCOPY);
                     Result := 1;
                   end;

   WM_DESTROY: begin
                   DeleteDC(memDC);
                   ReleaseDC(hWindow, winDC);
                   PostQuitMessage(0);
                 end;
...
begin
 hBmp := LoadImage(0, 'MyBmp.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
 winDC := GetDC(hWindow);
 memDC:=CreateCompatibleDC(winDC);
 SelectObject(memDC, hBmp);
...

Но вопрос тогда когда удалять DC, точнее winDC и MemDC? в WM_DESTROY как я показал?

Ketmar   (2006-11-14 19:21:00) [11]

неправильно. гуру рекомендуют не уничтожать DC с выбраным битмапом. правильно, кстати, рекомендуют.

Max_2006   (2006-11-14 19:06:00) [12]

Вроде что-то сделал такое работающее, немного доделал обработку сообщения WM_ERASEBKGND, а так все тоже самое осталось, но только на сколько это правильно вот вопрос...

     WM_ERASEBKGND: begin
                      DC:=CreateCompatibleDC(wParam);
                      SelectObject(DC, hBmp);
                      BitBlt(wParam, 0, 0, 283, 149, DC, 0, 0, SRCCOPY);
                      DeleteDC(DC);
                      Result := 1;
                    end;

Max_2006   (2006-11-14 18:54:00) [13]

Понятное дело что VCL использует API, но я не использую VCL )))

Eraser   (2006-11-14 18:50:00) [14]

> [4] Max_2006   (14.11.06 18:40)


> там нет такого в модулях Windows, Messages

в них много чего нету, даже того, что по-логике должно было бы и быть.
зато есть в Graphics.

> Я на API делаю

VCL тоже API использует.

> Bmp.LoadFromFile(..)  

bmp.LoadFromResourceName();
bmp.LoadFromResourceID();
еще иногда удобно использовать TResourceStream.

Max_2006   (2006-11-14 18:40:00) [15]

Eraser, т.е. так?

var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
Bmp.LoadFromFile(..)  // как-то так вроде...

Я на API делаю, там нет такого в модулях Windows, Messages... Хочу на одном WinApi это сделать...

Eraser   (2006-11-14 18:14:00) [16]

> [2] Max_2006   (14.11.06 18:06)

почему бы не использовать TBitmap, там и с ресурсами проще и CompatibleDC тоже.

Max_2006   (2006-11-14 18:06:00) [17]

А как это сделать? CreateCompatibleDC? ТОлько я не очень понимаю как этой функцией пользоваться...

MBo   (2006-11-14 17:52:00) [18]

В BitBlt передается дескриптор не битмапа, а контекста, в котором этот битмап выбран

Наверх

Титульная страница Поиск, карта сайта Написать письмо