|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Фон позади элементов
Я пишу приложение с графикой на чистом WinAPI и мне нужно рисовать фон окна. Я делаю это так:
Код:
procedure DrawBG; var Bitmap: TBitmap; DC: HDC; Canvas: TCanvas; begin Canvas := TCanvas.Create; DC := GetWindowDC(wnd0); Canvas.Handle := DC; Bitmap := TBitmap.Create(); Bitmap.PixelFormat := pf24bit; Bitmap.LoadFromResourceName(instance, 'BACKGROUND'); Canvas.Draw(0, 0, Bitmap); Bitmap.Free; ReleaseDC(wnd0, DC); Canvas.Free; end; |
#2
|
||||
|
||||
Цитата:
|
#3
|
||||
|
||||
Есть два варианта:
1. WM_PAINT 2. WM_ERASEBKGND И если пишете на WinAPI, TCanvas-у там делать нечего, как и TBitmap-у, иначе теряется весь смысл оного. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#4
|
|||
|
|||
Создаётся в таком порядке:
Создаем окно --> В WM_CREATE создаём элементы --> DrawBG Элементы не видны, но появляются при наведении, так как меняется состояние. А если не канвасы с битмапами, то что? |
#5
|
||||
|
||||
CreateWindowAPI.dpr
Код:
program CreateWindowAPI; {$R 'CreateWindowAPI.res' 'CreateWindowAPI.rc'} uses Windows, Messages; var AWndClass: WNDCLASS; AWnd: HWND; AMsg: TMsg; bmp: HBITMAP; dcbmp: HDC; tagbmp: TBitmap; function WindowProc(AWnd: HWND; Msg: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall; var rct: TRect; begin case Msg of WM_ERASEBKGND: begin GetClientRect(AWnd, rct); SetStretchBltMode(wParam, HALFTONE); StretchBlt(wParam, 0, 0, rct.Right, rct.Bottom, dcbmp, 0, 0, tagbmp.bmWidth, tagbmp.bmHeight, SRCCOPY); Result:=$ff; end; WM_CLOSE: begin PostQuitMessage(0); Result:=0; end; else Result:=DefWindowProc(AWnd, Msg, wParam, lParam); end end; begin bmp:=LoadBitmap(HInstance, 'bgimage'); GetObject(bmp, SizeOf(TBitmap), @tagbmp); dcbmp:=CreateCompatibleDC(0); SelectObject(dcbmp, bmp); AWndClass.Style:=CS_HREDRAW or CS_VREDRAW; AWndClass.lpfnWndProc:=@WindowProc; AWndClass.cbClsExtra:=0; AWndClass.cbWndExtra:=0; AWndClass.hInstance:=HInstance; AWndClass.hIcon:=LoadIcon(HInstance, 'APPICON'); AWndClass.hCursor:=LoadCursor(0, IDC_ARROW); AWndClass.hbrBackground:=HBRUSH(COLOR_INFOBK)+1; AWndClass.lpszMenuName:=nil; AWndClass.lpszClassName:='TWINAPIFORM'; RegisterClass(AWndClass); AWnd:=CreateWindowEx( 0, AWndClass.lpszClassName, 'MyWinAPIForm', WS_OVERLAPPEDWINDOW or WS_VISIBLE, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 0, 0, HInstance, nil); CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', 'Edit1', WS_CHILD or WS_VISIBLE, 10, 10, 100, 25, AWnd, 0, HInstance, nil); CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', 'Edit2', WS_CHILD or WS_VISIBLE, 10, 40, 100, 25, AWnd, 0, HInstance, nil); CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', 'Edit3', WS_CHILD or WS_VISIBLE, 10, 70, 100, 25, AWnd, 0, HInstance, nil); while GetMessage(AMsg, 0, 0, 0) do begin TranslateMessage(AMsg); DispatchMessage(AMsg); end; DestroyWindow(AWnd); UnregisterClass(AWndClass.lpszClassName, HInstance); DeleteDC(dcbmp); DeleteObject(bmp); end. Код:
bgimage bitmap background.bmp -- результат SelectObject потом восстановить самому) Пишу программы за еду. __________________ |
#6
|
|||
|
|||
Ошибка
Ошибка на StretchBlt.
Полностью код такой: Код:
{$APPTYPE GUI} program LightLauncher; uses windows, messages, commctrl, Graphics, Perimeter in 'Perimeter.pas', SocketsUDP in 'SocketsUDP.pas', cHash in 'cHash.pas'; {$R WindowsXP.res} {$R resources.RES} const WEBTOOLS_ADDR = '127.0.0.1'; WEBTOOLS_PORT = 25564; WND_CLASS_NAME0 = 'LL_WNDCLASS_0'; WND_CLASS_NAME1 = 'LL_WNDCLASS_1'; CHK_REM = 2000; TXT_STAT = 2001; TXT_DOWN = 2002; BTN_LOGIN = 2003; EDIT_PASS = 2004; EDIT_LOGIN = 2005; TXT_PASS = 2006; TXT_LOGIN = 2007; PB_STAT = 2008; var BG: TBitmap; BGDC: HDC; function wnd_proc0(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; forward; export; function create_wnd0: HWND; forward; procedure create_wnd_content0(parent: HWND); forward; function wnd_proc1(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; forward; export; function create_wnd1: HWND; forward; procedure create_wnd_content1(parent: HWND); forward; var instance: longint; h_font, h_big: HFONT; PB, StatText, wnd0: HWND; Remember: Boolean; Socket: TSocket; procedure OnDataRecieved(Data: PClientEventsData); var ReceivedData: string; begin ReceivedData := PAnsiChar(Data.ReceivedData); if ReceivedData = 'BAD' then MessageBox(create_wnd1, 'Неправильные логин или пароль!', 'Ошибка!', MB_ICONERROR); DestroySocket(Socket); end; procedure Auth; var Events: TClientEvents; ConnectionStatus: boolean; SendData: string; begin Socket := CreateClientSocket(WEBTOOLS_ADDR, WEBTOOLS_PORT, ConnectionStatus); if ConnectionStatus = false then begin MessageBox(wnd0, 'Не удалось подключиться к серверу!', 'Ошибка!', MB_ICONERROR); DestroySocket(Socket); Exit; end; FillChar(Events, SizeOf(Events), #0); Events.OnRead := OnDataRecieved; ListenClientSocket(Socket, Events); end; procedure SetPBSize(Size: Integer); begin SendMessage(PB, PBM_SETPOS, Size, 0); end; procedure DrawBG; var bmp: HBITMAP; begin BG := TBitmap.Create(); BG.PixelFormat := pf24bit; bmp := LoadBitmap(instance, 'BACKGROUND'); GetObject(bmp, SizeOf(TBitmap), @BG); BGDC:=CreateCompatibleDC(0); SelectObject(BGDC, bmp); end; function wnd_proc0(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; export; var rct: TRect; begin case message of WM_COMMAND: begin case LOWORD(w_param) of BTN_LOGIN: begin Auth; end; CHK_REM: begin Remember := IsDlgButtonChecked(window, CHK_REM) = BST_CHECKED; end; end; end; WM_CREATE: begin create_wnd_content0(window); end; WM_ERASEBKGND: begin GetClientRect(wnd0, rct); SetStretchBltMode(w_param, HALFTONE); StretchBlt(w_param, 0, 0, rct.Right, rct.Bottom, BGDC, 0, 0, BG.Width, BG.Height, SRCCOPY); end; WM_CLOSE: begin DestroyWindow(window); end; WM_DESTROY: begin FreeWinSock; PostQuitMessage(0); end; else begin wnd_proc0 := DefWindowProc(window, message, w_param, l_param); exit; end; end; wnd_proc0 := 0; end; function wnd_proc1(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; export; begin case message of WM_CREATE: begin create_wnd_content1(window); end; WM_CLOSE: begin DestroyWindow(window); end; WM_DESTROY: begin FreeWinSock; PostQuitMessage(0); end; else begin wnd_proc1 := DefWindowProc(window, message, w_param, l_param); exit; end; end; wnd_proc1 := 0; end; function create_wnd0: HWND; var wnd: HWND; begin wnd := CreateWindowEx($00000100, WND_CLASS_NAME0, 'LightLauncher ', WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX, 100, 200, 510, 368, 0, 0, instance, nil); UpdateWindow(wnd); create_wnd0 := wnd; wnd0 := wnd; end; function create_wnd1: HWND; var wnd: HWND; begin wnd := CreateWindowEx($00000100, WND_CLASS_NAME1, 'LightLauncher - Загрузка файлов', WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX, 100, 200, 674, 300, 0, 0, instance, nil); UpdateWindow(wnd); create_wnd1 := wnd; end; procedure create_wnd_content0(parent: HWND); var wnd: HWND; begin wnd := CreateWindowEx($00000000, 'Static', 'Логин', $50000300, 111, 170, 40, 14, parent, HMENU(TXT_LOGIN), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); wnd := CreateWindowEx($00000000, 'Static', 'Пароль', $50000300, 108, 193, 44, 20, parent, HMENU(TXT_PASS), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); wnd := CreateWindowEx($00000200, 'Edit', '', $50010080, 154, 163, 210, 24, parent, HMENU(EDIT_LOGIN), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); wnd := CreateWindowEx($00000200, 'Edit', '', $500100A0, 154, 192, 210, 24, parent, HMENU(EDIT_PASS), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); wnd := CreateWindowEx($00000000, 'Button', 'Войти', $50012F00, 173, 258, 150, 47, parent, HMENU(BTN_LOGIN), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); wnd := CreateWindowEx($00000000, 'Button', 'Запомнить меня', $50010003, 107, 216, 115, 35, parent, HMENU(CHK_REM), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); end; procedure create_wnd_content1(parent: HWND); var wnd: HWND; begin wnd := CreateWindowEx($00000000, 'Static', 'Идёт загрузка файлов', $50000300, 240, 42, 258, 52, parent, HMENU(TXT_DOWN), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_big), 1); wnd := CreateWindowEx($00000000, 'Static', 'x/x Мб. (x кб/с)', $50000300, 280, 216, 144, 26, parent, HMENU(TXT_STAT), instance, nil); SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1); StatText := wnd; wnd := CreateWindowEx($00000000, 'msctls_progress32', '', WS_CHILD or WS_VISIBLE, 120, 100, 430, 40, parent, HMENU(PB_STAT), instance, nil); SendMessage(wnd, PBM_SETRANGE, 0, MakeLong(0, 100)); PB := wnd; end; procedure register_classes; var wc: WNDCLASS; begin wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hbrBackground := HBRUSH(COLOR_3DFACE + 1); wc.hCursor := LoadCursor(0, IDC_ARROW); wc.hIcon := LoadIcon(instance, 'AppIcon'); wc.hInstance := instance; wc.lpszMenuName := nil; wc.style := CS_PARENTDC or CS_DBLCLKS; wc.lpfnWndProc := @wnd_proc0; wc.lpszClassName := WND_CLASS_NAME0; RegisterClass(wc); wc.lpfnWndProc := @wnd_proc1; wc.lpszClassName := WND_CLASS_NAME1; RegisterClass(wc); end; function message_loop: integer; var message: MSG; begin while GetMessage(message, 0, 0, 0) do begin TranslateMessage(message); DispatchMessage(message); end; message_loop := message.wParam; end; BEGIN instance := GetModuleHandle(nil); InitCommonControls; register_classes; h_font := CreateFont(-13, 0, 0, 0, FW_NORMAL, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'Times New Roman'); h_big := CreateFont(-22, 0, 0, 0, FW_NORMAL, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'Times New Roman'); ShowWindow(create_wnd0, SW_SHOWNORMAL); DrawBG; InitWinSock; message_loop; END. |