Фон позади элементов

serega6531 · #1 12.05.2014, 21:41

Я пишу приложение с графикой на чистом 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;

Но рисунок перекрывает элементы управления (кнопки, edit'ы), а мне нужно, чтобы они были поверх фона. Как это сделать? Прозрачность в нужных местах не подходит, т.к. некрасиво.

poli-smen · #2 13.05.2014, 01:02

Цитата:

Сообщение от serega6531

Но рисунок перекрывает элементы управления (кнопки, edit'ы), а мне нужно, чтобы они были поверх фона. Как это сделать? Прозрачность в нужных местах не подходит, т.к. некрасиво.

Как это фоновый рисунок может перекрывать оконные элементы управления? Что-то ты не то делаешь...

angvelem · #3 13.05.2014, 03:04

Есть два варианта:
1. WM_PAINT
2. WM_ERASEBKGND
И если пишете на WinAPI, TCanvas-у там делать нечего, как и TBitmap-у, иначе теряется весь смысл оного.

serega6531 · #4 13.05.2014, 07:51

Создаётся в таком порядке:
Создаем окно --> В WM_CREATE создаём элементы --> DrawBG
Элементы не видны, но появляются при наведении, так как меняется состояние.

А если не канвасы с битмапами, то что?

NumLock · #5 13.05.2014, 19:55

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.

CreateWindowAPI.rc

Код:

bgimage bitmap background.bmp

background.bmp

--

результат SelectObject потом восстановить самому)

serega6531 · #6 13.05.2014, 20:28

Ошибка на 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.

NumLock · #7 13.05.2014, 20:32

ну так ищи сам ошибку у себя. тебе уже дали полностью рабочий пример.

serega6531 · #8 13.05.2014, 21:11

Исправил ошибку, но фон теперь совсем не рисуется. Вот скриншот:

А вот код:

Код:

{$APPTYPE GUI}
program LightLauncher;

...

var
  BG: TBitmap;
  BGDC: HDC;

...

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

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 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);
	message_loop;
END.

serega6531 · #9 13.05.2014, 22:54

Похоже, что LoadBitmap завершается с ошибкой, так как возвращает 0. Это может быть связано с тем, что bmp 24-битный?

NumLock · #10 14.05.2014, 19:53

ты в ресурс то картинку добавил?

serega6531 · #11 14.05.2014, 20:11

Цитата:

Сообщение от NumLock

ты в ресурс то картинку добавил?

Конечно. Код из первого сообщения работает, но перекрывает элементы.

NumLock · #12 14.05.2014, 20:42

http://yadi.sk/d/sBmqjFvNQDa9e

serega6531 · #13 14.05.2014, 21:03

У вас работает, у меня не работает. Даже с вашей картинкой. В чем ошибка? Код в предыдущих сообщениях.

angvelem · #14 14.05.2014, 21:58

1. Зачем в оконной процедуре, директива export?
2. Выклади проект в архиве.

serega6531 · #15 14.05.2014, 22:17

Держите

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты