Текущий архив: 2005.07.18;
Скачать: CL | DM;

Вниз

Формы, контролы и т.д. на Winapi   Найти похожие ветки 

← →
ДГ   (2005-05-24 20:16) [0]

Где можно почитать о том, как создавать формы, контролы и т.д. не на VCL, а на голом Winapi? Понятно, что в хелпе по Winapi, но может какие статейки на русском есть? Примеры?

---

← →
Kerk ©   (2005-05-24 20:38) [1]

Удалено модератором

---

← →
Kerk ©   (2005-05-24 20:39) [2]

Kerk ©   (24.05.05 20:38) [1]

хм... глюк однако

---

← →
ДГ   (2005-05-24 20:49) [3]

Сорри. Перепутал эху.

---

← →
Sergey Masloff   (2005-05-24 21:01) [4]

Win32 Programmers Reference том 1. ТАкже все есть в MSDN

---

← →
Sergey Masloff   (2005-05-24 21:05) [5]

Блин не посмотрел что на русском тебе надо ;-)

---

← →
Sergey Masloff   (2005-05-24 23:39) [6]

Ну вот тебе пример простейшего MDI приложения. Наслаждайся а потом решай ;-)

program TestMDI;
{*
*  Трансляция Win32 Prog Ref by SM
*}

uses
 Windows, Messages,SysUtils;

type
 THREADLIST = record
  hThread :THandle ;
  lpvNext :Pointer;
 end;
 PTHREADLIST = ^THREADLIST;

{ Глобальные переменные }
var
 hModule : THandle;           { handle исполняемого файла данного процесса      }
 hwndMain : THandle;          { handle главного окна                            }
 fKillAll : Boolean;          { устанавливается в TRUE для остановки всех нитей }
 pHead : PTHREADLIST;         { связаный список записей с информацией о нитях   }

 msg : TMSG;

const MM_NEWWIN = 8001;

procedure ErrorExit(lpszMessage : PChar);
begin
MessageBox(hwndMain, lpszMessage, "Error", MB_OK);
ExitProcess(0);
end;

procedure AddThreadToList(hThread : THandle);
var
 pNode : PTHREADLIST;
begin
pNode := PTHREADLIST(LocalAlloc(LPTR,sizeof(PTHREADLIST)));
if (pNode = nil) then
 ErrorExit("malloc failed");
pNode.hThread := hThread;
pNode.lpvNext := Pointer(pHead);
pHead := pNode;
end;

{
* Каждое дочернее окно имеет собственную нить которая может быть испольована
* для решения связаных с окном заданий - например, для перерисовки окна
}
function ThreadFunc(hwnd : THandle) :DWORD; stdcall;
var
 lKillMe : DWORD;
begin
while (True) do
 begin
 lKillMe := GetWindowLong(hwnd, GWL_USERDATA);
   if ((fKillAll) or (lKillMe = 1)) then
         break;
 {  Делаем что-то полезное }
end;
{ Очистка перед завершением нити }
Result := 0;
end;

{  Обработка сообщений дочернего окна }

function ChildWndProc(hwnd : THandle; uiMessage : DWORD; wParam, lParam : DWORD) : DWORD; stdcall;
var
 lPrevLong : Longint;
begin
case uiMessage of
WM_CLOSE:
   begin
    lPrevLong := SetWindowLong(hwnd, GWL_USERDATA, 1);
    Result := DefMDIChildProc(hwnd, uiMessage, wParam, lParam);
   end;
WM_DESTROY:
   Result := 0;
else
   Result := DefMDIChildProc(hwnd, uiMessage, wParam, lParam);
 end;
end;


---

← →
Sergey Masloff   (2005-05-24 23:39) [7]

продолжение:

function MainWndProc(hwnd : THandle; uiMessage : DWORD; wParam, lParam : DWORD) : DWORD; stdcall;
const
hwndClient :THandle = 0;
dwCount :DWORD = 1;
var
ccsClientCreate :CLIENTCREATESTRUCT;
hwndChildWnd :THandle;
IDThread :DWORD;
pNode :PTHREADLIST;

 dwRes : DWORD ;

 hThrd : THandle;
 mdicCreate : MDICREATESTRUCT;
 tchTitleBarText : PChar;
 lPrev : Longint;
