Transparenz bei DeskBars

[meg91]

Hallo
hab mal wieder ein Problem und zwar:
ich habe eine Deskbar laut sakura's Tutorial erstellt, welche ich in der Taskleiste verwenden möchte.
Im Moment habe ich das MediaCenter Theme bei WinXP eingestellt
Nur sieht es im Moment ziemlich doof aus, weil ich da immer die Farbe der Form als Hintergrund habe
lieber wäre mir es, wenn der ganze Hintergrund transparent wäre, sprich man die Taskleiste sieht
ich hab auch schon Transparenz und alles eingestellt da ändert sich aber nix

weis da jemand weiter

Gruß
meg

[turboPASCAL]

Das klappt schon, halt mit Tricks.

Einfach ein Stück der Taskbar in ein Bitmap kopieren und als Hintergrund verwenden.

zB. schaut das dann so aus:

Delphi-Quellcode:

procedure TfrmDeskBand.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;

Ein Beispiel ? Siehe Anhang.

[meg91]

super DNAKE :cheers:

[sailxia]

a little Bug...

in unit unitDemoDeskBand.pas,

Delphi-Quellcode:

  
if pdbi.dwMask or DBIM_INTEGRAL <> 0 then //Line 393
  begin
    pdbi.ptIntegral.x := 25;
    pdbi.ptIntegral.y := 22; //this size
  end;

Modified to:

Delphi-Quellcode:

  if pdbi.dwMask or DBIM_INTEGRAL <> 0 then
  begin
    pdbi.ptIntegral.x := 25;
    pdbi.ptIntegral.y := -1; //to this size
  end;

then, if the form been a float-form, the form will be a normal and can be a size form.

[turboPASCAL]

Hm, stimmt. Das ist (war ;) ) ein kleiner Fehler. Deswegen im Anhang noch einmal der korig. Sourcecode.

Was ich nun noch gern wissen möchte ist wie man feststellen kann ob sich das Fenster in der Taskbar oder auf dem Desktop befindet.

PS.:
Um die DemoDeskBar zu instalieren / deinstalieren einfach _install.bat bzw. _uninstall.bat aufrufen.

[enricoffo]

Also,

das mit dem Hintergrund kopieren ist sahr schlau gelöst. Leider ist danach mein Edit-Feld unsichtbar. Oder bin ich zu blöde?

[turboPASCAL]

Hm, da ich deinen Code ned kenn, kann ich auch nix dazu sagen. ;)

[enricoffo]

Kann Ihn gerne posten, aber das ist nur die Deskband wie aus der Demo mitm Label und einem Editfeld drauf.
Das Label sieht man und das Edit-Feld ist weg...

[turboPASCAL]

Hm, dürfte eigentlich nicht vorkommen. Es sei denn du malst mit irgrnd etwas darüber.

Zeig mal den Code, sonst kann man nur raten.

[enricoffo]

Hier die Unit...

Delphi-Quellcode:

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.

...und hier die Form, aber die Label werden ja nicht übermalt...

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.