|
![]() |
|
Registriert seit: 24. Dez 2005 Ort: Keine Ergebnisse gefunden 38 Beiträge Delphi 7 Professional |
#1
Hier die Unit...
Delphi-Quellcode:
...und hier die Form, aber die Label werden ja nicht übermalt...
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.
Delphi-Quellcode:
unit Form_BatMon;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, jpeg, ExtCtrls, StdCtrls, ImgList, ComCtrls, XPMan; type TForm1 = class(TForm) Label1: TLabel; Edit1: TEdit; Label2: TLabel; Image1: TImage; procedure FormPaint(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormPaint(Sender: TObject); var ReBar32Wnd: HWND; DC: HDC; begin ReBar32Wnd := FindWindowEx( FindWindow('Shell_TrayWnd', nil ), 0, 'ReBarWindow32', nil ); if (ReBar32Wnd <> 0) then begin DC := GetDC(ReBar32Wnd); StretchBlt(Canvas.Handle, 0, 0, Width, Height, DC, 0, Top, 1, Height, SRCCOPY); ReleaseDC(ReBar32Wnd, DC); end; end; end.
Computer machen keine Fehler
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |