| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Перетаскивание формы [D6]

vvvaaa ©   (2005-08-25 15:13:00) 

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

   ...

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
 inherited;
 if M.Result = htClient then M.Result := htCaption;
end;

А как сделать этоже на чистом API?

---

vvvaaa   (2005-08-25 16:26:00) [1]

> Leonid Troyanovsky ©   (25.08.05 16:19) [5]
Спасибо, то что надо

---

Leonid Troyanovsky   (2005-08-25 16:19:00) [2]

> vvvaaa   (25.08.05 15:57) [2]
> ok покажи как на на грязном, а на счет почисить чёнить придумаю


Вставь в оконную процедуру, что-то вроде:


 case msg of
  ..
  WM_NCHITTEST:
    begin
      Result := DefWindowProc(wnd, msg, awparam, alparam);
        if Result = HTCLIENT then
          begin
            Result := HTCAPTION;
            Exit;
          end;
    end;


--
Regards, LVT.

---

vvvaaa   (2005-08-25 16:06:00) [3]

Спасибо конечно, но как создавать форму и объекты я знаю. Меня интересует конкретно обработка собщения WM_NCHITTEST

---

alpet   (2005-08-25 15:59:00) [4]

Создай окно, организуй ему оконную процедуру, и запусти цикл сообщений. Для сообщения сделай проверку в оконной процедуре.

Simple demonstration code:

Uses Windows, Messages, ExtCtrls, Printers;
var hMainWnd: THandle;
   hCtrls: array of THandle;
   msg: tagMSG;

function RegClassEx (name: PAnsiChar; wFunc: Pointer; style: dword): Boolean;
var
  wclass: WNDCLASSEXA;
begin
result := true;
fillchar (wclass, sizeof (wclass), 0);
wclass.cbSize := sizeof (wclass);
if not GetClassInfoEx (hInstance, PChar (name), wclass) then
 begin
  wclass.cbSize := sizeof (wclass);
  wclass.lpszClassName := name;
  wclass.lpfnWndProc := wFunc;
  wclass.style := style;
  wclass.hInstance := hInstance;
  wclass.hbrBackground := GetSysColorBrush (COLOR_BTNFACE);
  wclass.hCursor := LoadCursor (0, IDC_ARROW);
  result := RegisterClassEx (wclass) <> 0;
 end;
end;

function OnCreate: Bool;
begin
// some actions on create
result := false;
end;

function MainWndFunc (hWnd: THandle; uMsg, wParam, lParam: dword): Integer; stdcall;
var bHandled: Bool;
begin
result := 0;
bHandled := false;
case uMsg of
 WM_CREATE: bHandled := OnCreate;
 WM_CLOSE: bHandled := DestroyWindow (hWnd);
end;
if not bHandled then result := DefWindowProc (hWnd, uMsg, wParam, lParam);
end; // MainWndFunc

function CreateWndIndirect (const cs: tagCREATESTRUCTA; ctrl_id: dword = 0): HWND;
begin
with cs do
result := CreateWindowEx (dwExStyle, lpszClass, lpszName,
                          style, x, y, cx, cy,
                          hwndParent, 0, hInstance, @cs);
if (ctrl_id <> 0) and (result <> 0) then
   SetWindowLong (result, GWL_ID, ctrl_id);
end;

procedure SetCSRect (var cs: tagCREATESTRUCTA; x, y, cx, cy: Integer);
begin
cs.x := x;
cs.y := y;
cs.cx := cx;
cs.cy := cy;
end;

const wClassName = 'DemoWindowClass';
var cs: tagCREATESTRUCTA;
begin
{ ... }
if not RegClassEx (wClassName, @MainWndFunc,
                      CS_HREDRAW or CS_VREDRAW or CS_OWNDC) then exit;

fillChar (cs, sizeof (cs), 0);
cs.dwExStyle := WS_EX_APPWINDOW or WS_EX_CONTROLPARENT or WS_EX_DLGMODALFRAME;
cs.style := WS_VISIBLE or WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW or WS_TABSTOP;
cs.lpszName := 'Caption';
cs.lpszClass := wClassName;
cs.hInstance := hInstance;
SetCSRect (cs, CW_USEDEFAULT, CW_USEDEFAULT, 240, 150);
hMainWnd := CreateWndIndirect (cs);
{ Creating child controls }
SetLength (hCtrls, 2);
cs.lpszClass := 'button';
cs.lpszName := 'ok';
cs.hwndParent := hMainWnd;
cs.style := BS_PUSHBUTTON or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CHILD or WS_TABSTOP;
cs.dwExStyle := 0;
SetCSREct (cs, 10, 10, 200, 25);
hCtrls [0] := CreateWndIndirect (cs, 101);
cs.lpszName := 'cancel';
SetCSRect (cs, 10, 50, 200, 25);
hCtrls [1] := CreateWndIndirect (cs, 102);

while (IsWindow (hMainWnd) and GetMessage (msg, 0, 0, 0)) do
 begin
  TranslateMessage (msg);
  DispatchMessage (msg);
  if (msg.message = WM_CHAR) and (msg.wParam = VK_TAB) then
   begin
    //PostMessage (hMainWnd, WM_NEXTDLGCTL, 0, 0);
    if GetFocus = hCtrls [0] then SetFocus (hCtrls [1]) else SetFocus (hCtrls [0]);
   end;
 end;
end.


---

vvvaaa   (2005-08-25 15:57:00) [5]

ok покажи как на на грязном, а на счет почисить чёнить придумаю

---

Leonid Troyanovsky   (2005-08-25 15:31:00) [6]

> vvvaaa   (25.08.05 15:13)  
> А как сделать этоже на чистом API?


Например, можно сделать на грязном,
а потом слегка почистить.

--
Regards, LVT.

---

Наверх