Форум: "Начинающим";
Текущий архив: 2006.11.19;
Скачать: [xml.tar.bz2];

Вниз

Запуск потока Windows API   Найти похожие ветки 

← →
Andrey.Ru   (2006-10-27 12:52) [0]

Мне необходимо получить окно, но каким то образом все пре процедуры запихнуть в класс. Вот мой текст модуля, единственное что там не работает, так это запуск цикла сообщений в отдельном потоке. Может мне кто-нибудь разъяснить почему поток не запускается?

unit SmartWnd;

interface

uses
 windows,
 messages;

type
 TSmartWindow = class
 private
   fHandle : cardinal;
   fWidth,
   fHeight,
   fTop,
   fLeft   : integer;
   procedure SetWidth(val  : integer);
   procedure SetHeight(val : integer);
   procedure SetTop(val    : integer);
   procedure SetLeft(val   : integer);
 public
   constructor Create;
   destructor  Destroy; override;
   Procedure   Close;
 published
   property Width  : integer  read fWidth   write SetWidth;
   property Height : integer  read fHeight  write SetHeight;
   property Top    : integer  read fTop     write SetTop;
   property Left   : integer  read fLeft    write SetLeft;
   property Handle : Cardinal read fHandle;
 end;

 function SmartWndProc(Wnd    : HWND;
                       Mess   : Cardinal;
                       wParam : integer;
                       lParam : LongInt) : LongInt; stdcall;

 procedure WhileThread; stdcall;

 var
   GLFM : TSmartWindow;

implementation
//------------------------------------------------------------------------------
procedure TSmartWindow.Close;
 begin
   Destroy;
 end;
//------------------------------------------------------------------------------
constructor TSmartWindow.Create;
 var
   Res      : word;
   WndClass : TWndClass;
   ThID : cardinal;
 begin
   fLeft   := 0;
   fTop    := 0;
   fWidth  := 200;
   fHeight := 200;
   WndClass.lpszClassName := "GlWindow";
   WndClass.style := CS_VREDRAW or CS_HREDRAW;
   WndClass.lpfnWndProc := @SmartWndProc;
   WndClass.hInstance := hInstance;
   WndClass.cbClsExtra := 0;
   WndClass.cbWndExtra := 0;
   WndClass.hIcon := LoadIcon(0, IDI_APPLICATION);
   WndClass.hCursor := LoadCursor(0, IDC_ARROW);
   WndClass.hbrBackground := COLOR_BTNFACE + 1;
   WndClass.lpszMenuName := nil;
   Res := Windows.RegisterClass(WndClass);
   if Res = 0 then
     MessageBox(0, "Class not registred", "Error", MB_OK + MB_ICONERROR);
   GLFM := self;
   fHandle := CreateWindow(WndClass.lpszClassName,
                           "GlWindow",
                           WS_CAPTION + WS_SIZEBOX + WS_SYSMENU,
                           fLeft,
                           fTop,
                           fWidth,
                           fHeight,
                           0,
                           0,
                           hInstance,
                           nil);
   if fHandle = 0 then
     MessageBox(0, "Window not create", "Error", MB_OK + MB_ICONERROR);
   ShowWindow(fHandle, SW_ShowNormal);
   CreateThread(nil, 1024, @WhileThread, nil, 0, ThID);
 end;
//------------------------------------------------------------------------------
procedure WhileThread; stdcall;
 var
   Msg : TMsg;
 begin
   while GetMessage(Msg, 0, 0, 0) do
     begin
       TranslateMessage(Msg);
       DispatchMessage(Msg);
     end;
 end;
//------------------------------------------------------------------------------
destructor TSmartWindow.Destroy;
 var
   CP : cardinal;
 begin
   CP := GetCurrentProcess;
   TerminateProcess(CP, 0);
   inherited;
 end;
