unit primePageControl;
{$mode objfpc}{$H+}
interface
uses
Classes, ComCtrls, Graphics, SysUtils, LCLIntf, LCLType, Controls;
type
{ TprimePageControl }
TprimePageControl = class(TPageControl)
protected
procedure PaintWindow(DC: HDC); override;
end;
procedure Register;
implementation
uses
primeGlobalData, primeFile, primeSourceFile, primeXRefFile,
primeKISFile;
{ TprimePageControl }
procedure TprimePageControl.PaintWindow(DC: HDC);
var r, r2, r3, r4:TRect;
i: Integer;
f: TprimeFile;
begin
inherited PaintWindow(DC);
//DebugLn('TrimePageControl.Paint()');
for i:=0 to PageCount-1 do begin
r:= TabRect(i);
f := TprimeFile(Pages[i].Tag);
if not Assigned(f) then exit;
//DebugLn(' %d - %s (%s)', [i, f.Name, f.ClassName]);
if (TabPosition in [tpLeft, tpRight]) then begin
r2.TopLeft.x:=r.Left;
r2.TopLeft.y:=r.Top;
r2.BottomRight.x:=r2.TopLeft.x + 2;
r2.BottomRight.y:=r.Bottom - 3;
end else begin
r2.TopLeft.x:=r.Left + 3;
r2.TopLeft.y:=r.Bottom - 2;
r2.BottomRight.x:=r.Right - 4;
r2.BottomRight.y:=r2.TopLeft.y + 2;
r3.TopLeft.x := r.Left + 5;
r3.TopLeft.y := r.Top + 7;
if i <> ActivePageIndex then inc(r3.TopLeft.y, 2);
r3.BottomRight.x := r3.TopLeft.x + 4;
r3.BottomRight.y := r3.TopLeft.y + 4;
r4.TopLeft.x := r3.TopLeft.x - 2;
r4.TopLeft.y := r3.TopLeft.y - 2;
r4.BottomRight.x := r3.BottomRight.x + 2;
r4.BottomRight.y := r3.BottomRight.y + 2;
end;
if f.Modified then begin
Brush.Color := clRed;
FillRect(DC, r4, HBRUSH(Brush.Reference.Handle));
end else if (f is TprimeKISFile) and TprimeKISFile(f).NeedsCheckIn then begin
Brush.Color := TColor($80C0FF);
FillRect(DC, r3, HBRUSH(Brush.Reference.Handle));
end;
if (f is TprimeSourceFile) and TprimeSourceFile(f).IsActiveProgram then begin
//DebugLn(' -> ActiveProgam');
Brush.Color := TColor($00BB00);
FillRect(DC, r2, HBRUSH(Brush.Reference.Handle));
end else if (f is TprimeXRefFile) and TprimeXRefFile(f).IsActiveXRef then begin
//DebugLn(' -> ActiveXRef');
Brush.Color := TColor($0080FF);
FillRect(DC, r2, HBRUSH(Brush.Reference.Handle));
end;
end;
end;
end.