jvbandobject.pas

East make Tray Icon in delphi

//=== { TzCommBandObjectFactory } ============================================

function TzCommBandObjectFactory.GetImplCatID: TGUID;
begin
  Result := StringToGUID(CATID_COMMBAND);
end;

//=== { TzCustomBandObject } =================================================

procedure TzCustomBandObject.AfterConstruction;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.AfterConstruction()');
  {$ENDIF DEBUGINFO_ON}
  inherited AfterConstruction;
  FBandForm := nil;
  FSite := nil;
  FOleCommandTarget := nil;
end;

procedure TzCustomBandObject.BeforeDestruction;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.BeforeDestruction()');
  {$ENDIF DEBUGINFO_ON}
  if Assigned(FSite) then
    FSite := nil; // implicit Release
  if Assigned(FOleCommandTarget) then
    FOleCommandTarget := nil; // implicit Release
  if Assigned(FBandForm) then
    FreeAndNil(FBandForm);
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.BeforeDestruction End()');
  {$ENDIF DEBUGINFO_ON}
  inherited BeforeDestruction;
end;

function TzCustomBandObject.BandInfoChanged: HRESULT;
var
  CGID_DeskBand: TGUID;
  vaIn, vaOut: OleVariant;
begin
  if not Assigned(OleCommandTarget) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  CGID_DeskBand := IDeskBand;
  vaIn := OleVariant(BandID);
  Result := OleCommandTarget.Exec(@CGID_DeskBand, DBID_BANDINFOCHANGED,
    OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

function TzCustomBandObject.Maximize: HRESULT;
var
  CGID_DeskBand: TGUID;
  vaIn, vaOut: OleVariant;
begin
  if not Assigned(OleCommandTarget) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  CGID_DeskBand := IDeskBand;
  vaIn := OleVariant(BandID);
  Result := OleCommandTarget.Exec(@CGID_DeskBand, DBID_MAXIMIZEBAND,
    OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

function TzCustomBandObject.HideAllBands: HRESULT;
var
  CGID_DeskBand: TGUID;
  vaIn, vaOut: OleVariant;
begin
  if not Assigned(OleCommandTarget) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  CGID_DeskBand := IDeskBand;
  vaIn := 0;
  Result := OleCommandTarget.Exec(@CGID_DeskBand, DBID_SHOWONLY,
    OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

function TzCustomBandObject.ShowAllBands: HRESULT;
var
  CGID_DeskBand: TGUID;
  vaIn, vaOut: OleVariant;
begin
  if not Assigned(OleCommandTarget) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  CGID_DeskBand := IDeskBand;
  vaIn := 1;
  Result := OleCommandTarget.Exec(@CGID_DeskBand, DBID_SHOWONLY,
    OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

function TzCustomBandObject.ShowMeOnly: HRESULT;
var
  CGID_DeskBand: TGUID;
  Unknown: IUnknown;
  vaIn, vaOut: OleVariant;
begin
  if not Assigned(OleCommandTarget) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  CGID_DeskBand := IDeskBand;
  if Self.QueryInterface(IUnknown, Unknown) <> S_OK then
  begin
    Result := E_FAIL;
    Exit;
  end;
  try
    vaIn := Unknown;
    Result := OleCommandTarget.Exec(@CGID_DeskBand, DBID_SHOWONLY,
      OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  finally
    Unknown := nil;
  end;
end;

// IDeskBand

function TzCustomBandObject.GetBandInfo(BandID, ViewMode: DWORD;
  var Dbi: TDeskBandInfo): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetBandInfo()');
  zTraceLog('  BandID=' + Format('0x%x', [BandID]));
  zTraceLog('  ViewMode=' + Format('0x%x', [ViewMode]));
  zTraceLog('  Dbi=' + Format('0x%p', [@Dbi]));
  zTraceLog('    dwMask=' + Format('0x%x', [Dbi.dwMask]));
  {$ENDIF DEBUGINFO_ON}
  FBandID := BandID;
  FViewMode := ViewMode;
  if not Assigned(FBandForm) then
  begin
    Result := E_UNEXPECTED;
    Exit;
  end;
  with Dbi, FBandForm do
  begin
    if (dwMask and DBIM_MINSIZE) <> 0 then
    begin
      ptMinSize := BandMinSize;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.ptMinSize=' + Format('(%d,%d)', [ptMinSize.x, ptMinSize.y]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_MAXSIZE) <> 0 then
    begin
      ptMaxSize := BandMaxSize;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.ptMaxSize=' + Format('(%d,%d)', [ptMaxSize.x, ptMaxSize.y]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_INTEGRAL) <> 0 then
    begin
      ptIntegral := BandIntegral;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.ptIntegral=' + Format('(%d,%d)', [ptIntegral.x, ptIntegral.y]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_ACTUAL) <> 0 then
    begin
      ptActual := BandActualSize;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.ptActual=' + Format('(%d,%d)', [ptActual.x, ptActual.y]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_TITLE) <> 0 then
    begin
      StringToWideChar(Caption, @wszTitle[0], Length(wszTitle));
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.wszTitle=' + Format('%s', [Caption]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_MODEFLAGS) <> 0 then
    begin
      dwModeFlags := DBIMF_NORMAL;
      if bmfVariableHeight in BandModeFlags then
        dwModeFlags := dwModeFlags or DBIMF_VARIABLEHEIGHT;
      if bmfDebossed in BandModeFlags then
        dwModeFlags := dwModeFlags or DBIMF_DEBOSSED;
      if bmfBkColor in BandModeFlags then
        dwModeFlags := dwModeFlags or DBIMF_BKCOLOR;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.dwModeFlags=' + Format('0x%x', [dwModeFlags]));
      {$ENDIF DEBUGINFO_ON}
    end;
    if (dwMask and DBIM_BKCOLOR) <> 0 then
    begin
      crBkgnd := Color;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  Dbi.crBkgnd=' + Format('0x%x', [crBkgnd]));
      {$ENDIF DEBUGINFO_ON}
    end;
  end;
  Result := NOERROR;
end;

// IDockingWindow

function TzCustomBandObject.ShowDW(AShow: BOOL): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.ShowDW()');
  if AShow then
    zTraceLog('  Show=True')
  else
    zTraceLog('  Show=False');
  {$ENDIF DEBUGINFO_ON}
  Result := NOERROR;
  if not Assigned(FBandForm) then
    Exit;
  FHasFocus := AShow;
  with FBandForm do
    if AShow then
    begin
      Show;
      FocusChange(AShow);
    end
    else
      Hide;
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.ShowDW() End');
  {$ENDIF DEBUGINFO_ON}
end;

function TzCustomBandObject.CloseDW(dwReserved: DWORD): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.CloseDW()');
  {$ENDIF DEBUGINFO_ON}
  Result := NOERROR;
  try
    try
      if not Assigned(FBandForm) then
        Exit;
      ShowDW(False);
      FBandForm.Free;
      if FHook <> 0 then
      begin
        UnhookWindowsHookEx(FHook);
        FHook := 0;
      end;
    finally
      FBandForm := nil;
    end;
  except
  end;
end;

function TzCustomBandObject.ResizeBorderDW(var Border: TRect;
  ToolbarSite: IUnknown; Reserved: BOOL): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.ResizeBorderDW()');
  {$ENDIF DEBUGINFO_ON}
  // Never called for band objects.
  Result := E_NOTIMPL;
end;

// IOleWindow

function TzCustomBandObject.GetWindow(out Wnd: HWND): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetWindow()');
  {$ENDIF DEBUGINFO_ON}
  if Assigned(FBandForm) then
    Wnd := FBandForm.Handle
  else
    Wnd := 0;
  {$IFDEF DEBUGINFO_ON}
  zTraceLog('  Wnd=' + Format('0x%x', [Wnd]));
  {$ENDIF DEBUGINFO_ON}
  Result := S_OK;
end;

function TzCustomBandObject.ContextSensitiveHelp(EnterMode: BOOL): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.ContextSensitiveHelp()');
  {$ENDIF DEBUGINFO_ON}
  Result := E_NOTIMPL;
end;

// IObjectWithSite

function TzCustomBandObject.SetSite(const Site: IUnknown): HRESULT;
var
  OleWindow: IOleWindow;
  ParentWnd: HWND;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.SetSite()');
  if Assigned(Site) then
    zTraceLog('  Site=not nil')
  else
    zTraceLog('  Site=nil');
  {$ENDIF DEBUGINFO_ON}
  if Assigned(FSite) then
    FSite := nil; // implicit Release
  if Assigned(FOleCommandTarget) then
    FOleCommandTarget := nil; // implicit Release
  if Assigned(Site) then
  begin
    if not Assigned(FBandForm) then
    begin
      if Site.QueryInterface(IOleWindow, OleWindow) <> S_OK then
      begin
        Result := E_FAIL;
        Exit;
      end;
      try
        OleWindow.GetWindow(ParentWnd);
      finally
        OleWindow := nil;
      end;
      {$IFDEF DEBUGINFO_ON}
      zTraceLog('  ParentWnd=' + Format('0x%x', [ParentWnd]));
      {$ENDIF DEBUGINFO_ON}
      if ParentWnd = 0 then
      begin
        Result := E_FAIL;
        Exit;
      end;
      FBandForm := CreateBandForm(ParentWnd);

      FSavedWndProc := FBandForm.WindowProc;
      FBandForm.WindowProc := BandWndProc;

      FHook := SetWindowsHookEx(WH_GETMESSAGE,
        MethodToProcedure(Self, Self.MethodAddress('MsgHookProc')), HInstance, GetCurrentThreadID);
    end;
    if Site.QueryInterface(IInputObjectSite, FSite) <> S_OK then // implicit FSite.AddRef;
    begin
      Result := E_FAIL;
      Exit;
    end;
    {$IFDEF DEBUGINFO_ON}
    zTraceLog('  FSite assigned.');
    {$ENDIF DEBUGINFO_ON}
    if FSite.QueryInterface(IOleCommandTarget, FOleCommandTarget) <> S_OK then
      FOleCommandTarget := nil;
  end;
  Result := S_OK;
end;

function TzCustomBandObject.GetSite(const Riid: TIID;
  out Site: IUnknown): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetSite()');
  zTraceLog('  Riid=' + GUIDToString(Riid));
  {$ENDIF DEBUGINFO_ON}
  if not Assigned(FSite) then
  begin
    Site := nil;
    Result := E_FAIL;
    Exit;
  end;
  Result := FSite.QueryInterface(Riid, Site);
  {$IFDEF DEBUGINFO_ON}
  zTraceLog('  Result=' + IntToStr(Result));
  {$ENDIF DEBUGINFO_ON}
end;

// IPersistStream

function TzCustomBandObject.IsDirty: HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.IsDirty()');
  {$ENDIF DEBUGINFO_ON}
  Result := S_FALSE;
end;

function TzCustomBandObject.Load(const Strm: IStream): HRESULT;