Yurgel
Joined: 26 Dec 2007
Posts: 2
Location: Moscow, Russia
|
 Posted: Wed Dec 26, 2007 11:04 pm Post subject: few words about writing plug-ins in Delphi |
 |
|
Good day to all of you. I'm newbie here, so maybe currently i'm writing wrong things in wrong place - i'll beg your pardon, if this is so  Hope that moderators will put things right or just kill the post if it isn't necessary.
but i'd like to share some ideas about the subj, 'cause current situation looks a little bit incorrect. First, examples, provided for "delphi-writers" in Plugin SDK have no common with regular Delphi approach for writing things of a such kind. It's not a "object-oriented code", it's just a word-by-word translation of C++ sources. And these examples, from my point of view, are violating the main idea of Delphi - to let the developer concentrate at really important things, not at window creating by calling Win32 API functions. (BTW, this is one of the reasons, why delphists are called "mouse-clickers" - the main part of a job IDE does itself, but from other hand - that is the factor which let us think about the goal but not the implementation) All mentioned above is just my point of view, and i'm gonna to prove it
The second and the last. Although creating plugins for Aston in Delphi IS VERY EASY, provided samples can only frighten a person who is really writing in pure Delphi and, in most cases, has no idea about Win32 API. Of course, we will have to use low-level functions, but not for implementing the whole gadget, but only for providing some specific "Aston-looking" behavior to our form.
Well, here the philosophy ends, and let us get to "mouse-clicking" closely.
===============================================
We know, that Aston plugin is a regular dynamic loadable library, dll, with specific extension and a row of a specific functions, being exported. This is the only one thing, which we will need from the examples in SDK - we must understand, what functions with which parameters we will have to export, when we're writing our own plugin. I was fighting with DeskChld.dpr, but the logic is quite similar everywhere.
So, exported functions are:
| Code: |
exports
InitGlobalModule,
DoneModule;
end. |
Let's have a look at them:
| Code: |
procedure InitGlobalModule(const AstonData:PAstonData);stdcall;
var
WindowClass:TWndClass;
begin
RtlMoveMemory(@AData, AstonData, SizeOf(TAstonData));
RtlZeroMemory(@WindowClass, sizeOf(TWndClass));
WindowClass.style:=CS_HREDRAW or CS_VREDRAW;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hInstance := hInstance;
WindowClass.lpfnWndProc:=@WindowProc;
WindowClass.lpszClassName:= szClassName;
if RegisterClass(WindowClass) = 0 then exit;
ReadConfig;
ChildWindow:= CreateWindowEx(WS_EX_TRANSPARENT,
szClassName,
nil,
WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
XPos, YPos,
64, 48,
AData.Desktop,
0,
hInstance,
nil);
AData.Node.Wnd:= ChildWindow;
GetClientRect(ChildWindow, ClientRC);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure DoneModule; stdcall;
begin
if ChildWindow<>0 then
begin
DestroyWindow(ChildWindow);
ChildWindow:=0;
end;
UnregisterClass(szClassName, hInstance);
|
InitGlobalModule is the main function, that is being called from Aston and have to fire up our module. What it does?
Adata is a global variable, which is being used in other functions. When we are being called from Aston for the very first time, Aston is passing to us the pointer to it's own data. Note, that we can modify this data. Although this is a constant parameter, but actually it is a pointer. We can't modify the address in memory, which this pointer is pointing to, and that is why it is "const", but we can freely modify the data, which resides at this address, and these changes may reflect at the Aston's behavior. So, in this function we are receiving a pointer to some internal Aston data and here we are supposed to create our own form. Given example creates this form by calling Win32 API functions, says to Aston, that his Desktop have to be a parent for the window created, and stores coordinates of the window in another global variables. Actually, this is almost everyting, that this procedure does: receives reference at Aston's desktop, creates window, parented to this desktop, and copies Aston's data to it's own variables, which will be available until the module is loaded in memory.
procedure DoneModule is quite transparent - it's just freeing our form, created before.
Now, when we're understanding, what we have to do, let's forget about examples and create the subj in Delphi style. What does the Delphist when he have to create the new form? The correct answer - he is pushing the appropriate menu item. The goal is quite simple: we have to create new library, add a form to it, and exports two functions: one creating the form parented to a given structure and the second, freeing this form. The whole source will look loke this:
| Code: |
library lazycpu;
uses
Windows,
Messages,
FNxxx in '..\..\AstonSDK\Pascal\SDK\FNxxx.pas',
AstonSDK in '..\..\AstonSDK\Pascal\SDK\AstonSDK.pas',
st_api in '..\..\AstonSDK\Pascal\SDK\st_api.pas',
Unit1 in 'Unit1.pas' {Form1};
{---------------------------------------------------------------------}
{$IFDEF Debug}
{$E .plg}
{$ELSE}
{$I ..\plg.pas}
{$ENDIF}
{$IMAGEBASE $00400000}
procedure InitGlobalModule(const AstonData:PAstonData);stdcall;
begin
Form1 := TForm1.CreateParented (AstonData^);
end;
procedure DoneModule; stdcall;
begin
if Assigned (Form1) then begin
Form1.Free;
Form1 := nil;
end;
end;
exports
InitGlobalModule,
DoneModule;
end.
|
Look at the original DeskChld.dpr from SDK:
| Code: |
library DeskChld;
uses
Windows,
Messages,
FNxxx in '..\..\SDK\FNxxx.pas',
AstonSDK in '..\..\SDK\AstonSDK.pas',
st_api in '..\..\SDK\st_api.pas';
{---------------------------------------------------------------------}
{$IFDEF Debug}
{$E .plg}
{$ELSE}
{$I ..\..\plg.pas}
{$ENDIF}
{$IMAGEBASE $00400000}
{---------------------------------------------------------------------}
const
szClassName = 'Desktop Plugin Sample';
szXPos = 'XPos';
szYPos = 'YPos';
var
AData: TAstonData;
ChildWindow:hWnd=0;
ClientRC:TRect;
XPos, YPos: integer;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure SavePos;
var
CFG:TCFG;
r:TRect;
begin
OpenCFGw(AData.PluginsCFG, @CFG);
FindSection(szClassName, SECTION_CREATE_ALWAYS, @CFG);
GetWindowRect(ChildWindow, r);
XPos:=r.Left;
YPos:=r.Top;
SetCFGInt(szXPos, XPos, @CFG);
SetCFGInt(szYPos, YPos, @CFG);
CloseCFGw(AData.PluginsCFG, false, @CFG);
end;
{---------------------------------------------------------------------}
function WindowProc(Window: HWnd; Message:UINT; WParam: WParam;
LParam: LParam): Longint; stdcall;
var
DC: hDC;
ps: TPaintStruct;
r, r2:Trect;
uFlags:UINT;
begin
result := 0;
case Message of
WM_PAINT:
begin
DC:=BeginPaint(Window, ps);
GetClientRect(Window, ClientRC);
GetWindowRect(Window, r);
SetRect(r2, 0,0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN));
uFlags:= DPEx_CORRECTBRUSH;
with AData.WallPaperInfo do
begin
if TileWallpaper<>0 then uFlags:= uFlags or DPEx_TILED;
if WallpaperStyle=0 then uFlags:= uFlags or DPEx_CENTERED;
DrawSkin(DC, DC, ClientRC, r, r2, Wallpaper, DesktopBrush, uFlags);
end;
DrawEdge(DC, ClientRC, BDR_SUNKENOUTER, BF_RECT);
InflateRect(ClientRC, -8, -8);
DrawEdge(DC, ClientRC, BDR_RAISEDINNER, BF_RECT);
EndPaint(Window, ps);
exit;
end;
WM_ERASEBKGND:
begin
result:= 1;
exit;
end;
WM_ENTERSIZEMOVE:
begin
SetWindowLong(Window, GWL_EXSTYLE, GetWindowLong(Window, GWL_EXSTYLE) and not WS_EX_TRANSPARENT);
end;
WM_MOVING:
begin
InvalidateRect(Window, nil, false);
end;
WM_EXITSIZEMOVE:
begin
SavePos;
SetWindowLong(Window, GWL_EXSTYLE, GetWindowLong(Window, GWL_EXSTYLE) or WS_EX_TRANSPARENT);
InvalidateRect(Window, nil, false);
end;
WM_NCHITTEST:
begin
DefWindowProc(Window, Message, WParam, LParam);
result:=HTCAPTION;
exit;
end;
end;
result := DefWindowProc(Window, Message, WParam, LParam);
end;
{---------------------------------------------------------------------}
procedure ReadConfig;
var
CFG:TCFG;
begin
OpenCFGr(AData.PluginsCFG, @CFG);
FindSection(szClassName, 0, @CFG);
XPos:=GetCFGInt(szXPos, 0, @CFG);
CheckInt(XPos, 0, GetSystemMetrics(SM_CXSCREEN)-8, 0);
YPos:=GetCFGInt(szYPos, 1, @CFG);
CheckInt(YPos, 0, GetSystemMetrics(SM_CYSCREEN)-8, 0);
CloseCFGr(@CFG);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure InitGlobalModule(const AstonData:PAstonData);stdcall;
var
WindowClass:TWndClass;
begin
RtlMoveMemory(@AData, AstonData, SizeOf(TAstonData));
RtlZeroMemory(@WindowClass, sizeOf(TWndClass));
WindowClass.style:=CS_HREDRAW or CS_VREDRAW;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hInstance := hInstance;
WindowClass.lpfnWndProc:=@WindowProc;
WindowClass.lpszClassName:= szClassName;
if RegisterClass(WindowClass) = 0 then exit;
ReadConfig;
ChildWindow:= CreateWindowEx(WS_EX_TRANSPARENT,
szClassName,
nil,
WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
XPos, YPos,
64, 48,
AData.Desktop,
0,
hInstance,
nil);
AData.Node.Wnd:= ChildWindow;
GetClientRect(ChildWindow, ClientRC);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure DoneModule; stdcall;
begin
if ChildWindow<>0 then
begin
DestroyWindow(ChildWindow);
ChildWindow:=0;
end;
UnregisterClass(szClassName, hInstance);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
exports
InitGlobalModule,
DoneModule;
end.
|
and try to feel a difference. There is only one moment, needs to be explained: call to class function CreateParented with AstonData as parameter. I didn't want to write form-specific functions in DLL, so all functions, which are implementing mentioned above "Aston-specific" behaviour are written directly in the form unit. Since our form have to operate with Aston's data, it was quite logical to pass reference to this data in a moment of form creation. Therefore i write a little bit different version of a class function CreateParented, which receives AstonData as parameter and creates the form as a child of a field Desktop of AstonData structure:
| Code: |
constructor TForm1.CreateParented(AstonData: TAstonData);
begin
ParentWindow := AstonData.Desktop;
Create (nil);
fAstonData := AstonData;
fAstonData.Node.Wnd := Handle;
ReadConfig;
...
end;
|
As you can see, Form1 "remembers" AstonData reference and can operate with it until it lives. Therefore procedures ReadConfig and SavePos, being implemented like methods of a form, have an access to Aston structures and Form is able to read its parameters from ini and to write it back when they're changed.
Her is the listing of the whole form:
| Code: |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AstonSDK, st_api, StdCtrls, ExtCtrls, Registry, Grids;
const
szXPos = 'XPos';
szYPos = 'YPos';
SystemBasicInformation = 0;
SystemPerformanceInformation = 2;
SystemTimeOfDayInformation = 3;
type
SYSTEM_BASIC_INFORMATION = packed record
AlwaysZero : ULONG;
uKeMaximumIncrement : ULONG;
uPageSize : ULONG;
uMmNumberOfPhysicalPages: ULONG;
uMmLowestPhysicalPage : ULONG;
uMmHighestPhysicalPage : ULONG;
uAllocationGranularity : ULONG;
pLowestUserAddress : POINTER;
pMmHighestUserAddress : POINTER;
uKeActiveProcessors : POINTER;
bKeNumberProcessors : BYTE;
Filler : array [0..2] of BYTE;
end;
SYSTEM_PERFORMANCE_INFORMATION = packed record
nIdleTime : INT64;
dwSpare : array [0..75]of DWORD;
end;
SYSTEM_TIME_INFORMATION = packed record
nKeBootTime : INT64;
nKeSystemTime : INT64;
nExpTimeZoneBias : INT64;
uCurrentTimeZoneId : ULONG;
dwReserved : DWORD;
end;
type
TForm1 = class(TForm)
Timer1: TTimer;
sg: TStringGrid;
Label1: TLabel;
Label2: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
private
{ Private declarations }
fAstonData: TAstonData;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMNCHitTest (var Msg: TWMNCHITTEST); message WM_NCHITTEST;
procedure WMExitSizeMove (var Msg: TMessage); message WM_EXITSIZEMOVE;
procedure ReadConfig;
procedure SavePos;
public
{ Public declarations }
constructor CreateParented(AstonData: TAstonData);
end;
function NtQuerySystemInformation(
SystemInformationClass: DWORD; // тип требуемой информации
SystemInformation : Pointer; // указатель на буфер, в который вернется информация
SystemInformationLength : DWORD; // размер буфера в байтах
var ReturnLength: DWORD // сколько байт было возвращено или требуется
): DWORD; stdcall; external 'ntdll.dll';
var
nOldIdleTime : Int64 = 0;
nOldSystemTime : INT64 = 0;
nNewCPUTime : ULONG = 0;
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
end;
constructor TForm1.CreateParented(AstonData: TAstonData);
begin
ParentWindow := AstonData.Desktop;
Create (nil);
fAstonData := AstonData;
fAstonData.Node.Wnd := Handle;
ReadConfig;
sg.ColCount := sg.ClientWidth div 4;
sg.RowCount := sg.ClientHeight div 2;
Timer1.Enabled := true;
end;
procedure TForm1.ReadConfig;
var
lCFG:TCFG;
lClassName: string;
XPos, YPos: integer;
begin
lClassName := ClassName;
OpenCFGr(fAstonData.PluginsCFG, @lCFG);
FindSection(PAnsiChar (lClassName), 0, @lCFG);
XPos:=GetCFGInt(szXPos, 0, @lCFG);
CheckInt(XPos, 0, GetSystemMetrics(SM_CXSCREEN)-8, 0);
YPos:=GetCFGInt(szYPos, 1, @lCFG);
CheckInt(YPos, 0, GetSystemMetrics(SM_CYSCREEN)-8, 0);
CloseCFGr(@lCFG);
Left := XPos;
Top := YPos;
end;
procedure TForm1.SavePos;
var
lCFG:TCFG;
lClassName: string;
begin
lClassName := ClassName;
OpenCFGw(fAstonData.PluginsCFG, @lCFG);
FindSection(PAnsiChar (lClassName), SECTION_CREATE_ALWAYS, @lCFG);
SetCFGInt(szXPos, Left, @lCFG);
SetCFGInt(szYPos, Top, @lCFG);
CloseCFGw(fAstonData.PluginsCFG, false, @lCFG);
end;
procedure TForm1.WMExitSizeMove(var Msg: TMessage);
begin
SavePos;
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHITTEST);
begin
Msg.Result := HTCAPTION;
end;
function GetNewCPUTime: integer;
var
spi : SYSTEM_PERFORMANCE_INFORMATION;
sti : SYSTEM_TIME_INFORMATION;
sbi : SYSTEM_BASIC_INFORMATION;
Dummy: DWORD;
begin
Result := 0;
if NTQuerySystemInformation(SystemBasicInformation, @sbi,
SizeOf(SYSTEM_BASIC_INFORMATION), Dummy) = NO_ERROR then
if NTQuerySystemInformation(SystemTimeOfDayInformation, @sti,
SizeOf(SYSTEM_TIME_INFORMATION), Dummy) = NO_ERROR then
if NTQuerySystemInformation(SystemPerformanceInformation, @spi,
SizeOf(SYSTEM_PERFORMANCE_INFORMATION), Dummy) = NO_ERROR then begin
if (nOldIdleTime <> 0) then begin
Result := Trunc(100 - ((spi.nIdleTime - nOldIdleTime)
/ (sti.nKeSystemTime - nOldSystemTime) * 100)
/ sbi.bKeNumberProcessors + 0.5);
if (Result <> nOldIdleTime) then
end;
nOldIdleTime := spi.nIdleTime;
nOldSystemTime := sti.nKeSystemTime;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
x, y: integer;
cur: integer;
begin
cur := GetNewCPUTime;
with sg do begin
for x := 0 to ColCount - 2 do begin
for y := 0 to RowCount - 1 do begin
Cells [x, y] := Cells [x + 1, y];
end;
end;
for y := 0 to RowCount - 1 do begin
if y < RowCount - cur / (100 / RowCount) then
Cells [ColCount - 1, y] := ''
else
Cells [ColCount - 1, y] := '1';
end;
end;
Label2.Caption := IntToStr (cur) + '%';
end;
procedure TForm1.sgDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with sg.Canvas do begin
if sg.Cells [ACol, ARow] = '' then
Brush.Color := clBlack
else begin
if ARow < sg.RowCount / 4 then
Brush.Color := clRed
else
if ARow < sg.RowCount / 2 then
Brush.Color := clYellow
else
Brush.Color := clLime;
end;
Rect.Right := Rect.Right - 1;
Rect.Bottom := Rect.Bottom - 1;
FillRect (Rect);
end;
end;
end.
|
I won't describe it step-by-step, main part of a code implements an alternative variant for CPU-Meter. But instead of example in SDK, this is a really Delphi form, with a TStringGrid, being painted in it's own event, and 2 TLabels, created by simple "mouse-clicking", not by calling to CreateWindowEx and other stuff Feel free to kill existing controls on the form and add your own buttons, images, or whatever you like. There is still much work to do: there is no configuration window, form does not change itself according to theme changes, but i hope, that main idea is clear such things, lke a WndProc and many others - are already implemented by low-level Delphi components, and there is absolutely no need to cary about such trivial things, like erasing background or invalidating the form after it has been moved.
P.S.
This CPUMeter does not work with PerfomanceStats, but counts a time during which CPU was idle for a period of time mesured, supposing that other time during this period CPU was doing smth:) That is why things it shows can differ from standard Aston's CPU gauge, and that is whay it is called "Lazy" - it is based on a fact that sometimes CPU does nothing.
P.S.S.
I've just reread everything before posting.. and i just want to apologize before gyus who wrote SDK for Delphi/Pascal - it was a great help, actually, and all that i wanted to say - that Delphi provides a way to make things easier 
P.S.S.S.
also sorry for my language - english isn't my native.
|
| Description: |
| *.PLG file and the sources |
|
Download |
| Filename: |
lazycpu.rar |
| Filesize: |
185.53 KB |
| Downloaded: |
964 Time(s) |
|
|