//------------------------------------------------------------------------------
function SmartWndProc(Wnd    : HWND;
                     Mess   : Cardinal;
                     wParam : integer;
                     lParam : LongInt) : LongInt; stdcall;
 begin
   Result := 0;
   with GLFM do
   case mess of
     WM_DESTROY :  Destroy;
     WM_MOVE :     begin
                     fTop    := HIWORD(lParam);
                     fLeft   := LOWORD(lParam);
                   end;
     WM_SIZE :     begin
                     fWidth  := LOWORD(lParam);
                     fHeight := HIWORD(lParam);
                   end;
     else
       begin
         Result := DefWindowProc(Wnd,
                                 Mess,
                                 wParam,
                                 lParam);
       end;
   end;
 end;
//------------------------------------------------------------------------------
procedure TSmartWindow.SetHeight(val: integer);
 begin
   if val <> fHeight then
     begin
       SetWindowPos(fHandle, 0, fLeft, fTop, fWidth, val, SWP_DRAWFRAME);
       fHeight := val;
     end;
 end;
//------------------------------------------------------------------------------
procedure TSmartWindow.SetLeft(val: integer);
 begin
   if val <> fLeft then
     begin
       SetWindowPos(fHandle, 0, val, fTop, fWidth, fHeight, SWP_DRAWFRAME);
       fLeft := val;
     end;
 end;
//------------------------------------------------------------------------------
procedure TSmartWindow.SetTop(val: integer);
 begin
   if val <> fTop then
     begin
       SetWindowPos(fHandle, 0, fLeft, val, fWidth, fHeight, SWP_DRAWFRAME);
       fTop := val;
     end;
 end;
//------------------------------------------------------------------------------
procedure TSmartWindow.SetWidth(val: integer);
 begin
   if val <> fWidth then
     begin
       SetWindowPos(fHandle, 0, fLeft, fTop, val, fHeight, SWP_DRAWFRAME);
       fWidth := val;
     end;
 end;
//------------------------------------------------------------------------------
end.

---

← →
Сергей М. ©   (2006-10-27 13:00) [1]

> почему поток не запускается?


Кто тебе сказал, что он не запускается ?

---

← →
Игорь Шевченко ©   (2006-10-27 13:03) [2]

Окно должно создаваться в том же потоке, что и выборка сообщений

---

← →
Andrey.Ru   (2006-10-27 13:13) [3]

> Игорь Шевченко ©   (27.10.06 13:03) [2]
> Окно должно создаваться в том же потоке, что и выборка сообщений


Пробывал вообще все в поток запихать, но такое чувство что поток не стартует вовсе. Под отладчиком проверьте кому не лень, модуль то небольшой. Да, и необязятельно создавать окно в томже потоке что и выборка сообщений, оконный класс и так к нему привязан. А GetMessage можно и в отдельном потоке пустить, теоретически. На практике пока чтото не получилось.

---

← →
Сергей М. ©   (2006-10-27 13:30) [4]

> Пробывал .. запихать


Не надо "пихать". Надо думать.


> чувство что поток не стартует


Верить следует не чувствам, а инстр.средствам разработки/отладки программ.


> Под отладчиком проверьте кому не лень


Угу. тебе самому лень, а мы все бросай и проверяй ?)
Совесть-то имей немного)..


> необязятельно создавать окно в томже потоке что и выборка
> сообщений


Да, не обязательно.


>  оконный класс и так к нему привязан


?!!!


> GetMessage можно и в отдельном потоке пустить, теоретически


Не только теоретически, но и практически.
Но если окно W создано в контексте потока А, то GetMessage(), вызыванный в контексте потока В, хоть обделайся, не получит ни единого сообщения, адресованного кем-бы то ни было окну W (если, конечно же, не использованы AttachThreadInput() и иже с ней)

---

← →
Игорь Шевченко ©   (2006-10-27 14:57) [5]

> Да, и необязятельно создавать окно в томже потоке что и
> выборка сообщений, оконный класс и так к нему привязан.


Оконный класс привязывается не к потокам, а к процессам.


