Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2007.04.01;
Скачать: [xml.tar.bz2];

Вниз

Вывести bmp-рисунок на окно на API   Найти похожие ветки 

 
Max_2006   (2006-11-14 17:40) [0]

Создаю окно на 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.


 
MBo ©   (2006-11-14 17:52) [1]

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


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

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


 
Eraser ©   (2006-11-14 18:14) [3]

> [2] Max_2006   (14.11.06 18:06)

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


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

Eraser, т.е. так?

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

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


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

> [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:54) [6]

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


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

Вроде что-то сделал такое работающее, немного доделал обработку сообщения 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;


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

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


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

т.е. создать 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 как я показал?


 
Eraser ©   (2006-11-14 19:41) [10]

> [6] Max_2006   (14.11.06 18:54)


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

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


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

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


 
Anatoly Podgoretsky ©   (2006-11-14 19:44) [12]

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

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


 
Ketmar ©   (2006-11-14 20:22) [13]

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


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

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


 
Ketmar ©   (2006-11-14 20:37) [15]

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


 
Rouse_ ©   (2006-11-15 10:57) [16]

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

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;


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

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


 
DVM ©   (2006-11-17 16:24) [18]


> 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;



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2007.04.01;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.51 MB
Время: 0.042 c
15-1173576885
eXPell
2007-03-11 04:34
2007.04.01
Концепты от LADA


1-1171032439
Нож
2007-02-09 17:47
2007.04.01
gds_db 3050/tcp Unable to complete network request


15-1173157995
eXPell
2007-03-06 08:13
2007.04.01
Подскажите софт, пожалуйста


15-1173540667
PARUS
2007-03-10 18:31
2007.04.01
JAVA на компе


2-1172997048
mavrtuva
2007-03-04 11:30
2007.04.01
QuantumGrid





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский