delphitpagecontrol

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


How can I implement a close button for a TTabsheet of a TPageControl like Firefox?

Edit:
Delphi Version: Delphi 2010
OS: Windows XP and up


Solution

  • 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