[serega6531]

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

А вот код:

Код:

{$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.