TChromeTabs 优化改进

已知未解决问题

  • 全屏时当窗体失去焦点,则会显示出未绘制完成的原标题栏(Fixed);
  • 处于非 Areo 效果下时,窗体标题栏需要定制。
  • 新增按钮上的 Hint 提示后再移至其它标签,将无法重新提示。

1、解决全屏时未重新计算 ChromeTabs 占有的客户区问题。

全屏时 TChromeTabsGlassForm 窗体仍然会为 ChromeTabs 保留一个位置,因此,需要修改如下代码(在 ChromeTabsGlassForm.pas):

procedure TChromeTabsGlassForm.AdjustClientRect(var Rect: TRect);
begin
  inherited;

  if ShowTabsInTitleBar then
    Inc(Rect.Top, GlassFrame.Top);
end;

为如下代码

procedure TChromeTabsGlassForm.AdjustClientRect(var Rect: TRect);
begin
  inherited;

  if ShowTabsInTitleBar and ChromeTabs.Visible then
    Inc(Rect.Top, GlassFrame.Top);
end;

解决启动时窗体最大化时,左边有一白色竖线问题(未更新),需要修改 ChromeTabsGlassForm.pas 文件如下代码:

procedure TChromeTabsGlassForm.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  if ShowTabsInTitleBar and ChromeTabs.Visible then
  begin
    if WindowState = wsMaximized then
      Inc(Message.CalcSize_Params.rgrc[0].Left, FWndFrameSize + 1)
    else
      Inc(Message.CalcSize_Params.rgrc[0].Left, FWndFrameSize);

    Dec(Message.CalcSize_Params.rgrc[0].Right, FWndFrameSize);
    Dec(Message.CalcSize_Params.rgrc[0].Bottom, FWndFrameSize);
  end
  else
    inherited;
end;

为如下代码:

procedure TChromeTabsGlassForm.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  if ShowTabsInTitleBar and ChromeTabs.Visible then
  begin
    if WindowState = wsMaximized then
      Inc(Message.CalcSize_Params.rgrc[0].Left, FWndFrameSize)
    else
      Inc(Message.CalcSize_Params.rgrc[0].Left, FWndFrameSize);

    Dec(Message.CalcSize_Params.rgrc[0].Right, FWndFrameSize);
    Dec(Message.CalcSize_Params.rgrc[0].Bottom, FWndFrameSize);
  end
  else
    inherited;
end;

 2、为 TChromeTab 控件增加自定义的图标,而不使用 ImageList。

首先是 ChromeTabsClasses.pas

IChromeTabs 接口定义,增加如下接口方法,用于根据 Tab 的索引取得 TChromeTab 对象。尝试过使用 IChromeTab 对象强制转换为 TChromeTab 然后取 Picture 的值,只能取到空值。

function GetTabByIndex(index: integer): TChromeTab;

IChromeTab 接口的定义,增加如下方法。

function GetPicture: TPicture;

TChromeTab 类中增加如下属性和方法

TChromeTab = class(TCollectionItem, IChromeTab)
private
    FPicture: TPicture; 
    function GetPicture: TPicture; 
    procedure SetPicture(const Value: TPicture); 
public
    constructor Create(Collection: TCollection); override; //要增加内容
    destructor Destroy; override; //要增加内容
published
property Picture: TPicture read FPicture write SetPicture;
end;

增加的相关代码

constructor TChromeTab.Create(Collection: TCollection);
begin
  FCollection := Collection;
  FImageIndex := -1;
  FImageIndexOverlay := -1;
  FVisible := TRUE;
  FPicture := TPicture.Create; //此行新增。

  // Inherited needs to be here so the property values are
  // set before it is called
  inherited;

//  GetChromeTabInterface.TabCreate(Self);
end;

destructor TChromeTab.Destroy;
begin
//  GetChromeTabInterface.TabDestroy(Self);
  FPicture.Free; //此行新增。
  inherited;

  if FTabControl <> nil then
    FTabControl.Free;
