Delphi – How to change the orientation of the label on a TPageControl

delphidelphi-2009orientationtabcontroltpagecontrol

I'm new to Delphi (again – I used Delphi back in 1994). I now have Delphi 2009 Pro.

Coming from Java, I find the object inheritance very obscure.

My users want tabbed pages with the tabs on the left. But, the TPageControl doesn't allow the tab label direction or orientation to be changed. They want the words on the tabs to read top to bottom with the letters rotated so they are in a "normal" orientation. With the tabs on the left the labels read from the bottom up with the letters rotated 90 deg. to the left and there is a tendency to tilt your head to the left to read the tabs. I found several enhancements to the standard TPageControl VCL that add images, text and color changes for hover and active, but nothing that allows the manipulation of font direction or orientation on the tabs.

Page Control Tabls should look something like:

P
a
g
e
1

P
a
g
e
2

P
a
g
e
3

And so on…

Best Answer

1.) set the TPageControl properties:

TabPosition := tpLeft;
OwnerDraw := True;
TabWidth := 180;    //set to any adequate value because
                    // TPageControl doesn't have a measure event handler

2.) use the following OnDrawTab code:

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  I: Integer;
  PageControl: TPageControl;
  TextFormat: TTextFormat;
  Text: string;
  TextRect: TRect;
begin
  PageControl := Control as TPageControl;

  Text := PageControl.Pages[TabIndex].Caption;

  for I := Length(Text) - 1 downto 1 do
  begin
    Text := Copy(Text, 1, I) + sLineBreak + Copy(Text, I+1, MaxInt);
  end;

  TextRect := Rect;
  TextRect.Left := TextRect.Left + 5;
  TextRect.Top := TextRect.Top + 3;

  TextFormat := [tfCenter];

  PageControl.Canvas.TextRect(
    TextRect,
    Text,
    TextFormat
    );
end;

3.) compile, start and enjoy !

Related Solutions

R – How to convert Delphi TPageControl “tab index” to “page index”

I you look in the source for TPageControl (ComCtrls.pas), there is a private method:

function TPageControl.PageIndexFromTabIndex(TabIndex: Integer): Integer;

that does what you want. But you can't call it (D2007), so (unfortunately) you have to copy the code.

Delphi – How to implement a close button for a TTabsheet of a TPageControl

Now with Theme support (include Windows, UxTheme, Themes units)!

type
  TFormMain = class(TForm)
    {...}
  private
    FCloseButtonsRect: array of TRect;
    FCloseButtonMouseDownIndex: Integer;
    FCloseButtonShowPushed: Boolean;
    {...}
  end;

{...}

procedure TFormMain.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  PageControlCloseButton.TabWidth := 150;
  PageControlCloseButton.OwnerDraw := True;

  //should be done on every change of the page count
  SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
  FCloseButtonMouseDownIndex := -1;

  for I := 0 to Length(FCloseButtonsRect) - 1 do
  begin
    FCloseButtonsRect[I] := Rect(0, 0, 0, 0);
  end;
end;

procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  CloseBtnSize: Integer;
  PageControl: TPageControl;
  TabCaption: TPoint;
  CloseBtnRect: TRect;
  CloseBtnDrawState: Cardinal;
  CloseBtnDrawDetails: TThemedElementDetails;
begin
  PageControl := Control as TPageControl;

  if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
  begin
    CloseBtnSize := 14;
    TabCaption.Y := Rect.Top + 3;

    if Active then
    begin
      CloseBtnRect.Top := Rect.Top + 4;
      CloseBtnRect.Right := Rect.Right - 5;
      TabCaption.X := Rect.Left + 6;
    end
    else
    begin
      CloseBtnRect.Top := Rect.Top + 3;
      CloseBtnRect.Right := Rect.Right - 5;
      TabCaption.X := Rect.Left + 3;
    end;

    CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
    CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
    FCloseButtonsRect[TabIndex] := CloseBtnRect;

    PageControl.Canvas.FillRect(Rect);
    PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);

    if not UseThemes then
    begin
      if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
        CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
      else
        CloseBtnDrawState := DFCS_CAPTIONCLOSE;

      Windows.DrawFrameControl(PageControl.Canvas.Handle,
        FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
    end
    else
    begin
      Dec(FCloseButtonsRect[TabIndex].Left);

      if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
        CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
      else
        CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);

      ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
        FCloseButtonsRect[TabIndex]);
    end;
  end;
end;

procedure TFormMain.PageControlCloseButtonMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  PageControl: TPageControl;
begin
  PageControl := Sender as TPageControl;

  if Button = mbLeft then
  begin
    for I := 0 to Length(FCloseButtonsRect) - 1 do
    begin
      if PtInRect(FCloseButtonsRect[I], Point(X, Y)) then
      begin
        FCloseButtonMouseDownIndex := I;
        FCloseButtonShowPushed := True;
        PageControl.Repaint;
      end;
    end;
  end;
end;

procedure TFormMain.PageControlCloseButtonMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  PageControl: TPageControl;
  Inside: Boolean;
begin
  PageControl := Sender as TPageControl;

  if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
  begin
    Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y));

    if FCloseButtonShowPushed <> Inside then
    begin
      FCloseButtonShowPushed := Inside;
      PageControl.Repaint;
    end;
  end;
end;

procedure TFormMain.PageControlCloseButtonMouseLeave(Sender: TObject);
var
  PageControl: TPageControl;
begin
  PageControl := Sender as TPageControl;
  FCloseButtonShowPushed := False;
  PageControl.Repaint;
end;

procedure TFormMain.PageControlCloseButtonMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  PageControl: TPageControl;
begin
  PageControl := Sender as TPageControl;

  if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
  begin
    if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
    begin
      ShowMessage('Button ' + IntToStr(FCloseButtonMouseDownIndex + 1) + ' pressed!');

      FCloseButtonMouseDownIndex := -1;
      PageControl.Repaint;
    end;
  end;
end;

Looks like:

page control with buttons

Best Answer

Related Solutions

R – How to convert Delphi TPageControl “tab index” to “page index”

Delphi – How to implement a close button for a TTabsheet of a TPageControl

Related Topic