begin
 GetMem(tchTitleBarText,32);
 case uiMessage of
 WM_CREATE:
   begin
  ccsClientCreate.hWindowMenu := 0;
  ccsClientCreate.idFirstChild := 1;
  hwndClient := CreateWindow("MDICLIENT", nil,
   WS_CHILD or WS_CLIPCHILDREN or WS_VISIBLE, 0, 0, 0, 0,
   hwnd, 0, hModule, @ccsClientCreate);
  Result := 0;
   end;
 WM_CLOSE:
   begin
  fKillAll := TRUE;
  pNode := pHead;
  while (pNode <> nil) do begin
   SetThreadPriority(pNode.hThread, THREAD_PRIORITY_HIGHEST);
   dwRes := WaitForSingleObject(pNode.hThread, INFINITE);
   pNode := PTHREADLIST(pNode).lpvNext;
  end;
  Result := DefFrameProc(hwnd, hwndClient, uiMessage, wParam, lParam);
    end;
 WM_DESTROY:
   begin
  PostQuitMessage(0);
  Result := 0;
   end;
  WM_COMMAND:
    begin
      case LoWord(wParam) of
        MM_NEWWIN :
          begin
            tchTitleBarText := PChar(Format("ThreadWindow %d", [dwCount]));
       mdicCreate.szClass := "ThreadWindowClass";
        mdicCreate.szTitle := PChar(tchTitleBarText);
        mdicCreate.hOwner := hModule;
       mdicCreate.x := CW_USEDEFAULT;
            mdicCreate.y := CW_USEDEFAULT;
            mdicCreate.cx := CW_USEDEFAULT;
            mdicCreate.cy := CW_USEDEFAULT;
        mdicCreate.style := 0;
            mdicCreate.lParam := 0;

        { Сообщение клиентскому окну о создании дочернего окна }

        hwndChildWnd := SendMessage(hwndClient,
                WM_MDICREATE,
                0,
                Integer(@mdicCreate));

        if (hwndChildWnd = 0) then
         ErrorExit("Failed in Create Child Window");

        {  Структура используемая для сообщения нити о необходимости завершения }
        lPrev := SetWindowLong(hwndChildWnd, GWL_USERDATA, -1);

         {  Создаем приостановленую! нить чтобы задать ей приоритет и запустить }

        hThrd := CreateThread(nil, { Атрибуты безопасности по умолчанию }
          0, { Размер стека по умолчанию }
          @ThreadFunc,
          Pointer(hwndChildWnd), {  Параметр для функции нити }
           CREATE_SUSPENDED, { Флаг - создаем приостановленой }
          DWORD(IDThread)); { возвращает ID нити }

        if (hThrd = 0) then
         ErrorExit("CreateThread failed");

        AddThreadToList(hThrd);
        Inc(dwCount);

        {
         *  Устанавливаем приоритет меньший чем у первичной нити, чтобы процесс
         *  мог обрабатывать ввод пользователя.
         }

        if not(SetThreadPriority(hThrd, THREAD_PRIORITY_BELOW_NORMAL)) then
         ErrorExit("SetThreadPriorityFailed!");
        if (ResumeThread(hThrd) = -1) then
         ErrorExit("ResumeThread failed!");
        Result := 0;
          end;
      else
        Result := DefFrameProc(hwnd, hwndClient, uiMessage, wParam, lParam);
      end;
    end;
  else
    Result := DefFrameProc(hwnd, hwndClient, uiMessage, wParam, lParam);
  end;
end;

function InitializeApp() : Boolean;
var
 hmenuMain, hmenuPopup : THandle;
wc : WNDCLASS;
begin
 { Класс главного окна }
wc.style := CS_OWNDC;
wc.lpfnWndProc := @MainWndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := THandle(hModule);
wc.hIcon := LoadIcon(0, IDI_APPLICATION);
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := color_btnface + 1;
wc.lpszMenuName := nil;
wc.lpszClassName := "MainWindowClass";
 wc.hInstance := hModule;

 if (RegisterClass(wc) = 0) then
 begin
 result := FALSE;
   Exit;
 end;

 { Оконные классы "дочек" }

wc.lpfnWndProc := @ChildWndProc;
wc.lpszClassName := "ThreadWindowClass";
if (RegisterClass(wc) = 0) then
 begin
 result := FALSE;
   Exit;
 end;

 { Меню для главного окна }

hmenuMain := CreateMenu();
hmenuPopup := CreateMenu();

if not(AppendMenu(hmenuPopup, MF_STRING, MM_NEWWIN, "&New Window")) then
 begin
 result := FALSE;
   exit;
 end;
if not(AppendMenu(hmenuMain, MF_POPUP, hmenuPopup, "&Threads")) then
begin
 result := FALSE;
   exit;
 end;

 { Создаем главное окно }
hwndMain := CreateWindow("MainWindowClass", "Primary Window",
 WS_OVERLAPPED or WS_CAPTION or WS_BORDER or WS_THICKFRAME or
 WS_MAXIMIZEBOX or WS_MINIMIZEBOX or WS_CLIPCHILDREN or
 WS_VISIBLE or WS_SYSMENU, CW_USEDEFAULT, CW_USEDEFAULT,
 CW_USEDEFAULT, CW_USEDEFAULT, 0, hmenuMain, hModule, nil);
 
if (hwndMain = 0) then
begin
 result := FALSE;
   exit;
 end;

{ Устанавливаем фкус }

SetFocus(hwndMain);
Result := TRUE;
end;

begin
 IsMultiThread := True;
 fKillAll := False;
hModule := GetModuleHandle(nil);
if not(InitializeApp()) then
 ErrorExit("InitializeApp failed");
