unit kPageControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ComCtrls, Graphics,ImgList,jpeg;

type
  TkPageControl = class(TPageControl)
  private
    FTabUnselFontCol: TColor;
    FTabSelFontCol: TColor;
    FSideTabs: boolean;
    FBitName: string;
    FButtonList : TImageList;
    FOldWidth, FOldHeight : integer;
    FOldTabPos : TTabPosition;
    FOldOwnerDraw : boolean;
    procedure SetTabSelFontCol(const Value: TColor);
    procedure SetTabUnselFontCol(const Value: TColor);
    procedure SetSideTabs(const Value: boolean);
    procedure SetBitName(const Value: string);
    procedure SetToSideTabs;
  protected
    procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); override;
//    procedure WndProc(var Message: TMessage); override;
//    procedure CreateParams(var Params: TCreateParams); override;

  public
    function VisibleTabs: integer;
    function TabText(index: integer): string;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    property TabSelFontCol : TColor read FTabSelFontCol write SetTabSelFontCol default  clBlack;
    property TabUnselFontCol : TColor read FTabUnselFontCol write SetTabUnselFontCol default clBlack;
    property SideTabs : boolean read FSideTabs write SetSideTabs default false;
    property BitName : string read FBitName write SetBitName;
  end;

procedure Register;

implementation

uses dialogs;

procedure Register;
begin
  RegisterComponents('KaveOptions', [TkPageControl]);
end;

{ TkPageControl }

constructor TkPageControl.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csOpaque];
  FButtonList := TImageList.Create(self);
  FTabUnselFontCol := clBlack;
  FTabSelFontCol := clBlack;
end;

procedure TkPageControl.SetTabSelFontCol(const Value: TColor);
begin
  FTabSelFontCol := Value;
end;

procedure TkPageControl.SetTabUnselFontCol(const Value: TColor);
begin
  FTabUnselFontCol := Value;
end;


function TkPageControl.VisibleTabs:integer;
var i:integer;
begin
  Result := 0;
  for i:=0 to PageCount-1 do
    if ( Pages[i].TabVisible ) then inc(Result);
end;

procedure TkPageControl.SetToSideTabs();
begin
  if ( TabHeight <> FButtonList.Width ) then begin TabHeight := FButtonList.Width; end;
  if ( TabWidth <> FButtonList.Height ) then begin TabWidth := FButtonList.Height; end;
  if ( TabPosition <> tpLeft ) then begin TabPosition := tpLeft; end;
end;


function TkPageControl.TabText(index:integer):string;
var i,j:integer;
begin
  j := -1;
  for i:=0 to PageCount-1 do begin
    if ( Pages[i].TabVisible ) then inc(j);
    if ( j = index ) then begin Result := Pages[i].Caption; exit; end;
  end;
  Result := '';
end;

procedure TkPageControl.DrawTab(TabIndex: Integer; const Rect: TRect;
  Active: Boolean);

var cx : TSize;
    s : string;
    col : TColor ;
    i : integer;
begin
//  inherited;
  if ( not SideTabs ) then exit;

  i := 0;
  if ( Active ) then i := 1;

  if ( FButtonList.Count >= 1 ) then
    FButtonList.Draw(Canvas,Rect.Left,Rect.Top + TabWidth div 2 - FButtonList.Height div 2,i);

(*
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clRed;
  Canvas.Rectangle(0,TabWidth*VisibleTabs,1000,1000);
*)

  Canvas.Brush.Style := bsClear;
//  s := Pages[TabIndex].Caption;
  s := TabText(TabIndex);
  cx := Canvas.TextExtent(s);
  col := TabUnselFontCol;
  if ( Active ) then col := TabSelFontCol;
  Canvas.Font.Color := col;
  Canvas.TextOut(Rect.Left+10,Rect.Top+TabWidth div 2 - cx.cy div 2,s);
end;


procedure TkPageControl.SetSideTabs(const Value: boolean);
begin
  if ( FSideTabs = Value ) then exit;
  FSideTabs := Value;
  if ( SideTabs ) then begin
    FOldWidth     := TabWidth;
    FOldHeight    := TabHeight;
    FOldTabPos    := TabPosition;
    FOldOwnerDraw := OwnerDraw;
    OwnerDraw := true;
    SetToSideTabs;
  end else begin
    TabWidth    := FOldWidth;
    TabHeight   := FOldHeight;
    TabPosition := FOldTabPos;
    OwnerDraw   := FOldOwnerDraw;
  end;
  Invalidate;
end;

procedure TkPageControl.SetBitName(const Value: string);
var b : TPicture; bmp : TBitmap;
begin
  FBitName := Value;
  FButtonList.Clear;
//  b := FButtonList.FileLoad(rtBitmap,Value,clWhite);
//  b := FButtonList.GetInstRes(self.Handle, rtBitmap,Value,200,[lrFromFile,lrTransparent],clWhite);
//  if ( b ) then ShowMessage('Moi');
  b := TPicture.Create;
  try
    b.LoadFromFile(FBitName);
  except
    b.Free;
    Exit;
  end;
  if b.Graphic is TJPEGImage then
    with TJPEGImage(b.Graphic) do
    begin
      Performance := jpBestQuality;
    end;

  bmp := TBitmap.Create;
  bmp.Width := b.Width div 2;
  bmp.Height := b.Height;
  FButtonList.Width := bmp.Width;
  FButtonList.Height := b.Height;
  bmp.Canvas.Draw(0,0,b.Graphic);
  FButtonList.AddMasked(bmp,bmp.TransparentColor);
  bmp.Canvas.Draw(-bmp.Width,0,b.Graphic);
  FButtonList.AddMasked(bmp,bmp.TransparentColor);
  bmp.Free;
  b.Free;
  if ( SideTabs ) then SetToSideTabs;
  invalidate;
end;

destructor TkPageControl.Destroy;
begin
  FButtonList.Free;
  inherited;
end;

(*
procedure TkPageControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
  { Enable full repaint }
    Style := Style and not WS_CLIPCHILDREN;
    Style := Style and not WS_CLIPSIBLINGS;
  { Add transparency }
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
  end;
end;

procedure TkPageControl.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_ERASEBKGND ) then begin
    Message.Result := 1;
  end else begin
    inherited;
  end;
end;
*)

end.