[bulldog]

Всем привет, трабл такой. На vlc превосходно работает перерисовка регионов, а на winapi нет. Код у меня такой:

Код:

program APIx_Project3;

uses
  windows,
  messages,
  commctrl;

var
  WinClass : TWndClass;
  Form : HWND;
  Handle : HWND;
  Msg : TMSG;
  hFont : HWND;
  HRegion1, Hreg2, Hreg3: THandle;
  Region: HRGN;

procedure ShutDown; //процедура завершения программы
begin
  DeleteObject(hFont); //удаление шрифта
  UnRegisterClass('TAPIxForm', Form); //удаление окна
  ExitProcess(Form); //закрытие программы
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //обработчик сообщений
begin
  Result := DefWindowProc(hwnd, msg, wparam, lparam);
  case Msg of
WM_COMMAND:
if (lParam = ...) and (HiWord(wParam) = BN_CLICKED) then
  begin
  ...;
  end;
  WM_DESTROY: ShutDown;
  end;
end;

begin
Form := GetModuleHandle(nil);
  with WinClass do
  begin
   Style := CS_PARENTDC; 
   hIcon := LoadIcon(Form, MAKEINTRESOURCE('APIXICON')); 
   lpfnWndProc := @WindowProc;
   hInstance := Form;
   hbrBackground := COLOR_BTNFACE + ...;
   lpszClassName := 'TAPIxForm';
   hCursor := LoadCursor(0, IDC_ARROW);
   Region := CreateEllipticRgn(0, 0, 490, 300);
   SetWindowRgn(Handle, Region, True);
  end;
InitCommonControls;
RegisterClass(WinClass); 

Handle := CreateWindowEx(0, 'TAPIxForm', 'NAC',
WS_POPUP or WS_GROUP or
WS_VISIBLE or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU or WS_EX_CLIENTEDGE,
219, 116, 500, 366,
0, 0,
Form, nil);

hFont := CreateFont(
-11, 0, 0, 0, 0, 0, 0, 0,
DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

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

Подскажите что я делаю не так, в google и yandex ничего не нашёл

[NumLock]

SetWindowRgn после CreateWindowEx

CreateWindowEx без WS_VISIBLE
потом:
ShowWindow
UpdateWindow

[bulldog]

NumLucl сделал так

Код:

program APIx_Project3;

uses
  windows,
  messages,
  commctrl;

var
  WinClass : TWndClass;
  Form : HWND;
  Handle : HWND;
  Msg : TMSG;
  hFont : HWND;
  HRegion1, Hreg2, Hreg3: THandle;
  Region: HRGN;

procedure ShutDown; //процедура завершения программы
begin
  DeleteObject(hFont); //удаление шрифта
  UnRegisterClass('TAPIxForm', Form); //удаление окна
  ExitProcess(Form); //закрытие программы
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //обработчик сообщений
begin
  Result := DefWindowProc(hwnd, msg, wparam, lparam);
  case Msg of
WM_COMMAND:
if (lParam = ...) and (HiWord(wParam) = BN_CLICKED) then
  begin
  ...;
  end;
  WM_DESTROY: ShutDown;
  end;
end;

begin
Form := GetModuleHandle(nil);
  with WinClass do
  begin
   Style := CS_PARENTDC; 
   hIcon := LoadIcon(Form, MAKEINTRESOURCE('APIXICON')); 
   lpfnWndProc := @WindowProc;
   hInstance := Form;
   hbrBackground := COLOR_BTNFACE + ...;
   lpszClassName := 'TAPIxForm';
   hCursor := LoadCursor(0, IDC_ARROW);
  end;
InitCommonControls;
RegisterClass(WinClass); 

Handle := CreateWindowEx(0, 'TAPIxForm', 'NAC',
WS_POPUP or WS_GROUP or 
WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU or WS_EX_CLIENTEDGE,
219, 116, 500, 366,
0, 0,
Form, nil);
Region := CreateEllipticRgn(0, 0, 490, 300);
   SetWindowRgn(Handle, Region, True);

hFont := CreateFont(
-11, 0, 0, 0, 0, 0, 0, 0,
DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
  ShowWindow(Form,SW_SHOW);
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  end.

Но компилица не доканца и ошибок не выводит, ходя в explorer прогу вижу фоном, UpdateWindow не знаю как делать

[NumLock]

Код:

program APIx_Project3;

uses
  windows,
  messages,
  commctrl;

var
  WinClass : TWndClass;
  Form : HWND;
  Handle : HWND;
  Msg : TMSG;
  hFont : HWND;
  HRegion1, Hreg2, Hreg3: THandle;
  Region: HRGN;

procedure ShutDown; //ïðîöåäóðà çàâåðøåíèÿ ïðîãðàììû
begin
  DeleteObject(hFont); //óäàëåíèå øðèôòà
  UnRegisterClass('TAPIxForm', Form); //óäàëåíèå îêíà
  ExitProcess(Form); //çàêðûòèå ïðîãðàììû
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //îáðàáîò÷èê ñîîáùåíèé
begin
  Result := DefWindowProc(hwnd, msg, wparam, lparam);
  case Msg of
WM_COMMAND:
//if (lParam = ...) and (HiWord(wParam) = BN_CLICKED) then
  begin
//  ...;
  end;
  WM_DESTROY: ShutDown;
  end;
end;

begin
Form := GetModuleHandle(nil);
  with WinClass do
  begin
   Style := CS_PARENTDC; 
   hIcon := LoadIcon(Form, MAKEINTRESOURCE('APIXICON')); 
   lpfnWndProc := @WindowProc;
   hInstance := Form;
   hbrBackground := COLOR_BTNFACE; 
   lpszClassName := 'TAPIxForm';
   hCursor := LoadCursor(0, IDC_ARROW);
   Region := CreateEllipticRgn(0, 0, 490, 300);
  end;
InitCommonControls;
RegisterClass(WinClass);

Handle := CreateWindowEx(0, 'TAPIxForm', 'NAC',
WS_POPUP or WS_GROUP or
WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU or WS_EX_CLIENTEDGE,
219, 116, 500, 366,
0, 0,
Form, nil);
   SetWindowRgn(Handle, Region, True);
   ShowWindow(Handle, SW_SHOW);
   UpdateWindow(Handle);

hFont := CreateFont(
-11, 0, 0, 0, 0, 0, 0, 0,
DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

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

[bulldog]

Работает, спасибо