end;

procedure TChromeTab.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

function TChromeTab.GetPicture: TPicture;
begin
  Result := FPicture;
end;

ChromeTabs.pas 文件,修改 TCustomChromeTabs 类,增加新方法如下

function TCustomChromeTabs.GetTabByIndex(index: integer): TChromeTab;
begin
  Result := FTabs[index];
end;

ChromeTabsControls.pas 文件,修改 CalculateRects 方法内容如下: 

procedure TChromeTabControl.CalculateRects(var ImageRect, TextRect,
  CloseButtonRect, CloseButtonCrossRect: TRect;
  var NormalImageVisible, OverlayImageVisible, SpinnerVisible, TextVisible: Boolean);
var
  LeftOffset, RightOffset, ImageWidth, ImageHeight: Integer;
  //xiefang Added.
  tab: TChromeTab;
begin
  ...//关键是增加这个条件,以免图标位置计算错误以及不显示图标。
  tab := ChromeTabs.GetTabByIndex(ChromeTab.GetIndex);  //xiefang added.
  NormalImageVisible := Assigned(tab.Picture.Graphic) and (not tab.Picture.Graphic.Empty); //xiefang added.
  if not NormalImageVisible then //xiefang added.
    NormalImageVisible := ImageVisible(ChromeTabs.GetImages, ChromeTab.GetImageIndex);
  OverlayImageVisible := ImageVisible(ChromeTabs.GetImagesOverlay, ChromeTab.GetImageIndexOverlay);
  SpinnerVisible := (ChromeTab.GetSpinnerState <> tssNone) and (not (csDesigning in ChromeTabs.GetComponentState));

 ...

end;

 TChromeTabControl.DrawTo 方法中嵌套方法 DrawImage() 修改如下

procedure DrawImage(Images: TCustomImageList; ImageIndex: Integer; ImageRect: TRect; ChromeTabItemType: TChromeTabItemType);
  var
    ImageBitmap: TGPImage;
    Handled: Boolean;
    tab: TChromeTab;//Xiefang Add. 2016-05-30
  begin
    ChromeTabs.DoOnBeforeDrawItem(TabCanvas, ImageRect, ChromeTabItemType, ChromeTab.GetIndex, Handled);

    if not Handled then
    begin
      tab := ChromeTabs.GetTabByIndex(ChromeTab.GetIndex); //Xiefang Add. 2016-05-30
      if Assigned(tab.Picture.Graphic) and (not tab.Picture.Graphic.Empty) then //Xiefang Add. 2016-05-30
      begin
        //Xiefang Add. 2016-05-30
        ImageBitmap := GraphicToGPBitmap(tab.Picture.Graphic);
      end
      else
      begin
        ImageBitmap := ImageListToTGPImage(Images, ImageIndex);
      end;
      try
        TabCanvas.DrawImage(ImageBitmap, ImageRect.Left, ImageRect.Top);
      finally
        FreeAndNil(ImageBitmap);
      end;
    end;

    ChromeTabs.DoOnAfterDrawItem(TabCanvas, ImageRect, ChromeTabItemType, ChromeTab.GetIndex);
  end;

ChromeTabsUtils.pas 中,增加公共方法如下

function GraphicToGPBitmap(Graphic: TGraphic): TGPBitmap;
var
  MemStream: TMemoryStream;
begin
  MemStream := TMemoryStream.Create;
  try
    Graphic.SaveToStream(MemStream);

    MemStream.Position := 0;
  except
    FreeAndNil(MemStream);

    raise;
  end;

  Result := TGPBitmap.Create(TStreamAdapter.Create(MemStream, soOwned));
end;

大功告成。设置 ChromeTab 中的 Picture 属性为一个图标即可显示。

原文地址:https://www.cnblogs.com/xiefang2008/p/5535516.html