unit Unit_Mon;
interface
uses
Windows, Messages, Classes,
ActiveX, ComServ, ComObj, ShlObj, SHDocVw_TLB,
Graphics, Form_BatMon, ShellAPI, SysUtils;
const
/// <summary>
/// Durch Microsoft definierte GUID zur Registrierung von Desk-Bändern
/// </summary>
REGKEY_DESK_BAND = '
{00021492-0000-0000-C000-000000000046}';
/// <summary>
/// GUID zur Identifizierung unseres Desk-Bandes. Jedes Desk-Band muss(!)
/// seine eigene GUID definieren
/// </summary>
{$MESSAGE 'Ändern Sie diese GUID, damit das Deskband eindeutig bleibt. Drücken Sie hierfür STRG+SHIFT+G in ihrer Delphi IDE.'}
CLSID_MY_DESK_BAND: TGUID = '
{B7638B09-D0C0-4C7F-99BA-410C0E3AEC08}';
/// <summary>
/// Der Titel unseres Desk-Bandes wie dieses im Kontextmenü "Symbolleisten"
/// angezeigt wird
/// </summary>
EXPLORER_MENU_CAPTION = '
&Battery Monitor';
/// <summary>
/// Der Titel des eingeblendeten Desk-Bandes
/// </summary>
BAND_TITLE = '
Monitor';
/// <summary>
/// Der Titel unseres Kontextmenüeintrages
/// </summary>
MENU_TITLE_ABOUT = '
Über Monitor...';
Var
Weite:Word = 115;
type
/// <summary>
/// Klasse zur Registrierung unseres Desk-Bandes im Windows COM-SubSystem
/// </summary>
TDeskBandFactory =
class(TComObjectFactory)
private
protected
public
/// <summary>
/// Registriert bzw. entfernt unser Desk-Band in/aus dem Windows Explorer/
/// Internet Explorer
/// </summary>
procedure UpdateRegistry(
Register: Boolean);
override;
end;
/// <summary>
/// Das COM Objekt unseres Desk-Bandes. Dieses übernimmt alle Interaktionen
/// mit dem Windows/Internet Explorer
/// </summary>
TDeskBand =
class(TComObject, IDeskBand, IPersist, IPersistStream,
IPersistStreamInit, IObjectWithSite, IContextMenu, IInputObject)
private
FHasFocus: Boolean;
FBandID: DWORD;
FParentWnd: HWND;
FSite: IInputObjectSite;
FMenuItemCount: Integer;
FCommandTarget: IOleCommandTarget;
FIE: IWebbrowser2;
FBandForm: TForm1;
FSavedWndProc: TWndMethod;
/// <summary>
/// Blendet das DeskBand aus, sichert jedoch das Form-Objekt
/// </summary>
procedure HideBandForm;
protected
/// <summary>
/// Anzahl der eigenen Menü-Einträge im Kontextmenü des Desk-Bandes
/// </summary>
property MenuItemCount: Integer
read FMenuItemCount;
/// <summary>
/// Ist True, wenn des Desk-Band fokusiert ist, ansonsten False
/// </summary>
property HasFocus: Boolean
read FHasFocus;
/// <summary>
/// Speichert die ID des Bandes innerhalb des Host-Containers
/// </summary>
property BandID: DWORD
read FBandID;
/// <summary>
/// Pointer zur "WndProc" Methode des Delphi-Forms welches im DeskBand
/// dargestellt wird
/// </summary>
property SavedWndProc: TWndMethod
read FSavedWndProc;
/// <summary>
/// Windows-Handle des Host-Containers des Desk-Bandes
/// </summary>
property ParentWnd: HWND
read FParentWnd;
/// <summary>
/// Ermöglicht und des Host-Container zu informieren, wenn sie der Fokus
/// ändert
/// </summary>
property Site: IInputObjectSite
read FSite;
/// <summary>
/// Ermöglicht es dem Desk-Band Anweisungen zu erhalten bzw. zu geben
/// </summary>
property CommandTarget: IOleCommandTarget
read FCommandTarget;
/// <summary>
/// Unser Delphi-Form, welches im Desk-Band dargestellt wird
/// </summary>
property BandForm: TForm1
read FBandForm;
/// <summary>
/// Link zum Internet Explorer, wenn das Desk-Band im Internet Explorer
/// als Toolbar dargestellt wird.
/// </summary>
property IE: IWebbrowser2
read FIE;
protected
/// <summary>
/// Informiert den Host-Container, ob das Desk-Band den Fokus hat
/// </summary>
procedure FocusChange(bHasFocus: Boolean);
/// <summary>
/// Informiert den Host-Container, dass sich die Einstellungen des
/// Desk-Bandes geändert haben und fordert diesen damit auf die Methode
/// GetBandInfo erneut aufzurufen
/// </summary>
procedure UpdateBandInfo;
/// <summary>
/// Leitet Windows-Nachrichten an unser Delphi-Form weiter
/// </summary>
procedure BandWndProc(
var Message: TMessage);
public
/// <summary>
/// Gibt alle Interface-Referenzen und Objekte frei. Intern wird jede
/// Freigabe von externen Interface-Referenzen durch einen seperaten
/// try...except-Block geschützt, da nicht alle Windows-Interfaces
/// Referenzzähler nutzen und diese somit evtl. bereits nicht mehr
/// existieren. Danke Bill :-/
/// </summary>
destructor Destroy;
override;
/// <summary>
/// Hier treffen wir alle Initialisierungen für unser Desk-Band. Benutzen
/// sie niemals den constructor Create in extern erstellten COM-Objekten,
/// da sie nicht garantieren können, welche Variante zur Erstellung
/// genutzt wird
/// </summary>
procedure Initialize;
override;
// IDeskBand methods
/// <summary>
/// Der Host-Container nutzt diese Methode zur Ermittlung der wichtigsten
/// Eigenschaften unseres Desk-Bandes
/// </summary>
function GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
stdcall;
/// <summary>
/// Der Host-Container ruft diese Methode auf, um den Deskband mitzuteilen,
/// ob es sich darstellen/verstecken soll. Soll es sich darstellen, so
/// holen wir uns ganz frech auch gleich mal den Fokus ;-)
/// </summary>
function ShowDW(fShow: BOOL): HResult;
stdcall;
/// <summary>
/// Der Host-Container ruft diese Methode auf, um uns mitzuteilen, dass
/// das Desk-Band geschlossen wird. Da Windows die COM-DLL nicht freigibt
/// bis der Explorer beendet wird (Abmeldung vom System), behalten wir
/// das Form auch im Speicher und setzen Visible lediglich auf False
/// </summary>
function CloseDW(dwReserved: DWORD): HResult;
stdcall;
/// <summary>
/// Wir ignorieren diese Anforderung einfach
/// </summary>
function ResizeBorderDW(
var prcBorder: TRect; punkToolbarSite: IUnknown; fReserved: BOOL): HResult;
stdcall;
/// <summary>
/// Der Explorer möchte das Handle des darzustellenden Fensters haben.
/// </summary>
function GetWindow(
out wnd: HWnd): HResult;
stdcall;
/// <summary>
/// Wir ignorieren auch diese Anforderung
/// </summary>
function ContextSensitiveHelp(fEnterMode: BOOL): HResult;
stdcall;
// IPersistStream methods
/// <summary>
/// Liefert die eineindeutige GUID unseres Desk-Bandes zurück.
/// </summary>
function GetClassID(
out classID: TCLSID): HResult;
stdcall;
/// <summary>
/// Na klar sind wir schmutzig ;-) IsDirty wird aufgerufen, um
/// herauszufinden, ob es seit der letzten Speicherung Änderungen am
/// Objekt gab. Auch wenn wir keine Informationen speichern wollen, so
/// ist die Rückgabe von S_OK Voraussetzung dafür, dass der Explorer die
/// Nutzereinstellungen (Position, Größe, etc.) des Desk-Bandes speichert.
/// Manchmal sind die Microsofties schon komisch, oder ;-)
/// </summary>
function IsDirty: HResult;
stdcall;
/// <summary>
/// Ermöglicht es uns Daten aus dem Desk-Band Stream zu laden
/// </summary>
function Load(
const stm: IStream): HResult;
stdcall;
/// <summary>
/// Ermöglicht es uns Daten in den Desk-Band Stream zu sichern
/// </summary>
function Save(
const stm: IStream; fClearDirty: BOOL): HResult;
stdcall;
/// <summary>
/// Liefert die maximale Anzahl an Bytes zurück, welche unser Desk-Band
/// benötigt, um seine Informationen zu sichern
/// </summary>
function GetSizeMax(
out cbSize: Largeint): HResult;
stdcall;
// IPersistStreamInit methods
/// <summary>
/// Wird aufgerufen, um das Desk-Band aufzufordern alle
/// Standardeinstellungen zu laden
/// </summary>
function InitNew: HResult;
stdcall;
// IObjectWithSite methods
/// <summary>
/// Gibt uns eine Referenz auf den Host-Container
/// </summary>
function SetSite(
const pUnkSite: IUnknown): HResult;
stdcall;
/// <summary>
/// Liefert die Referenz auf den uns letzten bekannten Host-Container
/// zurück
/// </summary>
function GetSite(
const riid: TIID;
out site: IUnknown): HResult;
stdcall;
// IContextMenu methods
/// <summary>
/// Wir werden gebeten dem Host mitzuteilen welche Menüpunkte benötigt
/// sind
/// </summary>
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
stdcall;
/// <summary>
/// Der Benutzer hat einen UNSERER Menüpunkte angeklickt. Wir werden jetzt
/// informiert was der Benutzer sehen will
/// </summary>
function InvokeCommand(
var lpici: TCMInvokeCommandInfo): HResult;
stdcall;
/// <summary>
/// Liefert weitergehende Informationen (z.B. Hint) zu unseren Menüpunkten
/// zurück. Okay tut es nicht, aber nur weil ich es ignoriere ;-)
/// </summary>
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
stdcall;
// IInputObject methods
/// <summary>
/// Aktiviert/Deaktiviert das User Interface - also unser Delphi-Form
/// </summary>
function UIActivateIO(fActivate: BOOL;
var lpMsg: TMsg): HResult;
stdcall;
/// <summary>
/// Gibt zurück ob wir glauben derzeit den Fokus zu haben
/// </summary>
function HasFocusIO: HResult;
stdcall;
/// <summary>
/// Übersetzt Kommando-Shortcuts für unser Desk-Band
/// </summary>
function TranslateAcceleratorIO(
var lpMsg: TMsg): HResult;
stdcall;
end;
implementation
uses
Registry;
{ TDeskBandFactory }
procedure TDeskBandFactory.UpdateRegistry(
Register: Boolean);
var
GUID:
string;
begin
inherited UpdateRegistry(
Register);
GUID := GUIDToString(CLSID_MY_DESK_BAND);
with TRegistry.Create
do
try
if Register then
begin
// das Desk-Band wird installiert
// Registrierung der COM Komponente
RootKey := HKEY_CLASSES_ROOT;
if OpenKey('
CLSID\' +
GUID, True)
then
try
WriteString('
', EXPLORER_MENU_CAPTION);
finally
CloseKey;
end;
if OpenKey('
CLSID\' +
GUID + '
\InProcServer32', True)
then
try
WriteString('
ThreadingModel', '
Apartment');
finally
CloseKey;
end;
if OpenKey('
CLSID\' +
GUID + '
\Implemented Categories\' + REGKEY_DESK_BAND, True)
then
CloseKey;
// Registrierung der COM Komponente im Internet Explorer
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('
SOFTWARE\Microsoft\Internet Explorer\Toolbar', True)
then
try
WriteString(
GUID, '
');
finally
CloseKey;
end;
end
else
begin
// das Desk-Band wird deinstalliert
RootKey := HKEY_CLASSES_ROOT;
DeleteKey('
Component Categories\' + REGKEY_DESK_BAND + '
\Enum');
DeleteKey('
CLSID\' +
GUID + '
\Implemented Categories\' + REGKEY_DESK_BAND);
DeleteKey('
CLSID\' +
GUID + '
\InProcServer32');
DeleteKey('
CLSID\' +
GUID);
CloseKey;
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('
Software\Microsoft\Internet Explorer\Toolbar', False)
then
try
DeleteValue(
GUID);
finally
CloseKey;
end;
end;
finally
Free;
end;
end;
{ TDeskBand }
procedure TDeskBand.BandWndProc(
var Message: TMessage);
begin
if (
Message.Msg = WM_PARENTNOTIFY)
then
begin
FHasFocus := True;
FocusChange(HasFocus);
end;
SavedWndProc(
Message);
end;
function TDeskBand.CloseDW(dwReserved: DWORD): HResult;
begin
HideBandForm;
Result := S_OK;
end;
function TDeskBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
destructor TDeskBand.Destroy;
begin
try
FIE :=
nil;
except
end;
if BandForm <>
nil then
try
FBandForm.Free;
FBandForm :=
nil;
except
end;
try
FSite :=
nil;
except
end;
try
FCommandTarget :=
nil;
except
end;
inherited Destroy;
end;
procedure TDeskBand.FocusChange(bHasFocus: Boolean);
begin
if Site <>
nil then
Site.OnFocusChangeIS(Self, bHasFocus);
end;
procedure TDeskBand.HideBandForm;
begin
BandForm.Hide;
end;
function TDeskBand.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
function ReadStringFromRegAPI(Alle:Boolean;
const p_sSubKey :
string;
const p_sValueName :
string;
var p_sResult :
string) : integer;
var
hResult : HKEY;
dwMaxValueLen : DWORD;
szResult : PChar;
begin
if Alle=False
then begin
Result := RegOpenKeyEx(HKEY_CURRENT_USER,PChar(p_sSubKey),0,KEY_ALL_ACCESS,hResult);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
try
Result := RegQueryInfoKey(hResult,
nil,
nil,
nil,
nil,
nil,
nil,
nil,
nil,@dwMaxValueLen,
nil,
nil);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
inc(dwMaxValueLen);
szResult := StrAlloc(dwMaxValueLen);
try
Result := RegQueryValueEx(hResult,PChar(p_sValueName),
nil,
nil,PByte(szResult),@dwMaxValueLen);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
p_sResult := trim(szResult);
finally
StrDispose(szResult);
end;
finally
RegCloseKey(hResult);
end;
end else begin
Result := RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar(p_sSubKey),0,KEY_ALL_ACCESS,hResult);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
try
Result := RegQueryInfoKey(hResult,
nil,
nil,
nil,
nil,
nil,
nil,
nil,
nil,@dwMaxValueLen,
nil,
nil);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
inc(dwMaxValueLen);
szResult := StrAlloc(dwMaxValueLen);
try
Result := RegQueryValueEx(hResult,PChar(p_sValueName),
nil,
nil,PByte(szResult),@dwMaxValueLen);
if Result <> ERROR_SUCCESS
then
begin
exit;
end;
p_sResult := trim(szResult);
finally
StrDispose(szResult);
end;
finally
RegCloseKey(hResult);
end;
end;
end;
var
iResult : integer;
sResult :
string;
begin
iResult := ReadStringFromRegAPI(True,'
Software\Mon','
Size',sResult);
if iResult = ERROR_SUCCESS
then Weite:=StrToInt(sResult);
FBandId := dwBandID;
if pdbi.dwMask
or DBIM_MINSIZE <> 0
then
begin
pdbi.ptMinSize.x := Weite;
pdbi.ptMinSize.y := 22;
end;
if pdbi.dwMask
or DBIM_MAXSIZE <> 0
then
begin
pdbi.ptMaxSize.x := Weite;
pdbi.ptMaxSize.y := 22;
end;
if pdbi.dwMask
or DBIM_INTEGRAL <> 0
then
begin
pdbi.ptIntegral.x := Weite;
pdbi.ptIntegral.y := -1;
//change here from 22
end;
if pdbi.dwMask
or DBIM_ACTUAL <> 0
then
begin
pdbi.ptActual.x := Weite;
pdbi.ptActual.y := 22;
end;
if pdbi.dwMask
or DBIM_MODEFLAGS <> 0
then
begin
pdbi.dwModeFlags := DBIMF_NORMAL
or DBIMF_VARIABLEHEIGHT;
//pdbi.dwModeFlags := DBIMF_NORMAL or DBIMF_VARIABLEHEIGHT or DBIMF_BKCOLOR;
end;
if pdbi.dwMask
or DBIM_BKCOLOR <> 0
then
begin
pdbi.dwMask := DBIM_BKCOLOR;
end;
if Pdbi.dwMask
and DBIM_TITLE <> 0
then
begin
FillChar(pdbi.wszTitle, Length(pdbi.wszTitle) * SizeOf(pdbi.wszTitle[0]), #0);
FillChar(pdbi.wszTitle, SizeOf(BAND_TITLE) + 1, '
');
StringToWideChar(BAND_TITLE, @pdbi.wszTitle, Length(BAND_TITLE) + 1);
end;
Result := NOERROR;
end;
function TDeskBand.GetClassID(
out classID: TCLSID): HResult;
begin
classID := CLSID_EG_DESK_BAND;
Result := S_OK;
end;
function TDeskBand.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
Result := NOERROR;
end;
function TDeskBand.GetSite(
const riid: TIID;
out site: IInterface): HResult;
begin
if Site <>
nil then
Result := Site.QueryInterface(riid, site)
else
Result := E_FAIL;
end;
function TDeskBand.GetSizeMax(
out cbSize: Largeint): HResult;
begin
cbSize := 256;
Result := S_OK;
end;
function TDeskBand.GetWindow(
out wnd: HWnd): HResult;
begin
if BandForm =
nil then
begin
FBandForm := TForm1.CreateParented(ParentWnd);
//FBandForm.IE := IE;
end;
Wnd := BandForm.Handle;
FSavedWndProc := BandForm.WindowProc;
BandForm.WindowProc := BandWndProc;
Result := S_OK;
end;
function TDeskBand.HasFocusIO: HResult;
begin
Result := Integer(
not HasFocus);
end;
procedure TDeskBand.Initialize;
begin
inherited Initialize;
end;
function TDeskBand.InitNew: HResult;
begin
Result := S_OK;
end;
function TDeskBand.InvokeCommand(
var lpici: TCMInvokeCommandInfo): HResult;
begin
if (HiWord(Integer(lpici.lpVerb)) <> 0)
or (LoWord(lpici.lpVerb) > Pred(MenuItemCount))
then
begin
Result := E_FAIL;
Exit;
end;
case LoWord(lpici.lpVerb)
of
0: MessageBox(ParentWnd, '
Monitor', '
Über', 0);
//1: Form2.Show;
end;
Result := NO_ERROR;
end;
function TDeskBand.IsDirty: HResult;
begin
Result := S_OK;
end;
function TDeskBand.Load(
const stm: IStream): HResult;
begin
Result := S_OK;
end;
function TDeskBand.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
begin
FMenuItemCount := 2;
AppendMenu(Menu, MF_STRING, idCmdFirst + 0, PChar(MENU_TITLE_ABOUT));
AppendMenu(Menu, MF_STRING, idCmdFirst + 1, PChar('
Battery Monitor Optionen'));
Result := MenuItemCount;
end;
function TDeskBand.ResizeBorderDW(
var prcBorder: TRect; punkToolbarSite: IInterface; fReserved: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
function TDeskBand.Save(
const stm: IStream; fClearDirty: BOOL): HResult;
begin
Result := S_OK;
end;
function TDeskBand.SetSite(
const pUnkSite: IInterface): HResult;
begin
if pUnkSite <>
nil then
begin
FSite := pUnkSite
as IInputObjectSite;
(pUnkSite
as IOleWindow).GetWindow(FParentWnd);
FCommandTarget := pUnkSite
as IOleCommandTarget;
(CommandTarget
as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, FIE);
end;
Result := S_OK;
end;
function TDeskBand.ShowDW(fShow: BOOL): HResult;
begin
FHasFocus := fShow;
FocusChange(HasFocus);
Result := S_OK;
end;
function TDeskBand.TranslateAcceleratorIO(
var lpMsg: TMsg): HResult;
begin
if lpMsg.WParam <> VK_TAB
then
begin
TranslateMessage(lpMSg);
DispatchMessage(lpMsg);
Result := S_OK;
end
else
begin
Result := S_FALSE;
end;
end;
function TDeskBand.UIActivateIO(fActivate: BOOL;
var lpMsg: TMsg): HResult;
begin
FHasFocus := fActivate;
FocusChange(HasFocus);
if HasFocus
then
if BandForm <>
nil then
BandForm.SetFocus;
Result := S_OK;
end;
procedure TDeskBand.UpdateBandInfo;
var
vain, vaOut: OleVariant;
PtrGuid: PGUID;
begin
vaIn := Variant(BandID);
New(PtrGUID);
PtrGUID^ := IDESKBAND;
CommandTarget.Exec(PtrGUID, DBID_BANDINFOCHANGED, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
Dispose(PtrGUID);
end;
initialization
TDeskBandFactory.Create(ComServer, TDeskBand, CLSID_MY_DESK_BAND, '
', BAND_TITLE, ciMultiInstance);
end.
Programmierung allgemein
Offene Frage von "bobo220673"
Antwort
24. Jun 2006, 12:00
Tutorial erstellt, welche ich in der Taskleiste verwenden möchte.
Zitat
) ein kleiner Fehler. Deswegen im Anhang noch einmal der korig. Sourcecode.
Linear-Darstellung