while(GetMessage(msg, 0, 0, 0)) do
 begin
 TranslateMessage(msg);
 DispatchMessage(msg);
end
end.


---

← →
Anatoly Podgoretsky ©   (2005-05-25 09:06) [8]

АПИ не может работать с формами.

---

← →
Marser ©   (2005-05-25 16:45) [9]

В MSDN есть примеры.
Общая идеология такова - для создания главного окна необходимо сперва зарегистрировать его класс. Затем после хорошо описанных действий создаются дочерние окна элементов управления.
Если класс стандартный, то сощдать такое окно можно простым CreateWindow/CreateWindowEx.
Наиболее распротранены - Button, Combobx, ScrollBox, ListBox, StaticText и другие.
Затем каждому контролу нужно установить собственную оконнную процедуру. Иначе обработка будет происходить по умолчанию.
И т.д...

---

← →
Игорь Шевченко ©   (2005-05-25 17:08) [10]

> Затем каждому контролу нужно установить собственную оконнную
> процедуру.


Это лишнее

---

← →
Marser ©   (2005-05-25 17:10) [11]

> Игорь Шевченко ©   (25.05.05 17:08) [10] [Новое
>сообщение][Ответить]
>
> > Затем каждому контролу нужно установить собственную
>оконнную
>> процедуру.
>
>
> Это лишнее

Я не сказал "необходимо". См. далее по тексту:

> Иначе обработка будет происходить по умолчанию.

---

← →
Игорь Шевченко ©   (2005-05-25 17:48) [12]

Marser ©   (25.05.05 17:10) [11]

Слово "нужно" мне привиделось ? :)

---

← →
alpet ©   (2005-05-25 18:15) [13]

Обрабатывать сообщения от контролов принадлежащих некоторому окну можно через обработку сообщения WM_COMMAND (при этом в lParam будет хэндл контрола), трогать же оконную процедуру у каждого контрола безосновательно.

---

← →
Sergey Masloff   (2005-05-26 10:21) [14]

Вот еще с кнопками пример и статическим текстом (в отличие от дельфийского Label - отдельное окно).

program VerySimple;
(*
*  Окно с кнопкой и статик текстом.
*)
uses Windows, Messages;

var wc: TWndClassA;
   Inst, Handle, Button1, Label1, Label2, Edit1, Edit2: Integer;
   Msg: TMsg;
   hFont: Integer;

{ Оконная процедура. Не забывать stdcall}

function WndProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
 case uMsg of
 WM_COMMAND :
   begin
     if (lParam = Button1) then
       MessageBoxA(Handle, "Button Clicked!", "Yes", 0);
     Result := 0;
   end;
 WM_DESTROY :
   PostQuitMessage(0);
 else
   Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
 end;
end;

begin
{ регистрируем свой класс окна }
 Inst := hInstance;
 with wc do
 begin
   style         := CS_CLASSDC or CS_PARENTDC;       // Стиль
   lpfnWndProc   := @WndProc;                        // Адрес оконной функции
   hInstance     := Inst;
   hbrBackground := color_btnface + 1;
   lpszClassname := "TESTWINDOW";                    // Имя нового класса
   hCursor       := LoadCursor(0, IDC_ARROW);        // Стандартный курсор
   hIcon         := LoadIcon(Inst, IDI_APPLICATION); // Стандартная иконка
 end;
 RegisterClass(wc);

{ Создаем главное окно программы }
 Handle := CreateWindowEx(WS_EX_WINDOWEDGE, "TESTWINDOW", "Тест",
                          WS_VISIBLE or WS_CAPTION or WS_SYSMENU,
                          200, 200, 200, 85, 0, 0, Inst, nil);

{ На этом окне делаем все прочие элементы - в данном случае LABEL и кнопку}

 Label1 := Createwindow("Static", "", WS_VISIBLE or WS_CHILD or SS_LEFT,
                        8, 12, 80, 13, Handle, 0, Inst, nil);

 Button1 := CreateWindow("Button", "ClickMe", WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
                          100, 10, 75, 39, Handle, 0, Inst, nil);

{ Создаем шрифт для всех элементов. }
 hFont := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
                     OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                     DEFAULT_PITCH or FF_DONTCARE, "MS Sans Serif");

{ Устанавливаем созданный шрифт для всех элементов }
 if hFont <> 0 then
 begin
   SendMessage(Button1, WM_SETFONT, hFont, 0);
   SendMessage(Label1, WM_SETFONT, hFont, 0);
 end;

{ Прописываем текст на метках (Label) }
 SetWindowText(Label1, "TestLabel");

{ Показать окно, и перерисовать содержимое }
 UpdateWindow(Handle);

{ цикл обработки сообщений, он и будет все время крутиться }
 while(GetMessage(Msg, 0, 0, 0)) do
 begin
   TranslateMessage(msg);
   DispatchMessage(msg);
 end;

end.



---

Страницы: 1 вся ветка

Текущий архив: 2005.07.18;
Скачать: CL | DM;

Наверх

Память: 0.53 MB
Время: 0.034 c