> А GetMessage можно и в отдельном потоке пустить, теоретически


Если сделать AttachThreadInput, предварительно почитав Рихтера.

---

← →
Anatoly Podgoretsky ©   (2006-11-03 10:16) [6]

> Под отладчиком проверьте кому не лень

Нам лень, но нам и не надо.

---

← →
han_malign ©   (2006-11-03 10:52) [7]

пользуся пока я добрый:
unit uWinThread;
{$IFDEF VER150}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{$ENDIF}
interface
uses
{$IFDEF LINUX}
 Messages, WinUtils, Windows, Classes;
{$ENDIF}
{$IFDEF MSWINDOWS}
 Messages, Windows, Classes;
{$ENDIF}

type
{$IFDEF LINUX}
 TWndMethod = WinUtils.TWndMethod;
{$ENDIF}
{$IFDEF MSWINDOWS}
 TWndMethod = Classes.TWndMethod;
{$ENDIF}

  TCreateParams = record
     Caption: PChar;
     Style: DWORD;
     ExStyle: DWORD;
     X, Y: Integer;
     Width, Height: Integer;
     WndParent: HWnd;
     Param: Pointer;
     WindowClass: TWndClass;
     WinClassName: array[0..63] of Char;
  end;

  TWinThread = class
  private
     F_pCS: TRtlCriticalSection;
     F_hWnd: HWnd;
     F_hThread: THandle;
     F_dwThreadId: DWORD;
     FObjectInstance: Pointer;
     FDefWndProc: Pointer;
     FWindowProc: TWndMethod;
     F_hRun: THandle;
     F_pMsg: TMsg;
     function _threadLoop: integer;
  protected
     procedure CreateHandle; virtual;
     procedure CreateParams(var Params: TCreateParams); virtual;
     procedure CreateSubClass(var Params: TCreateParams;
        ControlClassName: PChar);
     procedure CreateWindowHandle(const Params: TCreateParams); virtual;
     procedure CreateWnd; virtual;

     procedure DestroyHandle;
     procedure DestroyWindowHandle; virtual;
     procedure DestroyWnd; virtual;

     procedure MainWndProc(var Message: TMessage);
     procedure WndProc(var Message: TMessage); virtual;

     procedure Lock;
     procedure Unlock;

     function Run: integer;
     function Idle(): boolean;virtual;
     function IsMsgIdle(var Message: TMsg): boolean;virtual;

     property Handle: HWND read F_hWnd;
  public
     function SendMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
     function PostMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;

     function  WaitMsgQueue(aTimeout: DWORD): boolean;
     procedure Start;
     procedure Stop;
     constructor Create;
     destructor Destroy;override;
  end;
implementation
{=============================================================================== }
threadvar
 CreationControl: TWinThread;

function InitWndProc(HWindow: HWnd; Message, WParam,
 LParam: Longint): Longint stdcall;
{$IFDEF LINUX}
type
 TThunkProc = function (HWindow: HWnd; Message, WParam, LParam: Longint): Longint stdcall;
{$ENDIF}
var
 WinControl: TWinThread;
begin
 CreationControl.F_hWnd := HWindow;
 SetWindowLong(HWindow, GWL_WNDPROC,
   Longint(CreationControl.FObjectInstance));
 if (GetWindowLong(HWindow, GWL_STYLE) and WS_CHILD <> 0) and
   (GetWindowLong(HWindow, GWL_ID) = 0) then
   SetWindowLong(HWindow, GWL_ID, HWindow);
 WinControl := CreationControl;
 CreationControl := nil;
{$IFDEF LINUX}
 Result := TThunkProc(WinControl.FObjectInstance)(HWindow, Message, WParam, LParam);
{$ENDIF}

 asm
       PUSH    LParam
       PUSH    WParam
       PUSH    Message
       PUSH    HWindow
       MOV     EAX,WinControl
       CALL    [EAX].TWinThread.FObjectInstance
       MOV     Result,EAX
 end;

end;


---

