-
Проблема с функцией, результат выполнения которой осуществляется не сразу, а другой функцией, где нет доступа к данным компонента. В частности в конструкторе компонента NewTaskBar необходимо вызвать EnumWindows для заполнения структуры данных информацией о видимых окнах в системе.
function NewTaskBar(AParent: PControl): PTaskBar;
var
data: PTaskBarData;
begin
Result := PTaskBar(NewPanel(AParent, esNone));
New(data, Create);
Result.Transparent:=True;
Result.CustomObj := data;
GetMem(data.fStates, 1024);
Result.AttachProc(@TaskBarWndProc);
Result.OnPaint := Result.PaintTaskBar;
EnumWindows();
end;
Результат перечисления окон возвращается через EnumWindowsProc: function EnumWindowsProc(wnd:HWND; lParam: LPARAM):BOOL; stdcall;
var i:integer;
newwnd:boolean;
begin
result:=true;
newwnd:=true;
if (IsWindowVisible(wnd)) and (GetParent(wnd)=0) and (GetWindow(wnd,GW_OWNER)=0) and
((GetWindowLong(wnd,GWL_EXSTYLE) and WS_EX_TOOLWINDOW)=0) then
begin
i:=0;
while fStates.Apps[i].wnd>0 do begin
if fStates.Apps[i].wnd=wnd then begin
Apps[i]:=GetWndInfo(wnd);
newwnd:=False; end;
i:=i+1;
end;
if newwnd then fStates.Apps[i]:=GetWndInfo(wnd);
end;
end; К data нет доступа, потому, что она, как я понял, не может быть объявлена глобально. На fStates тоже ругается, мол не видит. Вот начало модуля: Unit KolTaskBar;
interface
uses Windows, Messages, KOL;
type
PTaskBar = ^TTaskBar;
TTaskBar = object(TControl)
private
procedure PaintTaskBar( Sender: PControl; DC: HDC );
procedure MouseDown(pt: TPoint);
public
end;
function NewTaskBar(AParent: PControl): PTaskBar;
implementation
Type
TApp = record
Icon16, Icon32: THandle;
wnd:HWND;
Owner:HWND;
Parent:HWND;
Visible:boolean;
lParam: LPARAM;
Caption: String;
ExeName: String;
ExePath: String;
index: integer;
IsFgnd, IsIconic, IsMaximized:boolean;
end;
type
PTaskBarData = ^TTaskBarData;
TTaskBarData = object(TObj)
private
fStates: PTaskBarData;
Apps: array [0..1000] of Tapp;
WndAllCnt, WndCount: integer;
hDLL: THandle;
public
destructor Destroy; virtual;
end;
-
Попробовал передать результат через SendMessage(FindWindow(nil, PChar('1FD35-GF43G')),1343,wnd,0); Предварительно панели компонента присвоил такой же Caption
function NewTaskBar(AParent: PControl): PTaskBar; var data: PTaskBarData; begin Result := PTaskBar(NewPanel(AParent, esLowered)); Result.Caption:='1FD35-GF43G'; Result.AttachProc(@TaskBarWndProc); Result.OnPaint := Result.PaintTaskBar; EnumWindows(@EnumWindowsProc,0); end; Код обработчика сообщений панели:
function TaskBarWndProc( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := False; case Msg.message of 1343: TextOut(GetDC(Sender.Handle), 5, 5, PChar(Int2Str(Msg.message)+'/'+Int2Str(Msg.wParam)+'/'+Int2Str(Msg.lParam)), 20); end; end;
Не срабатывает (
-
Нужно передать Result через lParam.
-
Нет FindWindow не ищет дочерние элементы видимого окна, каковым является KolPanel. Для этого пришлось использовать рекурсивный поиск с помощью FindWindowEx. Вот набросал:
function FindChildWindow(Parent:integer; Text:string):integer; var hChildWnd, hWnd: integer; s:array[0..MAX_PATH-1] of char; begin Result:=0; hWnd:=FindWindowEx(Parent,0,nil,nil); if hWnd=0 then Exit; repeat GetWindowText(hWnd,s,MAX_PATH); if Text=s then begin Result:=hWnd; Break; end; hChildWnd:=FindChildWindow(hWnd, Text); if hChildWnd<>0 then begin Result:=hChildWnd; Break; end; hWnd:=FindWindowEx(Parent,hWnd,nil,nil); until hWnd=0; end;
-
Только заметил, функция находит окно даже если в качестве Parent указать 0. Это же сколько окон ей приходится перебирать )
-
а имя класса окна передавать не пробовал? в моём тесте работало.
FindWindow (0, nameOfClass);
-
Нашел способ круче, безо всяких FindWindow и других перебирательных функций. Быстродействие на слабых машинах будет страдать, ведь функция вызывается много раз. В общем использовал следующий код, позволяющий передавать переменные глобально внутри dll. { Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira }
library ShareLib;
uses ShareMem, Windows, SysUtils, Classes; const cMMFileName: PChar = 'SharedMapData';
{$I DLLDATA.INC}
var GlobalData: PGlobalDLLData; MapHandle: THandle;
{ GetDLLData will be the exported DLL function }
procedure GetDLLData(var AGlobalData: PGlobalDLLData); stdcall; begin { Point AGlobalData to the same memory address referred to by GlobalData. } AGlobalData := GlobalData; end;
procedure OpenSharedData; var Size: Integer; begin { Get the size of the data to be mapped. } Size := SizeOf(TGlobalDLLData);
{ Now get a memory-mapped file object. Note the first parameter passes the value $FFFFFFFF or DWord(-1) so that space is allocated from the system's paging file. This requires that a name for the memory-mapped object get passed as the last parameter. }
MapHandle := CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, Size, cMMFileName);
if MapHandle = 0 then RaiseLastWin32Error; { Now map the data to the calling process's address space and get a pointer to the beginning of this address } GlobalData := MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size); { Initialize this data } GlobalData^.S := 'ShareLib'; GlobalData^.I := 1; if GlobalData = nil then begin CloseHandle(MapHandle); RaiseLastWin32Error; end; end;
procedure CloseSharedData; { This procedure un-maps the memory-mapped file and releases the memory-mapped file handle } begin UnmapViewOfFile(GlobalData); CloseHandle(MapHandle); end;
procedure DLLEntryPoint(dwReason: DWord); begin case dwReason of DLL_PROCESS_ATTACH: OpenSharedData; DLL_PROCESS_DETACH: CloseSharedData; end; end;
exports GetDLLData;
begin { First, assign the procedure to the DLLProc variable } DllProc := @DLLEntryPoint; { Now invoke the procedure to reflect that the DLL is attaching to the process } DLLEntryPoint(DLL_PROCESS_ATTACH); end. Взял отсюда: http://delphiworld.narod.ru/base/share_dll.htmlВот еще с архива этого форума пример использования этого метода при работе с хуками: http://www.delphimaster.net/view/4-84816
|