Другой подход заключается в использовании события OnDrawTab PageControl или TabControl.Опять же, вам понадобится механизм для запуска перерисовки, но вы можете либо нарисовать изображение непосредственно на холсте вкладки, либо переключать звездочку или циклически проходить ряд точек.Такой подход дает вам большую гибкость.Вот событие OnTabDraw, которое не делает ничего, кроме рисования вкладок со статическим градиентом;Вы можете использовать его в качестве отправной точки.
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;