← →
han_malign ©   (2006-11-03 10:52) [8]

{========================================================================= ======}
function TWinThread._threadLoop: integer;
begin
  CreateWnd;
  Result:= Run;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.CreateHandle;
begin
  if(F_hWnd = 0)then CreateWnd;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.CreateParams(var Params: TCreateParams);
begin
 FillChar(Params, SizeOf(Params), 0);
 with Params do
 begin
   Style := 0;//WS_CHILD or WS_CLIPSIBLINGS;
   ExStyle:= 0;
   X := 0;
   Y := 0;
   Width := 0;
   Height := 0;
   WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
   WindowClass.lpfnWndProc := @DefWindowProc;
   WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
   WindowClass.hbrBackground := 0;
   WindowClass.hInstance := HInstance;
   lstrcpyn(WinClassName, PChar(String(ClassName)), sizeof(WinClassName));
 end;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.CreateSubClass(var Params: TCreateParams;
  ControlClassName: PChar);
const
 CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS;
 CS_ON = CS_VREDRAW or CS_HREDRAW;
var
 SaveInstance: THandle;
begin
 if ControlClassName <> nil then
   with Params do
   begin
     SaveInstance := WindowClass.hInstance;
     if not GetClassInfo(HInstance, ControlClassName, WindowClass) and
       not GetClassInfo(0, ControlClassName, WindowClass) and
       not GetClassInfo(MainInstance, ControlClassName, WindowClass) then
       GetClassInfo(WindowClass.hInstance, ControlClassName, WindowClass);
     WindowClass.hInstance := SaveInstance;
     WindowClass.style := WindowClass.style and not CS_OFF or CS_ON;
   end;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.CreateWindowHandle(const Params: TCreateParams);
