Question

On Windows default appearance the tabsheet caption are showed in horizontal (left to right 1) and with the VCL styles enabled they are displayed in vertical (down to top[2]). How I can fix this on Delphi XE5? Detail: I'm using the JvgPageControl component, from JEDI-VCL 3.58.

I want to create an similar interface of DisplayFusion welcome screen [3]. Suggestions are welcome!

Images:

enter image description here

Thanks in advance!

Was it helpful?

Solution

The TJvgPageControl uses the same vcl style hook (TTabControlStyleHook) of the TPageControl control, so you must create a new style hook inherited from the TTabControlStyleHook and override the DrawTab method.

Check this basic implementation for the new style hook

type
   TTabControlStyleHookExt = class(TTabControlStyleHook)
   protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
   end;

   TCustomTabControlClass = class(TCustomTabControl);

{ TTabControlStyleHookExt }

procedure TTabControlStyleHookExt.DrawTab(Canvas: TCanvas; Index: Integer);
var
  R, LayoutR, GlyphR: TRect;
  ImageWidth, ImageHeight, ImageStep : Integer;
  LDrawState: TThemedTab;
  LDetails: TThemedElementDetails;
  ThemeTextColor: TColor;
  FImageIndex: Integer;
begin
  if TabPosition <> tpLeft then
  begin
    inherited ;
    exit;
  end;

  if (Images <> nil) and (Index < Images.Count) then
  begin
    ImageWidth := Images.Width;
    ImageHeight := Images.Height;
    ImageStep := 3;
  end
  else
  begin
    ImageWidth := 0;
    ImageHeight := 0;
    ImageStep := 0;
  end;

  R := TabRect[Index];
  if R.Left < 0 then Exit;

  if Index = TabIndex then
    Dec(R.Left, 2)
  else
    Dec(R.Right, 2);

  Canvas.Font.Assign(TCustomTabControlClass(Control).Font);
  LayoutR := R;

  if Index = TabIndex then
    LDrawState := ttTabItemLeftEdgeSelected
  else if (Index = HotTabIndex) and MouseInControl then
    LDrawState := ttTabItemLeftEdgeHot
  else
    LDrawState := ttTabItemLeftEdgeNormal;

  LDetails := StyleServices.GetElementDetails(LDrawState);
  StyleServices.DrawElement(Canvas.Handle, LDetails, R);

  { Image }
  if Control is TCustomTabControl then
    FImageIndex := TCustomTabControlClass(Control).GetImageIndex(Index)
  else
    FImageIndex := Index;

  if (Images <> nil) and (FImageIndex >= 0) and (FImageIndex < Images.Count) then
  begin
    GlyphR := LayoutR;

    GlyphR.Bottom := GlyphR.Bottom - ImageStep;
    GlyphR.Top := GlyphR.Bottom - ImageHeight;
    LayoutR.Bottom := GlyphR.Top;
    GlyphR.Left := GlyphR.Left + (GlyphR.Right - GlyphR.Left) div 2 - ImageWidth div 2;

    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, LDetails, GlyphR, Images.Handle, FImageIndex);
  end;

  { Text }

   if StyleServices.GetElementColor(LDetails, ecTextColor, ThemeTextColor) then
     Canvas.Font.Color := ThemeTextColor;

    //use the top tab style to draw the text
    if Index = TabIndex then
      LDetails := StyleServices.GetElementDetails(ttTabItemSelected)
    else
    if (Index = HotTabIndex) and MouseInControl then
      LDetails := StyleServices.GetElementDetails(ttTabItemHot)
    else
      LDetails := StyleServices.GetElementDetails(ttTabItemNormal);

     DrawControlText(Canvas, LDetails, Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE  or DT_NOCLIP);
end;

Then register the new style hook like this

initialization
  TStyleEngine.RegisterStyleHook(TJvgPageControl, TTabControlStyleHookExt);

enter image description here

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top