A simple way to show activity on the tab for a TTabSheet

Question

Basically I want an activity indicator that will show at a glance that there is an active calculation in progress on that tab. I'm looking for something very simple, like showing a gif on the tab, or showing a sequence of strings that change with a timer. I don't want a complicated solution or a solution that requires new components.

I already have an implementation, but I'm having a problem with it that I'm asking for a more specific solution to here: How to show backslash in a japanese locale

In the case that there isn't a solution to the other problem, or that there is a significantly better way to do this, I am asking the more general question. In any case, I'm sure that there will be others that could use a good way to do this.

Answer 1

Update :

The simplest way is probably this :

• Add an TImageList to your form.
• Add your animation images to the image list.
• Set the constant cMaxImageIndex to the last index of the animated list.
• Connect the ImageList to the TPageControl.
• Declare a function NextImageIndex.
• Activate the timer when appropriate.
• In the timer event, set the tabsheet ImageIndex property.

See code :

Const
  cMaxImageIndex = 5;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FImageIndex := 0;
end;

function TForm1.NextImageIndex: Integer;
begin
  Inc(FImageIndex);
  if (FImageIndex > cMaxImageIndex) then FImageIndex:= 0;
  Result := FImageIndex;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  PageControl1.Pages[0].ImageIndex := NextImageIndex;
end;

Note : Before activating the timer, set FImageIndex to zero, and when work is done you might also have some logic to have a default image for the tab.

Answer 2

Another approach would be to use the PageControl or TabControl's OnDrawTab event. Again, you'll need a mechanism to trigger the redrawing, but you can either draw an image directly onto the tab's canvas or toggle an asterisk or cycle through a series of dots. This approach gives you a lot of flexibility. Here's an OnTabDraw event that does nothing more than draw the tabs with a static gradient; you could use it as a starting point.

procedure TabDraw(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
const
  TCM_GETITEMRECT = $130A;
type
  TRIVERTEX = packed record
    X, Y: DWORD;
    Red, Green, Blue, Alpha: Word;
  end;
var
  vert: array[0..1] of TRIVERTEX;
  gRect: GRADIENT_RECT;
  iHeight,
  iWidth: Integer;
begin
  with FTabControl.Canvas do begin
    if Active then begin
      Brush.Color := TAB_ACTIVECOLOUR;
      FillRect(Rect);
    end
    else begin
      vert[0] .x := Rect.Left;
      vert[0] .y := Rect.Top;
      vert[0] .Red := $ab00;
      vert[0] .Green := $ab00;
      vert[0] .Blue := $ab00;
      vert[0] .Alpha := $ab00;
      vert[1] .x := Rect.Right;
      vert[1] .y := Rect.Bottom;
      vert[1] .Red := $ef00;
      vert[1] .Green := $ef00;
      vert[1] .Blue := $fe00;
      vert[1] .Alpha := $0000;
      gRect.UpperLeft  := 0;
      gRect.LowerRight := 1;
      GradientFill(FTabControl.Canvas.Handle, @vert, 2, @gRect, 1, GRADIENT_FILL_RECT_V);
    end;
    iHeight := (Rect.Bottom - Rect.Top) - TextHeight(FTabControl.Tabs[TabIndex]);
    if not Active then
      Inc(iHeight, 4);
    iWidth := (Rect.Right - Rect.Left) - TextWidth(FTabControl.Tabs[TabIndex]);
    Brush.Style := bsClear;
    TextOut(Rect.Left + (iWidth div 2), Rect.Top + (iHeight div 2), FTabControl.Tabs[TabIndex]);
  end;
end;