begin
 with Params do
   F_hWnd := CreateWindowEx(ExStyle, WinClassName, Caption, Style,
     X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.CreateWnd;
var
 Params: TCreateParams;
 TempClass: TWndClass;
 ClassRegistered: Boolean;
begin
  CreateParams(Params);
  with Params do begin
     FDefWndProc := WindowClass.lpfnWndProc;
     ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
     if not ClassRegistered or (TempClass.lpfnWndProc <> @InitWndProc) then
     begin
        if ClassRegistered then Windows.UnregisterClass(WinClassName,
           WindowClass.hInstance);
        WindowClass.lpfnWndProc := @InitWndProc;
        WindowClass.lpszClassName := WinClassName;
        if Windows.RegisterClass(WindowClass) = 0 then exit;
     end;
     CreationControl := Self;
     CreateWindowHandle(Params);
     if F_hWnd = 0 then exit;
     if (GetWindowLong(F_hWnd, GWL_STYLE) and WS_CHILD <> 0) and
        (GetWindowLong(F_hWnd, GWL_ID) = 0) then
        SetWindowLong(F_hWnd, GWL_ID, F_hWnd);
  end;
end;{}
{-------------------------------------------------------------------------------}


---

← →
han_malign ©   (2006-11-03 10:53) [9]

procedure TWinThread.DestroyHandle;
begin
 if F_hWnd <> 0 then
 begin
   DestroyWnd;
 end;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.DestroyWindowHandle;
begin
  Windows.DestroyWindow(F_hWnd);
  F_hWnd:= 0;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.DestroyWnd;
begin
  DestroyWindowHandle;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.MainWndProc(var Message: TMessage);
begin
  FWindowProc(Message);
  with Message do
  if(Result = 0)then begin
     case(Msg)of
     WM_CLOSE: begin
        DestroyHandle;
     end;
     WM_DESTROY: begin
        PostQuitMessage(0);
     end;
     WM_NCCREATE: begin
        Result:= 1;
     end;
     else
        Result:= CallWindowProc(FDefWndProc, F_hWnd, Msg, WParam, LParam);
     end;
  end;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.WndProc(var Message: TMessage);
begin
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.Lock;
begin
  EnterCriticalSection(F_pCS);
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.Unlock;
begin
  LeaveCriticalSection(F_pCS);
end;{}
{-------------------------------------------------------------------------------}
function TWinThread.Run: integer;
var fIdle: boolean;
begin
  fIdle:= true;
  SetEvent(F_hRun);

  while(F_hWnd <> 0) do begin
     while(fIdle and not PeekMessage(F_pMsg, 0, 0, 0, PM_NOREMOVE)) do begin
        if(not Idle())then fIdle:= false;
     end;
     if(Integer(GetMessage(F_pMsg, 0, 0, 0)) <= 0)then begin
        Result:= F_pMsg.wParam;
        exit;
     end;
     TranslateMessage(F_pMsg);
     DispatchMessage(F_pMsg);
     if(IsMsgIdle(F_pMsg))then fIdle:= true;
  end;
  Result:= -1;
end;{}
{-------------------------------------------------------------------------------}
function TWinThread.Idle(): boolean;
begin
  Result:= false;
end;{}
{-------------------------------------------------------------------------------}
function TWinThread.IsMsgIdle(var Message: TMsg): boolean;
begin
  Result:= false;
end;{}
{-------------------------------------------------------------------------------}
function TWinThread.SendMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Result:= -1;
  if(F_hWnd <> 0)then Result:= Windows.SendMessage(F_hWnd, Msg, wParam, lParam);
end;{}
{-------------------------------------------------------------------------------}
function TWinThread.PostMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
begin
  Result:= BOOL(-1);
  if(F_hWnd <> 0)then Result:= Windows.PostMessage(F_hWnd, Msg, wParam, lParam);
end;{}
{-------------------------------------------------------------------------------}
function  TWinThread.WaitMsgQueue(aTimeout: DWORD): boolean;
begin
  Start;
  Result:= (F_hThread <> 0)and(WaitForSingleObject(F_hRun, aTimeout) = WAIT_OBJECT_0);
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.Start;
begin
  if(F_hThread = 0)then begin
     F_hThread:= BeginThread(nil, 0, TThreadFunc(@TWinThread._threadLoop), self, 0, F_dwThreadID);
  end;
end;{}
{-------------------------------------------------------------------------------}
procedure TWinThread.Stop;
begin
  if(F_hThread <> 0)then begin
     WaitForSingleObject(F_hRun, INFINITE);
     if(F_hWnd <> 0)then Windows.SendMessage(F_hWnd, WM_CLOSE, 0, 0);
     WaitForSingleObject(F_hThread, INFINITE);
     F_hThread:= 0;
     F_hWnd:= 0;
     ResetEvent(F_hRun);
  end;
end;{}
{-------------------------------------------------------------------------------}
constructor TWinThread.Create;
begin
{$IFDEF LINUX}
 FObjectInstance := WinUtils.MakeObjectInstance(MainWndProc);
{$ENDIF}
{$IFDEF MSWINDOWS}
 FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
{$ENDIF}
 FWindowProc:= WndProc;
 InitializeCRiticalSection(F_pCS);
 F_hRun:= CreateEvent(nil, true, false, nil);
end;{}
{-------------------------------------------------------------------------------}
destructor TWinThread.Destroy;
begin
 Stop;
{$IFDEF LINUX}
 if FObjectInstance <> nil then WinUtils.FreeObjectInstance(FObjectInstance);
{$ENDIF}
{$IFDEF MSWINDOWS}
 if FObjectInstance <> nil then Classes.FreeObjectInstance(FObjectInstance);
{$ENDIF}
 DeleteCriticalSection(F_pCS);
end;{}
{-------------------------------------------------------------------------------}
end.


---

← →
novill ©   (2006-11-03 17:54) [10]

> [7] han_malign ©   (03.11.06 10:52)

А как этим всем пользоваться?
По доброте можешь еще несколько строчек запостить?

---

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

Форум: "Начинающим";
Текущий архив: 2006.11.19;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.52 MB
Время: 0.044 c