开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
bsSkinTabs.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：63k
源码类别：

Delphi控件源码

开发平台：

Delphi

bsSkinTabs.pas：源码内容
  1. {*******************************************************************}
  2. {                                                                   }
  3. {       Almediadev Visual Component Library                         }
  4. {       BusinessSkinForm                                            }
  5. {       Version 1.98                                                }
  6. {                                                                   }
  7. {       Copyright (c) 2000-2003 Almediadev                          }
  8. {       ALL RIGHTS RESERVED                                         }
  9. {                                                                   }
  10. {       Home:  http://www.almdev.com                                }
  11. {       Support: support@almdev.com                                 }
  12. {                                                                   }
  13. {*******************************************************************}
  15. unit bsSkinTabs;
  17. {$P+,S-,W-,R-}
  18. {$WARNINGS OFF}
  19. {$HINTS OFF}
  21. interface
  23. uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls,
  24.      CommCtrl, ComCtrls, ExtCtrls, bsSkinData, bsSkinBoxCtrls;
  25. type
  27.   TbsSkinCustomTabSheet = class(TTabSheet)
  28.   protected
  29.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  30.     procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  31.   public
  32.     procedure PaintBG(DC: HDC);
  33.     constructor Create(AOwner: TComponent); override;
  34.     destructor Destroy; override;
  35.   end;
  37.   TbsSkinTabSheet = class(TbsSkinCustomTabSheet)
  38.   protected
  39.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  40.   public
  41.     constructor Create(AOwner : TComponent); override;
  42.     destructor Destroy; override;
  43.   end;
  45.   TbsSkinPageControl = class(TPageControl)
  46.   private
  47.     FActiveTab, FOldActiveTab: Integer;
  48.     FActiveTabIndex, FOldActiveTabIndex: Integer;
  49.     function GetPosition: Integer;
  50.     function  GetInVisibleItemCount: Integer;
  51.     procedure OnUpDownChange(Sender: TObject);
  52.     procedure DrawTabs(Cnvs: TCanvas);
  53.     procedure DrawTab(TI: Integer; const Rct: TRect; Active, MouseIn: Boolean; Cnvs: TCanvas);
  54.     function GetItemRect(index: integer): TRect;
  55.     procedure SetItemSize(AWidth, AHeight: integer);
  56.     procedure CheckScroll;
  57.     procedure ShowSkinUpDown;
  58.     procedure HideSkinUpDown;
  59.     procedure TestActive(X, Y: Integer);
  60.   protected
  61.     //
  62.     FSD: TbsSkinData;
  63.     FSkinDataName: String;
  64.     FIndex: Integer;
  65.     FSkinUpDown: TbsSkinUpDown;
  66.     FDefaultFont: TFont;
  67.     FUseSkinFont: Boolean;
  68.     FDefaultItemHeight: Integer;
  69.     procedure SetDefaultItemHeight(Value: Integer);
  70.     procedure SetDefaultFont(Value: TFont);
  71.     procedure Change; override;
  72.     procedure GetSkinData;
  73.     //
  74.     procedure Notification(AComponent: TComponent;
  75.       Operation: TOperation); override;
  76.     procedure SetSkinData(Value: TbsSkinData);
  77.     procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  78.     procedure WMHSCROLL(var Msg: TWMEraseBkGnd); message WM_HSCROLL;
  79.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  80.     procedure PaintDefaultWindow(Cnvs: TCanvas);
  81.     procedure PaintSkinWindow(Cnvs: TCanvas);
  82.     procedure PaintWindow(DC: HDC); override;
  83.     procedure WndProc(var Message:TMessage); override;
  84.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  85.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  86.                         X, Y: Integer); override;
  87.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  88.   public
  89.     //
  90.     Picture: TBitMap;
  91.     SkinRect, ClRect, TabRect,
  92.     ActiveTabRect, FocusTabRect, MouseInTabRect: TRect;
  93.     TabsBGRect: TRect;
  94.     LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
  95.     TabLeftOffset, TabRightOffset: Integer;
  96.     FontName: String;
  97.     FontStyle: TFontStyles;
  98.     FontHeight: Integer;
  99.     FontColor, ActiveFontColor, FocusFontColor, MouseInFontColor: TColor;
  100.     UpDown: String;
  101.     BGPictureIndex: Integer;
  102.     //
  103.     constructor Create(AOwner: TComponent); override;
  104.     destructor Destroy; override;
  105.     procedure ChangeSkinData;
  106.     procedure Loaded; override;
  107.     procedure UpDateTabs;
  108.   published
  109.     property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
  110.     property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  111.     property DefaultItemHeight: Integer read FDefaultItemHeight write SetDefaultItemHeight;
  112.     property SkinData: TbsSkinData read FSD write SetSkinData;
  113.     property SkinDataName: String read FSkinDataName write FSkinDataName;
  114.     property Color;
  115.     property ActivePage;
  116.     property Align;
  117.     property Anchors;
  118.     property BiDiMode;
  119.     property Constraints;
  120.     property DockSite;
  121.     property DragCursor;
  122.     property DragKind;
  123.     property DragMode;
  124.     property Enabled;
  125.     property Font;
  126.     property HotTrack;
  127.     property Images;
  128.     property OwnerDraw;
  129.     property ParentBiDiMode;
  130.     property ParentFont;
  131.     property ParentShowHint;
  132.     property PopupMenu;
  133.     property RaggedRight;
  134.     property ScrollOpposite;
  135.     property ShowHint;
  136.     property TabHeight;
  137.     property TabOrder;
  138.     property TabPosition;
  139.     property TabStop;
  140.     property TabWidth;
  141.     property Visible;
  142.     property OnChange;
  143.     property OnChanging;
  144.     property OnDockDrop;
  145.     property OnDockOver;
  146.     property OnDragDrop;
  147.     property OnDragOver;
  148.     property OnDrawTab;
  149.     property OnEndDock;
  150.     property OnEndDrag;
  151.     property OnEnter;
  152.     property OnExit;
  153.     property OnGetImageIndex;
  154.     property OnGetSiteInfo;
  155.     property OnMouseDown;
  156.     property OnMouseMove;
  157.     property OnMouseUp;
  158.     property OnResize;
  159.     property OnStartDock;
  160.     property OnStartDrag;
  161.     property OnUnDock;
  162.   end;
  164.   TbsSkinTabControl = class(TTabControl)
  165.   private
  166.     FOldTop, FOldBottom: Integer;
  167.     FActiveTab, FOldActiveTab: Integer;
  168.     function GetPosition: Integer;
  169.     function  GetInVisibleItemCount: Integer;
  170.     procedure OnUpDownChange(Sender: TObject);
  171.     procedure DrawTabs(Cnvs: TCanvas);
  172.     procedure DrawTab(TI: Integer; const Rct: TRect; Active, MouseIn: Boolean; Cnvs: TCanvas);
  173.     function GetItemRect(index: integer): TRect;
  174.     procedure SetItemSize(AWidth, AHeight: integer);
  175.     procedure CheckScroll;
  176.     procedure ShowSkinUpDown;
  177.     procedure HideSkinUpDown;
  178.     procedure TestActive(X, Y: Integer);
  179.   protected
  180.     //
  181.     FSD: TbsSkinData;
  182.     FSkinDataName: String;
  183.     FIndex: Integer;
  184.     FSkinUpDown: TbsSkinUpDown;
  185.     FDefaultFont: TFont;
  186.     FUseSkinFont: Boolean;
  187.     FDefaultItemHeight: Integer;
  188.     procedure SetDefaultItemHeight(Value: Integer);
  189.     procedure SetDefaultFont(Value: TFont);
  190.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  191.     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  192.     procedure GetSkinData;
  193.     //
  194.     procedure Notification(AComponent: TComponent;
  195.       Operation: TOperation); override;
  196.     procedure SetSkinData(Value: TbsSkinData);
  197.     procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  198.     procedure WMHSCROLL(var Msg: TWMEraseBkGnd); message WM_HSCROLL;
  199.     procedure PaintDefaultWindow(Cnvs: TCanvas);
  200.     procedure PaintSkinWindow(Cnvs: TCanvas);
  201.     procedure PaintWindow(DC: HDC); override;
  202.     procedure WndProc(var Message:TMessage); override;
  203.     procedure Change; override;
  204.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  205.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  206.       X, Y: Integer); override;
  207.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  208.   public
  209.     //
  210.     Picture: TBitMap;
  211.     SkinRect, ClRect, TabRect,
  212.     ActiveTabRect, FocusTabRect, MouseInTabRect: TRect;
  213.     TabsBGRect: TRect;
  214.     LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
  215.     TabLeftOffset, TabRightOffset: Integer;
  216.     FontName: String;
  217.     FontStyle: TFontStyles;
  218.     FontHeight: Integer;
  219.     FontColor, ActiveFontColor, FocusFontColor, MouseInFontColor: TColor;
  220.     UpDown: String;
  221.     BGPictureIndex: Integer;
  222.     //
  223.     constructor Create(AOwner: TComponent); override;
  224.     destructor Destroy; override;
  225.     procedure ChangeSkinData;
  226.     procedure Loaded; override;
  227.     procedure UpDateTabs; 
  228.   published
  229.     property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
  230.     property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  231.     property DefaultItemHeight: Integer read FDefaultItemHeight write SetDefaultItemHeight;
  232.     property SkinData: TbsSkinData read FSD write SetSkinData;
  233.     property SkinDataName: String read FSkinDataName write FSkinDataName;
  234.     property Color;
  235.     property Align;
  236.     property Anchors;
  237.     property BiDiMode;
  238.     property Constraints;
  239.     property DockSite;
  240.     property DragCursor;
  241.     property DragKind;
  242.     property DragMode;
  243.     property Enabled;
  244.     property Font;
  245.     property HotTrack;
  246.     property Images;
  247.     property OwnerDraw;
  248.     property ParentBiDiMode;
  249.     property ParentFont;
  250.     property ParentShowHint;
  251.     property PopupMenu;
  252.     property RaggedRight;
  253.     property ScrollOpposite;
  254.     property ShowHint;
  255.     property TabHeight;
  256.     property TabOrder;
  257.     property TabPosition;
  258.     property TabStop;
  259.     property TabWidth;
  260.     property Visible;
  261.     property OnChange;
  262.     property OnChanging;
  263.     property OnDockDrop;
  264.     property OnDockOver;
  265.     property OnDragDrop;
  266.     property OnDragOver;
  267.     property OnDrawTab;
  268.     property OnEndDock;
  269.     property OnEndDrag;
  270.     property OnEnter;
  271.     property OnExit;
  272.     property OnGetImageIndex;
  273.     property OnGetSiteInfo;
  274.     property OnMouseDown;
  275.     property OnMouseMove;
  276.     property OnMouseUp;
  277.     property OnResize;
  278.     property OnStartDock;
  279.     property OnStartDrag;
  280.     property OnUnDock;
  281.   end;
  283. implementation
  285. uses Consts, ComStrs, bsUtils, ImgList, BusinessSkinForm, bsEffects;
  288. procedure DrawRotate90_1(Cnvs: TCanvas; B: TBitMap; X, Y: Integer);
  289. var
  290.   B1, B2: TbsEffectBmp;
  291. begin
  292.   B1 := TbsEffectBmp.CreateFromhWnd(B.Handle);
  293.   B2 := TbsEffectBmp.Create(B1.Height, B1.Width);
  294.   B1.Rotate90_1(B2);
  295.   B2.Draw(Cnvs.Handle, X, Y);
  296.   B1.Free;
  297.   B2.Free;
  298. end;
  300. procedure DrawRotate90_2(Cnvs: TCanvas; B: TBitMap; X, Y: Integer);
  301. var
  302.   B1, B2: TbsEffectBmp;
  303. begin
  304.   B1 := TbsEffectBmp.CreateFromhWnd(B.Handle);
  305.   B2 := TbsEffectBmp.Create(B1.Height, B1.Width);
  306.   B1.Rotate90_2(B2);
  307.   B2.Draw(Cnvs.Handle, X, Y);
  308.   B1.Free;
  309.   B2.Free;
  310. end;
  312. procedure DrawTabGlyphAndText(Cnvs: TCanvas; W, H: Integer; S: String;
  313.                               IM: TCustomImageList; IMIndex: Integer;
  314.                               AEnabled: Boolean);
  316. var
  317.   R, TR: TRect;
  318.   GX, GY, GW, GH, TW, TH: Integer;
  319. begin
  320.   R := Rect(0, 0, 0, 0);
  321.   DrawText(Cnvs.Handle, PChar(S), Length(S), R, DT_CALCRECT);
  322.   TW := RectWidth(R) + 2;
  323.   TH := RectHeight(R);
  324.   GW := IM.Width;
  325.   GH := IM.Height;
  326.   GX := W div 2 - (GW + TW + 2) div 2;
  327.   GY := H div 2 - GH div 2;
  328.   TR.Left := GX + GW + 2;
  329.   TR.Top := H div 2 - TH div 2;
  330.   TR.Right := TR.Left + TW;
  331.   TR.Bottom := TR.Top + TH;
  332.   DrawText(Cnvs.Handle, PChar(S), Length(S), TR, DT_CENTER);
  333.   IM.Draw(Cnvs, GX, GY, IMIndex, AEnabled);
  334. end;
  336. constructor TbsSkinCustomTabSheet.Create(AOwner: TComponent);
  337. begin
  338.   inherited Create(AOwner);
  339.   Align := alClient;
  340.   ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
  341.   Visible := False;
  342. end;
  344. destructor TbsSkinCustomTabSheet.Destroy;
  345. begin
  346.   inherited Destroy;
  347. end;
  349. procedure TbsSkinCustomTabSheet.WMEraseBkGnd;
  350. begin
  351.   PaintBG(Msg.DC);
  352. end;
  354. procedure TbsSkinCustomTabSheet.WMSize;
  355. begin
  356.   inherited;
  357.   RePaint;
  358. end;
  360. procedure TbsSkinCustomTabSheet.PaintBG;
  361. var
  362.   C: TCanvas;
  363.   TabSheetBG: TBitMap;
  364.   PC: TbsSkinPageControl;
  365.   X, Y, XCnt, YCnt, XO, YO, w, h, w1, h1: Integer;
  366. begin
  367.   if (Width <= 0) or (Height <=0) then Exit;
  368.   PC := TbsSkinPageControl(Parent);
  369.   if PC = nil then Exit;
  370.   PC.GetSkinData;
  371.   C := TCanvas.Create;
  372.   C.Handle := DC;
  374.   if (PC.FSD <> nil) and (not PC.FSD.Empty) and
  375.      (PC.FIndex <> -1) and (PC.BGPictureIndex <> -1)
  376.   then
  377.     begin
  378.       TabSheetBG := TBitMap(PC.FSD.FActivePictures.Items[PC.BGPictureIndex]);
  379.       if (Width > 0) and (Height > 0)
  380.       then
  381.         begin
  382.           XCnt := Width div TabSheetBG.Width;
  383.           YCnt := Height div TabSheetBG.Height;
  384.           for X := 0 to XCnt do
  385.           for Y := 0 to YCnt do
  386.           C.Draw(X * TabSheetBG.Width, Y * TabSheetBG.Height, TabSheetBG);
  387.         end;
  388.       C.Free;
  389.       Exit;
  390.     end;
  393.   w1 := Width;
  394.   h1 := Height;
  395.   TabSheetBG := TBitMap.Create;
  396.   TabSheetBG.Width := w1;
  397.   TabSheetBG.Height := h1;
  399.   if PC.FIndex <> -1
  400.   then
  401.   with TabSheetBG.Canvas, PC do
  402.   begin
  403.       w := RectWidth(ClRect);
  404.       h := RectHeight(ClRect);
  405.       XCnt := w1 div w;
  406.       YCnt := h1 div h;
  407.       for X := 0 to XCnt do
  408.       for Y := 0 to YCnt do
  409.       begin
  410.         if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
  411.         if Y * h + h > h1 then YO := Y * h + h - h1 else YO := 0;
  412.         CopyRect(Rect(X * w, Y * h, X * w + w - XO, Y * h + h - YO),
  413.                  Picture.Canvas,
  414.                  Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
  415.                  SkinRect.Left + ClRect.Right - XO,
  416.                  SkinRect.Top + ClRect.Bottom - YO));
  417.       end;
  418.   end
  419.   else
  420.   with TabSheetBG.Canvas do
  421.   begin
  422.     Brush.Color := clbtnface;
  423.     FillRect(Rect(0, 0, w1, h1));
  424.   end;
  425.   C.Draw(0, 0, TabSheetBG);
  426.   TabSheetBG.Free;
  427.   C.Free;
  428. end;
  430. {TTabSheetes}
  431. constructor TbsSkinTabSheet.Create(AOwner : TComponent);
  432. begin
  433.   inherited Create(AOwner);
  434. end;
  436. destructor TbsSkinTabSheet.Destroy;
  437. begin
  438.   inherited Destroy;
  439. end;
  441. procedure TbsSkinTabSheet.Notification(AComponent: TComponent; Operation: TOperation);
  442. begin
  443.   inherited Notification(AComponent, Operation);
  444. end;
  446. { TbsSkinPageControl }
  448. constructor TbsSkinPageControl.Create(AOwner: TComponent);
  449. begin
  450.   inherited Create(AOwner);
  451.   Ctl3D := False;
  452.   FIndex := -1;
  453.   Picture := nil;
  454.   Font.Name := 'Arial';
  455.   Font.Style := [];
  456.   Font.Color := clBtnText;
  457.   Font.Height := 14;
  458.   FSkinUpDown := nil;
  459.   FSkinDataName := 'tab';
  460.   FDefaultFont := TFont.Create;
  461.   FDefaultFont.Name := 'Arial';
  462.   FDefaultFont.Style := [];
  463.   FDefaultFont.Color := clBtnText;
  464.   FDefaultFont.Height := 14;
  465.   FDefaultItemHeight := 20;
  466.   FActiveTab := -1;
  467.   FOldActiveTab := -1;
  468.   FActiveTabIndex := -1;
  469.   FOldActiveTabIndex := -1;
  470.   FUseSkinFont := True;
  471. end;
  473. destructor TbsSkinPageControl.Destroy;
  474. begin
  475.   FDefaultFont.Free;
  476.   inherited Destroy;
  477. end;
  479. procedure TbsSkinPageControl.UpDateTabs;
  480. begin
  481.   if FIndex <> -1
  482.   then
  483.     SetItemSize(0, RectHeight(TabRect))
  484.   else
  485.     SetItemSize(0, FDefaultItemHeight);
  486.   if MultiLine and (FSkinUpDown <> nil)
  487.   then
  488.     HideSkinUpDown;
  489.   ReAlign;
  490. end;
  492. procedure TbsSkinPageControl.CMMouseLeave;
  493. var
  494.   R: TRect;
  495. begin
  496.   if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
  497.      (FOldActiveTabIndex < PageCount)
  498.   then
  499.     begin
  500.       R := GetItemRect(FOldActiveTabIndex);
  501.       DrawTab(FOldActiveTab, R, False, False, Canvas);
  502.       FOldActiveTabIndex := -1;
  503.       FOldActiveTab := -1;
  504.     end;
  506.   if (FActiveTabIndex <> - 1) and (FActiveTabIndex <> TabIndex) and
  507.      (FActiveTabIndex < PageCount)
  508.   then
  509.     begin
  510.       R := GetItemRect(FActiveTabIndex);
  511.       DrawTab(FActiveTab, R, False, False, Canvas);
  512.       FActiveTabIndex := -1;
  513.       FActiveTab := -1;
  514.     end;
  515. end;
  517. procedure TbsSkinPageControl.MouseDown;
  518. begin
  519.   inherited;
  520.   if (Button = mbLeft) and not (csDesigning in ComponentState)
  521.   then
  522.     TestActive(X, Y);
  523. end;
  525. procedure TbsSkinPageControl.MouseMove;
  526. begin
  527.  inherited;
  528.  if  not (csDesigning in ComponentState)
  529.  then
  530.    TestActive(X, Y);
  531. end;
  533. procedure TbsSkinPageControl.SetDefaultItemHeight;
  534. begin
  535.   FDefaultItemHeight := Value;
  536.   if FIndex = -1
  537.   then
  538.     begin
  539.       SetItemSize(0, FDefaultItemHeight);
  540.       Change;
  541.       ReAlign;
  542.     end;
  543. end;
  546. procedure TbsSkinPageControl.SetDefaultFont;
  547. begin
  548.   FDefaultFont.Assign(Value);
  549. end;
  551. procedure TbsSkinPageControl.OnUpDownChange(Sender: TObject);
  552. begin
  553.   FSkinUpDown.Max := GetInVisibleItemCount;
  554.   SendMessage(Handle, WM_HSCROLL,
  555.     MakeWParam(SB_THUMBPOSITION, FSkinUpDown.Position), 0);
  556. end;
  558. function TbsSkinPageControl.GetPosition: Integer;
  559. var
  560.   i, j: Integer;
  561.   R: TRect;
  562. begin
  563.   j := 0;
  564.   for i := 0 to PageCount - 1 do
  565.   begin
  566.     R := GetItemRect(i);
  567.     if R.Right <= 0 then inc(j);
  568.   end;
  569.   Result := j;
  570. end;
  572. function TbsSkinPageControl.GetInVisibleItemCount;
  573. var
  574.   i, j, k: Integer;
  575.   R: TRect;
  576.   Limit: Integer;
  577. begin
  578.   if FSkinUpDown = nil
  579.   then
  580.     Limit := Width - 3
  581.   else
  582.     Limit := Width - FSkinUpDown.Width - 3;
  583.   j := 0;
  584.   k := -1;
  585.   for i := 0 to PageCount - 1 do
  586.   if Pages[i].TabVisible
  587.   then
  588.   begin
  589.     inc(k);
  590.     R := GetItemRect(k);
  591.     if (R.Right > Limit) or (R.Right <= 0)
  592.     then inc(j);
  593.   end;
  594.   Result := j;
  595. end;
  597. procedure TbsSkinPageControl.CheckScroll;
  598. var
  599.   Wnd: HWND;
  600.   InVCount: Integer;
  601. begin
  602.   Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  603.   if Wnd <> 0 then DestroyWindow(Wnd);
  604.   InVCount := GetInVisibleItemCount;
  605.   if ((InVCount = 0) or MultiLine) and (FSkinUpDown <> nil)
  606.   then
  607.     HideSkinUpDown
  608.   else
  609.   if (InVCount > 0) and (FSkinUpDown = nil)
  610.   then
  611.     ShowSkinUpDown;
  612.   if FSkinUpDown <> nil
  613.   then
  614.     begin
  615.       FSkinUpDown.Max := InVCount;
  616.       FSkinUpDown.Left := Width - FSkinUpDown.Width;
  617.       if TabPosition = tpTop
  618.       then
  619.         FSkinUpDown.Top := 0
  620.       else
  621.        FSkinUpDown.Top := Height - FSkinUpDown.Height;
  622.     end;
  623. end;
  625. procedure TbsSkinPageControl.ShowSkinUpDown;
  626. begin
  627.   FSkinUpDown := TbsSkinUpDown.Create(Self);
  628.   FSkinUpDown.Parent := Self;
  629.   FSkinUpDown.Width := FDefaultItemHeight * 2;
  630.   FSkinUpDown.Height := FDefaultItemHeight;
  631.   FSkinUpDown.Min := 0;
  632.   FSkinUpDown.Max := GetInVisibleItemCount;
  633.   FSkinUpDown.Position := GetPosition;
  634.   FSkinUpDown.Increment := 1;
  635.   FSkinUpDown.OnChange := OnUpDownChange;
  636.   FSkinUpDown.Left := Width - FSkinUpDown.Width;
  637.   if TabPosition = tpTop
  638.   then
  639.     FSkinUpDown.Top := 0
  640.   else
  641.     FSkinUpDown.Top := Height - FSkinUpDown.Height;
  642.   FSkinUpDown.SkinDataName := UpDown;
  643.   FSkinUpDown.SkinData := SkinData;
  644.   FSkinUpDown.Visible := True;
  645. end;
  647. procedure TbsSkinPageControl.HideSkinUpDown;
  648. begin
  649.   FSkinUpDown.Free;
  650.   FSkinUpDown := nil;
  651. end;
  653. procedure TbsSkinPageControl.WMHSCROLL;
  654. begin
  655.   inherited;
  656.   RePaint;
  657. end;
  659. procedure TbsSkinPageControl.WMSize;
  660. begin
  661.   GetSkinData;
  662.   inherited;
  663. end;
  665. procedure TbsSkinPageControl.Change;
  666. begin
  667.   if FSkinUpDown <> nil
  668.   then FSkinUpDown.Position := GetPosition;
  669.   inherited;
  670.   Invalidate;
  671. end;
  673. procedure TbsSkinPageControl.GetSkinData;
  674. begin
  675.   BGPictureIndex := -1;
  676.   if FSD = nil
  677.   then
  678.     begin
  679.       FIndex := -1;
  680.       Exit;
  681.     end;
  682.   if FSD.Empty
  683.   then
  684.     FIndex := -1
  685.   else
  686.     FIndex := FSD.GetControlIndex(FSkinDataName);
  687.   //
  688.   if FIndex <> -1
  689.   then
  690.     if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTabControl
  691.     then
  692.       with TbsDataSkinTabControl(FSD.CtrlList.Items[FIndex]) do
  693.       begin
  694.         if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
  695.         then
  696.           Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
  697.         else
  698.           Picture := nil;
  699.         Self.SkinRect := SkinRect;
  700.         Self.ClRect := ClRect;
  701.         Self.TabRect := TabRect;
  702.         if IsNullRect(ActiveTabRect)
  703.         then
  704.           Self.ActiveTabRect := TabRect
  705.         else
  706.           Self.ActiveTabRect := ActiveTabRect;
  707.         if IsNullRect(FocusTabRect)
  708.         then
  709.           Self.FocusTabRect := ActiveTabRect
  710.         else
  711.           Self.FocusTabRect := FocusTabRect;
  712.         //
  713.         Self.TabsBGRect := TabsBGRect;
  714.         Self.LTPoint := LTPoint;
  715.         Self.RTPoint := RTPoint;
  716.         Self.LBPoint := LBPoint;
  717.         Self.RBPoint := RBPoint;
  718.         Self.TabLeftOffset := TabLeftOffset;
  719.         Self.TabRightOffset := TabRightOffset;
  720.         //
  721.         Self.FontName := FontName;
  722.         Self.FontColor := FontColor;
  723.         Self.ActiveFontColor := ActiveFontColor;
  724.         Self.FocusFontColor := FocusFontColor;
  725.         Self.FontStyle := FontStyle;
  726.         Self.FontHeight := FontHeight;
  727.         Self.UpDown := UpDown;
  728.         Self.BGPictureIndex := BGPictureIndex;
  729.         Self.MouseInTabRect := MouseInTabRect;
  730.         Self.MouseInFontColor := MouseInFontColor;
  731.       end;
  732. end;
  734. procedure TbsSkinPageControl.ChangeSkinData;
  735. begin
  736.   GetSkinData;
  737.   //
  738.   if FIndex <> -1
  739.   then
  740.     begin
  741.       if FUseSkinFont
  742.       then
  743.         begin
  744.           Font.Name := FontName;
  745.           Font.Height := FontHeight;
  746.           Font.Style := FontStyle;
  747.           Font.CharSet := DefaultFont.CharSet;
  748.         end
  749.       else
  750.         Font.Assign(FDefaultFont);
  751.       Font.Color := FontColor;
  752.       SetItemSize(0, RectHeight(TabRect));
  753.     end
  754.   else
  755.     begin
  756.       Font.Assign(FDefaultFont);
  757.       SetItemSize(0, FDefaultItemHeight);
  758.     end;
  759.   //
  760.   Change;
  761.   ReAlign;
  762.   if FSkinUpDown <> nil
  763.   then
  764.     begin
  765.       HideSkinUpDown;
  766.       CheckScroll;
  767.     end;
  768. end;
  770. procedure TbsSkinPageControl.SetSkinData;
  771. begin
  772.   FSD := Value;
  773.   if (FSD <> nil) then
  774.   if not FSD.Empty and not (csDesigning in ComponentState)
  775.   then
  776.     ChangeSkinData;
  777. end;
  779. procedure TbsSkinPageControl.Notification;
  780. begin
  781.   inherited Notification(AComponent, Operation);
  782.   if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  783. end;
  785. procedure TbsSkinPageControl.PaintDefaultWindow;
  786. var
  787.   R: TRect;
  788. begin
  789.   with Cnvs do
  790.   begin
  791.     Brush.Color := clBtnFace;
  792.     FillRect(ClientRect);
  793.     R := Self.DisplayRect;
  794.     InflateRect(R, 1, 1);
  795.     Frame3D(Cnvs, R, clBtnShadow, clBtnShadow, 1);
  796.   end;
  797. end;
  799. procedure TbsSkinPageControl.PaintSkinWindow;
  800. var
  801.   TOff, LOff, Roff, BOff: Integer;
  802.   DR, R: TRect;
  803.   TBGOffX, TBGOffY, X, Y, XCnt, YCnt, w, h, rw, rh, XO, YO: Integer;
  804.   NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  805. begin
  806.   TOff := ClRect.Top;
  807.   LOff := ClRect.Left;
  808.   ROff := RectWidth(SkinRect) - ClRect.Right;
  809.   BOff := RectHeight(SkinRect) - ClRect.Bottom;
  810.   DR := DisplayRect;
  811.   R := Rect(DR.Left - LOff, DR.Top - TOff, DR.Right + ROff, DR.Bottom + BOff);
  812.   XO := RectWidth(R) - RectWidth(SkinRect);
  813.   YO := RectHeight(R) - RectHeight(SkinRect);
  814.   NewLTPoint := LTPoint;
  815.   NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
  816.   NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
  817.   NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
  818.   // Draw tabs BG
  819.   if not IsNullRect(TabsBGRect)
  820.   then
  821.     begin
  822.       if TabPosition = tpLeft
  823.       then
  824.         begin
  825.           TBGOffY := 0;
  826.           TBGOffX := 0;
  827.           rw := R.Left;
  828.           rh := Height;
  829.         end
  830.       else
  831.       if TabPosition = tpRight
  832.       then
  833.         begin
  834.           TBGOffY := 0;
  835.           TBGOffX := R.Right;
  836.           rw := Width - R.Right;
  837.           rh := Height;
  838.         end
  839.       else
  840.       if TabPosition = tpTop
  841.       then
  842.         begin
  843.           TBGOffX := 0;
  844.           TBGOffY := 0;
  845.           rh := R.Top;
  846.           rw := Width;
  847.         end
  848.       else
  849.         begin
  850.           TBGOffX := 0;
  851.           TBGOffY := R.Bottom;
  852.           rh := Height - R.Bottom;
  853.           rw := Width;
  854.         end;
  855.       w := RectWidth(TabsBGRect);
  856.       h := RectHeight(TabsBGRect);
  857.       XCnt := rw div w;
  858.       YCnt := rh div h;
  859.       for X := 0 to XCnt do
  860.       for Y := 0 to YCnt do
  861.       begin
  862.         if X * w + w > rw then XO := X * w + w - rw else XO := 0;
  863.         if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
  864.         Cnvs.CopyRect(Rect(TBGOffX + X * w, TBGOffY + Y * h,
  865.                            TBGOffX + X * w + w - XO, TBGOffY + Y * h + h - YO),
  866.                       Picture.Canvas,
  867.                       Rect(TabsBGRect.Left, TabsBGRect.Top,
  868.                            TabsBGRect.Right - XO, TabsBGRect.Bottom - YO));
  869.       end;
  870.     end;  
  871.   // Draw frame around displayrect
  872.     // draw lines
  873.   w := RTPoint.X - LTPoint.X;
  874.   XCnt := (NewRTPoint.X - NewLTPoint.X) div w;
  875.   for X := 0 to XCnt do
  876.   begin
  877.     if NewLTPoint.X + X * w + w > NewRTPoint.X
  878.     then XO := NewLTPoint.X + X * w + w - NewRTPoint.X else XO := 0;
  879.     Cnvs.CopyRect(Rect(R.Left + NewLTPoint.X + X * w, R.Top,
  880.                   R.Left + NewLTPoint.X + X * w + w - XO, R.Top + TOff),
  881.              Picture.Canvas,
  882.              Rect(SkinRect.Left + LTPoint.X, SkinRect.Top,
  883.                   SkinRect.Left + RTPoint.X - XO, SkinRect.Top + TOff));
  884.   end;
  886.   w := RBPoint.X - LBPoint.X;
  887.   XCnt := (NewRBPoint.X - NewLBPoint.X) div w;
  888.   for X := 0 to XCnt do
  889.   begin
  890.     if NewLBPoint.X + X * w + w > NewRBPoint.X
  891.     then XO := NewLBPoint.X + X * w + w - NewRBPoint.X else XO := 0;
  892.     Cnvs.CopyRect(Rect(R.Left + NewLBPoint.X + X * w, R.Bottom - BOff,
  893.                   R.Left + NewLBPoint.X + X * w + w - XO, R.Bottom),
  894.              Picture.Canvas,
  895.              Rect(SkinRect.Left + LBPoint.X, SkinRect.Bottom - BOff,
  896.                   SkinRect.Left + RBPoint.X - XO, SkinRect.Bottom));
  897.   end;
  899.   w := LOff;
  900.   h := LBPoint.Y - LTPoint.Y;
  901.   YCnt := (NewLBPoint.Y - NewLTPoint.Y) div h;
  902.   for Y := 0 to YCnt do
  903.   begin
  904.     if NewLTPoint.Y + Y * h + h > NewLBPoint.Y
  905.     then YO := NewLTPoint.Y + Y * h + h - NewLBPoint.Y else YO := 0;
  906.     Cnvs.CopyRect(Rect(R.Left, R.Top + NewLTPoint.Y + Y * h,
  907.                        R.Left + w, R.Top + NewLTPoint.Y + Y * h + h - YO),
  908.                   Picture.Canvas,
  909.                   Rect(SkinRect.Left, SkinRect.Top + LTPoint.Y,
  910.                        SkinRect.Left + w, SkinRect.Top + LBPoint.Y - YO));
  911.   end;
  912.   w := ROff;
  913.   h := RBPoint.Y - RTPoint.Y;
  914.   YCnt := (NewRBPoint.Y - NewRTPoint.Y) div h;
  915.   for Y := 0 to YCnt do
  916.   begin
  917.     if NewRTPoint.Y + Y * h + h > NewRBPoint.Y
  918.     then YO := NewRTPoint.Y + Y * h + h - NewRBPoint.Y else YO := 0;
  919.     Cnvs.CopyRect(Rect(R.Right - w, R.Top + NewRTPoint.Y + Y * h,
  920.                        R.Right, R.Top + NewRTPoint.Y + Y * h + h - YO),
  921.                   Picture.Canvas,
  922.                   Rect(SkinRect.Right - w, SkinRect.Top + RTPoint.Y,
  923.                        SkinRect.Right, SkinRect.Top + RBPoint.Y - YO));
  924.   end;
  925.     // draw corners
  926.   Cnvs.CopyRect(Rect(R.Left, R.Top, R.Left + LTPoint.X, R.Top + LTPoint.Y),
  927.                 Picture.Canvas,
  928.                 Rect(SkinRect.Left, SkinRect.Top,
  929.                      SkinRect.Left + NewLTPoint.X, SkinRect.Top + NewLTPoint.Y));
  930.   Cnvs.CopyRect(Rect(R.Left + NewRTPoint.X, R.Top,
  931.                      R.Right, R.Top + NewRTPoint.Y),
  932.                 Picture.Canvas,
  933.                 Rect(SkinRect.Left + RTPoint.X, SkinRect.Top,
  934.                      SkinRect.Right, SkinRect.Top + RTPoint.Y));
  935.   Cnvs.CopyRect(Rect(R.Left, R.Top + NewLBPoint.Y,
  936.                      R.Left + NewLBPoint.X, R.Bottom),
  937.                 Picture.Canvas,
  938.                 Rect(SkinRect.Left, SkinRect.Top + LBPoint.Y,
  939.                      SkinRect.Left + LBPoint.X, SkinRect.Bottom));
  940.   Cnvs.CopyRect(Rect(R.Left + NewRBPoint.X, R.Top + NewRBPoint.Y,
  941.                      R.Right, R.Bottom),
  942.                 Picture.Canvas,
  943.                 Rect(SkinRect.Left + RBPoint.X, SkinRect.Top + RBPoint.Y,
  944.                      SkinRect.Right, SkinRect.Bottom));
  945. end;
  947. procedure TbsSkinPageControl.Loaded;
  948. begin
  949.   inherited Loaded;
  950.   if FIndex = -1
  951.   then
  952.     begin
  953.       SetItemSize(0, FDefaultItemHeight);
  954.       Change;
  955.       ReAlign;
  956.     end;
  957. end;
  959. procedure TbsSkinPageControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
  960. begin
  961.   if Self.PageCount = 0
  962.   then
  963.     inherited
  964.   else
  965.     Msg.Result := 1;
  966. end;
  968. procedure TbsSkinPageControl.WndProc(var Message:TMessage);
  969. var
  970.   TOff, LOff, Roff, BOff: Integer;
  971. begin
  972.   if Message.Msg = TCM_ADJUSTRECT
  973.   then
  974.     begin
  975.       inherited WndProc(Message);
  976.       if FIndex <> -1
  977.       then
  978.         begin
  979.           TOff := ClRect.Top;
  980.           LOff := ClRect.Left;
  981.           ROff := RectWidth(SkinRect) - ClRect.Right;
  982.           BOff := RectHeight(SkinRect) - ClRect.Bottom;
  983.         end;
  984.       case TabPosition of
  985.         tpLeft:
  986.            if FIndex <> -1
  987.            then
  988.              begin
  989.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + LOff - 4;
  990.                PRect(Message.LParam)^.Right := ClientWidth - ROff;
  991.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  992.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  993.              end
  994.            else
  995.              begin
  996.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
  997.                PRect(Message.LParam)^.Right := ClientWidth - 1;
  998.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  999.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1000.              end;
  1001.         tpRight:
  1002.            if FIndex <> -1
  1003.            then
  1004.              begin
  1005.                PRect(Message.LParam)^.Left := LOff;
  1006.                PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - ROff + 4;
  1007.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1008.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  1009.              end
  1010.            else
  1011.              begin
  1012.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
  1013.                PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 3;
  1014.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  1015.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1016.              end;
  1017.         tpTop:
  1018.            if FIndex <> -1
  1019.            then
  1020.              begin
  1021.                PRect(Message.LParam)^.Left := LOff;
  1022.                PRect(Message.LParam)^.Right := ClientWidth - ROff;
  1023.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1024.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  1025.              end
  1026.            else
  1027.              begin
  1028.                PRect(Message.LParam)^.Left := 1;
  1029.                PRect(Message.LParam)^.Right := ClientWidth - 1;
  1030.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  1031.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1032.              end;
  1033.         tpBottom:
  1034.           if FIndex <> -1
  1035.           then
  1036.             begin
  1037.               PRect(Message.LParam)^.Left := LOff;
  1038.               PRect(Message.LParam)^.Right := ClientWidth - ROff;
  1039.               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1040.               PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 4 - BOff;
  1041.             end
  1042.           else
  1043.             begin
  1044.               PRect(Message.LParam)^.Left := 1;
  1045.               PRect(Message.LParam)^.Right := ClientWidth - 1;
  1046.               PRect(Message.LParam)^.Top := 1;
  1047.               PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 3;
  1048.             end;
  1050.       end;
  1051.     end
  1052.   else
  1053.     if Message.Msg = TCM_GETITEMRECT
  1054.     then
  1055.       begin
  1056.         inherited WndProc(Message);
  1057.         if Style = tsTabs
  1058.         then
  1059.           case TabPosition of
  1060.             tpLeft:
  1061.                 begin
  1062.                   PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  1063.                   PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  1064.                 end;
  1065.             tpRight:
  1066.                 begin
  1067.                   PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + 2;
  1068.                   PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 2;
  1069.                 end;
  1071.             tpTop:
  1072.                 begin
  1073.                   if not MultiLine
  1074.                   then
  1075.                     begin
  1076.                       PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  1077.                       PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  1078.                     end;
  1079.                   PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
  1080.                   PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom - 2;
  1081.                 end;
  1082.             tpBottom:
  1083.                 begin
  1084.                   if not MultiLine
  1085.                   then
  1086.                     begin
  1087.                       PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  1088.                       PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  1089.                     end;
  1090.                   PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top + 2;
  1091.                   PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
  1092.                 end;
  1093.           end;
  1094.       end
  1095.   else
  1096.   inherited WndProc(Message);
  1097.   if (Message.Msg = WM_SIZE) and (not MultiLine) and
  1098.      not (csDesigning in ComponentState)
  1099.   then
  1100.     begin
  1101.       CheckScroll;
  1102.     end;
  1103. end;
  1105. function TbsSkinPageControl.GetItemRect(index: integer): TRect;
  1106. var
  1107.   R: TRect;
  1108. begin
  1109.   SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  1110.   Result := R;
  1111. end;
  1113. procedure TbsSkinPageControl.SetItemSize;
  1114. begin
  1115.   SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
  1116. end;
  1118. procedure TbsSkinPageControl.PaintWindow(DC: HDC);
  1119. var
  1120.   SaveIndex: Integer;
  1121.   B: TBitMap;
  1122. begin
  1123.   if (Width <= 0) or (Height <=0) then Exit;
  1124.   GetSkinData;
  1125.   SaveIndex := SaveDC(DC);
  1126.   try
  1127.     Canvas.Handle := DC;
  1128.     B := TBitMap.Create;
  1129.     B.Width := Width;
  1130.     B.Height := Height;
  1131.     if FIndex = -1
  1132.     then
  1133.       PaintDefaultWindow(B.Canvas)
  1134.     else
  1135.       PaintSkinWindow(B.Canvas);
  1136.     DrawTabs(B.Canvas);
  1137.     Canvas.Draw(0, 0, B);
  1138.     B.Free;
  1139.     Canvas.Handle := 0;
  1140.   finally
  1141.     RestoreDC(DC, SaveIndex);
  1142.   end;
  1143. end;
  1145. procedure TbsSkinPageControl.TestActive(X, Y: Integer);
  1146. var
  1147.   i, j, k: Integer;
  1148.   R: TRect;
  1149. begin
  1150.   FOldActiveTab := FActiveTab;
  1151.   FOldActiveTabIndex := FActiveTabIndex;
  1152.   k := -1;
  1153.   j := -1;
  1154.   for i := 0 to PageCount - 1 do
  1155.   if Pages[i].TabVisible then
  1156.   begin
  1157.     Inc(k);
  1158.     R := GetItemRect(k);
  1159.     if PtInRect(R, Point(X, Y))
  1160.     then
  1161.       begin
  1162.         j := k;
  1163.         Break;
  1164.       end;
  1165.   end;
  1167.   FActiveTab := i;
  1168.   FActiveTabIndex := j;
  1170.   if (FOldActiveTabIndex <> FActiveTabIndex)
  1171.   then
  1172.     begin
  1173.       if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
  1174.          (FOldActiveTabIndex < PageCount)
  1175.       then
  1176.         begin
  1177.           R := GetItemRect(FOldActiveTabIndex);
  1178.           DrawTab(FOldActiveTab, R, False, False, Canvas);
  1179.         end;
  1180.       if (FActiveTabIndex <> -1) and (FActiveTabIndex <> TabIndex) and
  1181.          (FActiveTabIndex < PageCount)
  1182.       then
  1183.         begin
  1184.           R := GetItemRect(FActiveTabIndex);
  1185.           DrawTab(FActiveTab, R, False, True, Canvas );
  1186.         end;
  1187.     end;
  1188. end;
  1190. procedure TbsSkinPageControl.DrawTabs;
  1191. var
  1192.   i, j: integer;
  1193.   R: TRect;
  1194. begin
  1195.   j := -1;
  1196.   for i := 0 to PageCount-1 do
  1197.   if Pages[i].TabVisible then
  1198.   begin
  1199.     inc(j);
  1200.     R := GetItemRect(j);
  1201.     DrawTab(i, R, (j = TabIndex), j = FActiveTabIndex, Cnvs);
  1202.   end;
  1203. end;
  1205. procedure TbsSkinPageControl.DrawTab;
  1206. var
  1207.   R: TRect;
  1208.   S: String;
  1209.   TB: TBitMap;
  1210.   DrawGlyph: Boolean;
  1211.   W, H: Integer;
  1212. begin
  1213.   DrawGlyph := (Images <> nil) and (TI < Images.Count);
  1214.   S := Pages[TI].Caption;
  1215.   TB := TBitMap.Create;
  1216.   if (TabPosition = tpTop) or (TabPosition = tpBottom)
  1217.   then
  1218.     begin
  1219.       W := RectWidth(Rct);
  1220.       H := RectHeight(Rct);
  1221.     end
  1222.   else
  1223.     begin
  1224.       H := RectWidth(Rct);
  1225.       W := RectHeight(Rct);
  1226.     end;
  1227.   R := Rect(0, 0, W, H);  
  1228.   if FIndex <> -1
  1229.   then
  1230.     begin
  1231.       if MouseIn and not Active and not IsNullRect(MouseInTabRect)
  1232.       then
  1233.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  1234.           TB, Picture, MouseInTabRect, W, H)
  1235.       else
  1236.       if Active and Focused
  1237.       then
  1238.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  1239.           TB, Picture, FocusTabRect, W, H)
  1240.       else
  1241.       if Active
  1242.       then
  1243.          CreateHSkinImage(TabLeftOffset, TabRightOffset,
  1244.           TB, Picture, ActiveTabRect, W, H)
  1245.       else
  1246.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  1247.           TB, Picture, TabRect, W, H);
  1248.       with TB.Canvas do
  1249.       begin
  1250.         Brush.Style := bsClear;
  1251.         if FUseSkinFont
  1252.         then
  1253.           begin
  1254.             Font.Name := FontName;
  1255.             Font.Style := FontStyle;
  1256.             Font.Height := FontHeight;
  1257.             Font.CharSet := Self.Font.CharSet;
  1258.           end
  1259.         else
  1260.            Font.Assign(Self.Font);
  1261.         if MouseIn and not Active
  1262.         then
  1263.           Font.Color := MouseInFontColor
  1264.         else
  1265.         if Active and Focused
  1266.         then
  1267.           Font.Color := FocusFontColor
  1268.         else
  1269.           if Active
  1270.           then Font.Color := ActiveFontColor
  1271.           else Font.Color := FontColor;
  1272.       end;
  1273.     end
  1274.   else
  1275.     begin
  1276.       TB.Width := W;
  1277.       TB.Height := H;
  1278.       if MouseIn and not Active
  1279.       then
  1280.         begin
  1281.           TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
  1282.           TB.Canvas.FillRect(R);
  1283.         end
  1284.       else
  1285.       if Active and Focused
  1286.       then
  1287.         begin
  1288.           Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
  1289.           TB.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
  1290.           TB.Canvas.FillRect(R);
  1291.         end
  1292.       else
  1293.       if Active
  1294.       then
  1295.         begin
  1296.           Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
  1297.           TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
  1298.           TB.Canvas.FillRect(R);
  1299.         end
  1300.       else
  1301.         begin
  1302.           TB.Canvas.Brush.Color := clBtnFace;
  1303.           TB.Canvas.FillRect(R);
  1304.         end;
  1305.       with TB.Canvas do
  1306.       begin
  1307.         Brush.Style := bsClear;
  1308.         Font.Assign(Self.Font);
  1309.       end;
  1310.     end;
  1311.   //
  1312.   if DrawGlyph
  1313.   then
  1314.     DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
  1315.                         Images, TI, Pages[TI].Enabled)
  1316.   else
  1317.     DrawText(TB.Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  1318.   if TabPosition = tpLeft
  1319.   then
  1320.     DrawRotate90_1(Cnvs, TB, Rct.Left, Rct.Top)
  1321.   else
  1322.   if TabPosition = tpRight
  1323.   then
  1324.     DrawRotate90_2(Cnvs, TB, Rct.Left, Rct.Top)
  1325.   else
  1326.     Cnvs.Draw(Rct.Left, Rct.Top, TB);
  1327.   TB.Free;
  1328. end;
  1331. { TbsSkinTabControl }
  1333. constructor TbsSkinTabControl.Create(AOwner: TComponent);
  1334. begin
  1335.   inherited Create(AOwner);
  1336.   Ctl3D := False;
  1337.   FIndex := -1;
  1338.   Picture := nil;
  1339.   Font.Name := 'Arial';
  1340.   Font.Style := [];
  1341.   Font.Color := clBtnText;
  1342.   Font.Height := 14;
  1343.   FOldTop := 0;
  1344.   FOldBottom := 0;
  1345.   FSkinUpDown := nil;
  1346.   FSkinDataName := 'tab';
  1347.   FDefaultFont := TFont.Create;
  1348.   FDefaultFont.Name := 'Arial';
  1349.   FDefaultFont.Style := [];
  1350.   FDefaultFont.Color := clBtnText;
  1351.   FDefaultFont.Height := 14;
  1352.   FDefaultItemHeight := 20;
  1353.   FUseSkinFont := True;
  1354. end;
  1356. procedure TbsSkinTabControl.MouseMove;
  1357. begin
  1358.  inherited;
  1359.  if not (csDesigning in ComponentState)
  1360.  then
  1361.    TestActive(X, Y);
  1362. end;
  1364. procedure TbsSkinTabControl.MouseDown;
  1365. begin
  1366.   inherited;
  1367.   if (Button = mbLeft) and not (csDesigning in ComponentState)
  1368.   then
  1369.     TestActive(X, Y);
  1370. end;
  1372. procedure TbsSkinTabControl.CMMouseLeave;
  1373. var
  1374.   R: TRect;
  1375. begin
  1376.   if (FOldActiveTab <> - 1) and (FOldActiveTab <> TabIndex) and
  1377.      (FOldActiveTab < Self.Tabs.Count)
  1378.   then
  1379.     begin
  1380.       R := GetItemRect(FOldActiveTab);
  1381.       DrawTab(FOldActiveTab, R, False, False, Canvas);
  1382.       FOldActiveTab := -1;
  1383.     end;
  1385.   if (FActiveTab <> - 1) and (FActiveTab <> TabIndex) and
  1386.      (FActiveTab < Self.Tabs.Count)
  1387.   then
  1388.     begin
  1389.       R := GetItemRect(FActiveTab);
  1390.       DrawTab(FActiveTab, R, False, False, Canvas);
  1391.       FActiveTab := -1;
  1392.     end;
  1393. end;
  1395. procedure TbsSkinTabControl.TestActive(X, Y: Integer);
  1396. var
  1397.   i, j: Integer;
  1398.   R: TRect;
  1399. begin
  1400.   FOldActiveTab := FActiveTab;
  1401.   j := -1;
  1402.   for i := 0 to Tabs.Count-1 do
  1403.   begin
  1404.     R := GetItemRect(i);
  1405.     if PtInRect(R, Point(X, Y))
  1406.     then
  1407.       begin
  1408.         j := i;
  1409.         Break;
  1410.       end;
  1411.   end;
  1413.   FActiveTab := j;
  1415.   if (FOldActiveTab <> FActiveTab)
  1416.   then
  1417.     begin
  1418.       if (FOldActiveTab <> - 1) and (FOldActiveTab <> TabIndex) and
  1419.          (FOldActiveTab < Self.Tabs.Count)
  1420.       then
  1421.         begin
  1422.           R := GetItemRect(FOldActiveTab);
  1423.           DrawTab(FOldActiveTab, R, False, False, Canvas);
  1424.         end;
  1425.       if (FActiveTab <> -1) and (FActiveTab <> TabIndex) and
  1426.          (FActiveTab < Self.Tabs.Count)
  1427.       then
  1428.         begin
  1429.           R := GetItemRect(FActiveTab);
  1430.           DrawTab(FActiveTab, R, False, True, Canvas );
  1431.         end;
  1432.     end;
  1433. end;
  1435. procedure TbsSkinTabControl.SetDefaultItemHeight;
  1436. begin
  1437.   FDefaultItemHeight := Value;
  1438.   if FIndex = -1
  1439.   then
  1440.     begin
  1441.       SetitemSize(0, FDefaultItemHeight);
  1442.       Change;
  1443.       ReAlign;
  1444.     end;
  1445. end;
  1448. procedure TbsSkinTabControl.SetDefaultFont;
  1449. begin
  1450.   FDefaultFont.Assign(Value);
  1451. end;
  1453. procedure TbsSkinTabControl.OnUpDownChange(Sender: TObject);
  1454. begin
  1455.   FSkinUpDown.Max := GetInVisibleItemCount;
  1456.   SendMessage(Handle, WM_HSCROLL,
  1457.     MakeWParam(SB_THUMBPOSITION, FSkinUpDown.Position), 0);
  1458. end;
  1460. function TbsSkinTabControl.GetPosition: Integer;
  1461. var
  1462.   i, j: Integer;
  1463.   R: TRect;
  1464. begin
  1465.   j := 0;
  1466.   for i := 0 to Tabs.Count - 1 do
  1467.   begin
  1468.     R := GetItemRect(i);
  1469.     if R.Right <= 0 then inc(j);
  1470.   end;
  1471.   Result := j;
  1472. end;
  1474. function TbsSkinTabControl.GetInVisibleItemCount;
  1475. var
  1476.   i, j: Integer;
  1477.   R: TRect;
  1478.   Limit: Integer;
  1479. begin
  1480.   if FSkinUpDown = nil
  1481.   then
  1482.     Limit := Width - 3
  1483.   else
  1484.     Limit := Width - FSkinUpDown.Width - 3;
  1485.   j := 0;
  1486.   for i := 0 to Tabs.Count - 1 do
  1487.   begin
  1488.     R := GetItemRect(i);
  1489.     if (R.Right > Limit) or (R.Right <= 0)
  1490.     then inc(j);
  1491.   end;
  1492.   Result := j;
  1493. end;
  1495. procedure TbsSkinTabControl.CheckScroll;
  1496. var
  1497.   Wnd: HWND;
  1498.   InVCount: Integer;
  1499. begin
  1500.   Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  1501.   if Wnd <> 0 then DestroyWindow(Wnd);
  1502.   InVCount := GetInVisibleItemCount;
  1503.   if (InVCount = 0) and (FSkinUpDown <> nil)
  1504.   then
  1505.     HideSkinUpDown
  1506.   else
  1507.   if (InVCount > 0) and (FSkinUpDown = nil)
  1508.   then
  1509.     ShowSkinUpDown;
  1510.   if FSkinUpDown <> nil
  1511.   then
  1512.     begin
  1513.       FSkinUpDown.Max := InVCount;
  1514.       FSkinUpDown.Left := Width - FSkinUpDown.Width;
  1515.       if TabPosition = tpTop
  1516.       then
  1517.         FSkinUpDown.Top := 0
  1518.       else
  1519.        FSkinUpDown.Top := Height - FSkinUpDown.Height;
  1520.     end;
  1521. end;
  1523. procedure TbsSkinTabControl.ShowSkinUpDown;
  1524. begin
  1525.   FSkinUpDown := TbsSkinUpDown.Create(Self);
  1526.   FSkinUpDown.Parent := Self;
  1527.   FSkinUpDown.Width := 36;
  1528.   FSkinUpDown.Height := 18;
  1529.   FSkinUpDown.Min := 0;
  1530.   FSkinUpDown.Max := GetInVisibleItemCount;
  1531.   FSkinUpDown.Position := GetPosition;
  1532.   FSkinUpDown.Increment := 1;
  1533.   FSkinUpDown.OnChange := OnUpDownChange;
  1534.   FSkinUpDown.Left := Width - FSkinUpDown.Width;
  1535.   if TabPosition = tpTop
  1536.   then
  1537.     FSkinUpDown.Top := 0
  1538.   else
  1539.     FSkinUpDown.Top := Height - FSkinUpDown.Height;
  1540.   FSkinUpDown.SkinDataName := UpDown;
  1541.   FSkinUpDown.SkinData := SkinData;
  1542.   FSkinUpDown.Visible := True;
  1543. end;
  1545. procedure TbsSkinTabControl.HideSkinUpDown;
  1546. begin
  1547.   FSkinUpDown.Free;
  1548.   FSkinUpDown := nil;
  1549. end;
  1551. procedure TbsSkinTabControl.WMPaint;
  1552. begin
  1553.   if ControlCount = 0
  1554.   then
  1555.     PaintHandler(Msg)
  1556.   else
  1557.     inherited;
  1558. end;
  1560. procedure TbsSkinTabControl.WMHSCROLL;
  1561. begin
  1562.   inherited;
  1563.   RePaint;
  1564. end;
  1566. procedure TbsSkinTabControl.WMSize;
  1567. begin
  1568.   inherited;
  1569. end;
  1571. destructor TbsSkinTabControl.Destroy;
  1572. begin
  1573.   FDefaultFont.Free;
  1574.   inherited Destroy;
  1575. end;
  1577. procedure TbsSkinTabControl.Change;
  1578. begin
  1579.   if FSkinUpDown <> nil
  1580.   then FSkinUpDown.Position := GetPosition;
  1581.   inherited;
  1582.   Invalidate;
  1583. end;
  1585. procedure TbsSkinTabControl.GetSkinData;
  1586. begin
  1587.   BGPictureIndex := -1;
  1588.   if FSD = nil
  1589.   then
  1590.     begin
  1591.       FIndex := -1;
  1592.       Exit;
  1593.     end;
  1594.   if FSD.Empty
  1595.   then
  1596.     FIndex := -1
  1597.   else
  1598.     FIndex := FSD.GetControlIndex(FSkinDataName);
  1599.   //
  1600.   if FIndex <> -1
  1601.   then
  1602.     if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTabControl
  1603.     then
  1604.       with TbsDataSkinTabControl(FSD.CtrlList.Items[FIndex]) do
  1605.       begin
  1606.         if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
  1607.         then
  1608.           Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
  1609.         else
  1610.           Picture := nil;
  1611.         Self.SkinRect := SkinRect;
  1612.         Self.ClRect := ClRect;
  1613.         Self.TabRect := TabRect;
  1614.         if IsNullRect(ActiveTabRect)
  1615.         then
  1616.           Self.ActiveTabRect := TabRect
  1617.         else
  1618.           Self.ActiveTabRect := ActiveTabRect;
  1619.         if IsNullRect(FocusTabRect)
  1620.         then
  1621.           Self.FocusTabRect := ActiveTabRect
  1622.         else
  1623.           Self.FocusTabRect := FocusTabRect;
  1624.         //
  1625.         Self.TabsBGRect := TabsBGRect; 
  1626.         Self.LTPoint := LTPoint;
  1627.         Self.RTPoint := RTPoint;
  1628.         Self.LBPoint := LBPoint;
  1629.         Self.RBPoint := RBPoint;
  1630.         Self.TabLeftOffset := TabLeftOffset;
  1631.         Self.TabRightOffset := TabRightOffset;
  1632.         //
  1633.         Self.FontName := FontName;
  1634.         Self.FontColor := FontColor;
  1635.         Self.ActiveFontColor := ActiveFontColor;
  1636.         Self.FocusFontColor := FocusFontColor;
  1637.         Self.FontStyle := FontStyle;
  1638.         Self.FontHeight := FontHeight;
  1639.         Self.UpDown := UpDown;
  1640.         Self.BGPictureIndex := BGPictureIndex;
  1641.         Self.MouseInFontColor := MouseInFontColor;
  1642.         Self.MouseInTabRect := MouseInTabRect;
  1643.       end;
  1644. end;
  1646. procedure TbsSkinTabControl.ChangeSkinData;
  1647. begin
  1648.   GetSkinData;
  1649.   //
  1650.   if FIndex <> -1
  1651.   then
  1652.     begin
  1653.       Font.Color := FontColor;
  1654.       if FUseSkinFont
  1655.       then
  1656.         begin
  1657.           Font.Name := FontName;
  1658.           Font.Height := FontHeight;
  1659.           Font.Style := FontStyle;
  1660.           Font.CharSet := DefaultFont.CharSet;
  1661.         end
  1662.       else
  1663.         Font.Assign(FDefaultFont);
  1664.       SetItemSize(0, RectHeight(TabRect));
  1665.     end
  1666.   else
  1667.     begin
  1668.       Font.Assign(FDefaultFont);
  1669.       SetItemSize(0, FDefaultItemHeight);
  1670.     end;
  1671.   //
  1672.   Change;
  1673.   ReAlign;
  1674.   RePaint;
  1675.   if FSkinUpDown <> nil
  1676.   then
  1677.     begin
  1678.       HideSkinUpDown;
  1679.       CheckScroll;
  1680.     end;
  1681. end;
  1683. procedure TbsSkinTabControl.SetSkinData;
  1684. begin
  1685.   FSD := Value;
  1686.   if (FSD <> nil) then
  1687.   if not FSD.Empty and not (csDesigning in ComponentState)
  1688.   then
  1689.     ChangeSkinData;
  1690. end;
  1692. procedure TbsSkinTabControl.Notification;
  1693. begin
  1694.   inherited Notification(AComponent, Operation);
  1695.   if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  1696. end;
  1698. procedure TbsSkinTabControl.PaintDefaultWindow;
  1699. var
  1700.   R: TRect;
  1701. begin
  1702.   with Cnvs do
  1703.   begin
  1704.     Brush.Color := clBtnFace;
  1705.     FillRect(ClientRect);
  1706.     R := Self.DisplayRect;
  1707.     InflateRect(R, 1, 1);
  1708.     Frame3D(Cnvs, R, clBtnShadow, clBtnShadow, 1);
  1709.   end;
  1710. end;
  1712. procedure TbsSkinTabControl.PaintSkinWindow;
  1713. var
  1714.   TOff, LOff, Roff, BOff: Integer;
  1715.   DR, R: TRect;
  1716.   TBGOffX, TBGOffY, X, Y, XCnt, YCnt, w, h, w1, h1, rw, rh, XO, YO: Integer;
  1717.   NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  1718.   B: TBitMap;
  1719. begin
  1720.   TOff := ClRect.Top;
  1721.   LOff := ClRect.Left;
  1722.   ROff := RectWidth(SkinRect) - ClRect.Right;
  1723.   BOff := RectHeight(SkinRect) - ClRect.Bottom;
  1724.   DR := DisplayRect;
  1725.   R := Rect(DR.Left - LOff, DR.Top - TOff, DR.Right + ROff, DR.Bottom + BOff);
  1726.   XO := RectWidth(R) - RectWidth(SkinRect);
  1727.   YO := RectHeight(R) - RectHeight(SkinRect);
  1728.   NewLTPoint := LTPoint;
  1729.   NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
  1730.   NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
  1731.   NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
  1732.   // DrawBG
  1734.   if BGPictureIndex <> -1
  1735.   then
  1736.     begin
  1737.       B := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
  1738.       if (Width > 0) and (Height > 0)
  1739.       then
  1740.         begin
  1741.           XCnt := Width div B.Width;
  1742.           YCnt := Height div B.Height;
  1743.           for X := 0 to XCnt do
  1744.           for Y := 0 to YCnt do
  1745.           Cnvs.Draw(X * B.Width, Y * B.Height, B);
  1746.         end;
  1747.       Exit;
  1748.     end;
  1750.   w := RectWidth(ClRect);
  1751.   h := RectHeight(ClRect);
  1752.   w1 := RectWidth(R);
  1753.   h1 := RectHeight(R);
  1754.   XCnt := w1 div w;
  1755.   YCnt := h1 div h;
  1756.   for X := 0 to XCnt do
  1757.   for Y := 0 to YCnt do
  1758.   begin
  1759.     if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
  1760.     if Y * h + h > h1 then YO := Y * h + h - h1 else YO := 0;
  1761.      Cnvs.CopyRect(Rect(R.Left + X * w, R.Top + Y * h,
  1762.                         R.Left + X * w + w - XO, R.Top + Y * h + h - YO),
  1763.               Picture.Canvas,
  1764.               Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
  1765.                    SkinRect.Left + ClRect.Right - XO,
  1766.                    SkinRect.Top + ClRect.Bottom - YO));
  1767.   end;            
  1768.   // Draw tabs BG
  1769.   if not IsNullRect(TabsBGRect)
  1770.   then
  1771.     begin
  1772.       if TabPosition = tpLeft
  1773.       then
  1774.         begin
  1775.           TBGOffY := 0;
  1776.           TBGOffX := 0;
  1777.           rw := R.Left;
  1778.           rh := Height;
  1779.         end
  1780.       else
  1781.       if TabPosition = tpRight
  1782.       then
  1783.         begin
  1784.           TBGOffY := 0;
  1785.           TBGOffX := R.Right;
  1786.           rw := Width - R.Right;
  1787.           rh := Height;
  1788.         end
  1789.       else
  1790.       if TabPosition = tpTop
  1791.       then
  1792.         begin
  1793.           TBGOffX := 0;
  1794.           TBGOffY := 0;
  1795.           rh := R.Top;
  1796.           rw := Width;
  1797.         end
  1798.       else
  1799.         begin
  1800.           TBGOffX := 0;
  1801.           TBGOffY := R.Bottom;
  1802.           rh := Height - R.Bottom;
  1803.           rw := Width;
  1804.         end;
  1805.       w := RectWidth(TabsBGRect);
  1806.       h := RectHeight(TabsBGRect);
  1807.       XCnt := rw div w;
  1808.       YCnt := rh div h;
  1809.       for X := 0 to XCnt do
  1810.       for Y := 0 to YCnt do
  1811.       begin
  1812.         if X * w + w > rw then XO := X * w + w - rw else XO := 0;
  1813.         if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
  1814.         Cnvs.CopyRect(Rect(TBGOffX + X * w, TBGOffY + Y * h,
  1815.                            TBGOffX + X * w + w - XO, TBGOffY + Y * h + h - YO),
  1816.                       Picture.Canvas,
  1817.                       Rect(TabsBGRect.Left, TabsBGRect.Top,
  1818.                            TabsBGRect.Right - XO, TabsBGRect.Bottom - YO));
  1819.       end;
  1820.     end;
  1821.   // Draw frame around displayrect
  1822.     // draw lines
  1823.   w := RTPoint.X - LTPoint.X;
  1824.   XCnt := (NewRTPoint.X - NewLTPoint.X) div w;
  1825.   for X := 0 to XCnt do
  1826.   begin
  1827.     if NewLTPoint.X + X * w + w > NewRTPoint.X
  1828.     then XO := NewLTPoint.X + X * w + w - NewRTPoint.X else XO := 0;
  1829.     Cnvs.CopyRect(Rect(R.Left + NewLTPoint.X + X * w, R.Top,
  1830.                   R.Left + NewLTPoint.X + X * w + w - XO, R.Top + TOff),
  1831.              Picture.Canvas,
  1832.              Rect(SkinRect.Left + LTPoint.X, SkinRect.Top,
  1833.                   SkinRect.Left + RTPoint.X - XO, SkinRect.Top + TOff));
  1834.   end;
  1836.   w := RBPoint.X - LBPoint.X;
  1837.   XCnt := (NewRBPoint.X - NewLBPoint.X) div w;
  1838.   for X := 0 to XCnt do
  1839.   begin
  1840.     if NewLBPoint.X + X * w + w > NewRBPoint.X
  1841.     then XO := NewLBPoint.X + X * w + w - NewRBPoint.X else XO := 0;
  1842.     Cnvs.CopyRect(Rect(R.Left + NewLBPoint.X + X * w, R.Bottom - BOff,
  1843.                   R.Left + NewLBPoint.X + X * w + w - XO, R.Bottom),
  1844.              Picture.Canvas,
  1845.              Rect(SkinRect.Left + LBPoint.X, SkinRect.Bottom - BOff,
  1846.                   SkinRect.Left + RBPoint.X - XO, SkinRect.Bottom));
  1847.   end;
  1849.   w := LOff;
  1850.   h := LBPoint.Y - LTPoint.Y;
  1851.   YCnt := (NewLBPoint.Y - NewLTPoint.Y) div h;
  1852.   for Y := 0 to YCnt do
  1853.   begin
  1854.     if NewLTPoint.Y + Y * h + h > NewLBPoint.Y
  1855.     then YO := NewLTPoint.Y + Y * h + h - NewLBPoint.Y else YO := 0;
  1856.     Cnvs.CopyRect(Rect(R.Left, R.Top + NewLTPoint.Y + Y * h,
  1857.                        R.Left + w, R.Top + NewLTPoint.Y + Y * h + h - YO),
  1858.                   Picture.Canvas,
  1859.                   Rect(SkinRect.Left, SkinRect.Top + LTPoint.Y,
  1860.                        SkinRect.Left + w, SkinRect.Top + LBPoint.Y - YO));
  1861.   end;
  1862.   w := ROff;
  1863.   h := RBPoint.Y - RTPoint.Y;
  1864.   YCnt := (NewRBPoint.Y - NewRTPoint.Y) div h;
  1865.   for Y := 0 to YCnt do
  1866.   begin
  1867.     if NewRTPoint.Y + Y * h + h > NewRBPoint.Y
  1868.     then YO := NewRTPoint.Y + Y * h + h - NewRBPoint.Y else YO := 0;
  1869.     Cnvs.CopyRect(Rect(R.Right - w, R.Top + NewRTPoint.Y + Y * h,
  1870.                        R.Right, R.Top + NewRTPoint.Y + Y * h + h - YO),
  1871.                   Picture.Canvas,
  1872.                   Rect(SkinRect.Right - w, SkinRect.Top + RTPoint.Y,
  1873.                        SkinRect.Right, SkinRect.Top + RBPoint.Y - YO));
  1874.   end;
  1875.     // draw corners
  1876.   Cnvs.CopyRect(Rect(R.Left, R.Top, R.Left + LTPoint.X, R.Top + LTPoint.Y),
  1877.                 Picture.Canvas,
  1878.                 Rect(SkinRect.Left, SkinRect.Top,
  1879.                      SkinRect.Left + NewLTPoint.X, SkinRect.Top + NewLTPoint.Y));
  1880.   Cnvs.CopyRect(Rect(R.Left + NewRTPoint.X, R.Top,
  1881.                      R.Right, R.Top + NewRTPoint.Y),
  1882.                 Picture.Canvas,
  1883.                 Rect(SkinRect.Left + RTPoint.X, SkinRect.Top,
  1884.                      SkinRect.Right, SkinRect.Top + RTPoint.Y));
  1885.   Cnvs.CopyRect(Rect(R.Left, R.Top + NewLBPoint.Y,
  1886.                      R.Left + NewLBPoint.X, R.Bottom),
  1887.                 Picture.Canvas,
  1888.                 Rect(SkinRect.Left, SkinRect.Top + LBPoint.Y,
  1889.                      SkinRect.Left + LBPoint.X, SkinRect.Bottom));
  1890.   Cnvs.CopyRect(Rect(R.Left + NewRBPoint.X, R.Top + NewRBPoint.Y,
  1891.                      R.Right, R.Bottom),
  1892.                 Picture.Canvas,
  1893.                 Rect(SkinRect.Left + RBPoint.X, SkinRect.Top + RBPoint.Y,
  1894.                      SkinRect.Right, SkinRect.Bottom));
  1895. end;
  1897. procedure TbsSkinTabControl.Loaded;
  1898. begin
  1899.   inherited Loaded;
  1900.   if FIndex = -1
  1901.   then
  1902.     begin
  1903.       SetItemSize(0, FDefaultItemHeight);
  1904.       Change;
  1905.       ReAlign;
  1906.     end;
  1907. end;
  1909. procedure TbsSkinTabControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
  1910. begin
  1911.   Msg.Result := 1;
  1912. end;
  1914. procedure TbsSkinTabControl.WndProc(var Message:TMessage);
  1915. var
  1916.   TOff, LOff, Roff, BOff: Integer;
  1917. begin
  1918.   if Message.Msg = TCM_ADJUSTRECT
  1919.   then
  1920.     begin
  1921.       inherited WndProc(Message);
  1922.       TOff := 0;
  1923.       LOff := 0;
  1924.       ROff := 0;
  1925.       BOff := 0;
  1926.       if (FIndex <> -1) and (BGPictureIndex = -1)
  1927.       then
  1928.         begin
  1929.           TOff := ClRect.Top;
  1930.           LOff := ClRect.Left;
  1931.           ROff := RectWidth(SkinRect) - ClRect.Right;
  1932.           BOff := RectHeight(SkinRect) - ClRect.Bottom;
  1933.         end;
  1934.       case TabPosition of
  1935.         tpLeft:
  1936.            if FIndex <> -1
  1937.            then
  1938.              begin
  1939.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + LOff - 4;
  1940.                PRect(Message.LParam)^.Right := ClientWidth - ROff;
  1941.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1942.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  1943.              end
  1944.            else
  1945.              begin
  1946.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
  1947.                PRect(Message.LParam)^.Right := ClientWidth - 1;
  1948.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  1949.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1950.              end;
  1951.         tpRight:
  1952.            if FIndex <> -1
  1953.            then
  1954.              begin
  1955.                PRect(Message.LParam)^.Left := LOff;
  1956.                PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - ROff + 4;
  1957.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1958.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  1959.              end
  1960.            else
  1961.              begin
  1962.                PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
  1963.                PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 3;
  1964.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  1965.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1966.              end;
  1967.         tpTop:
  1968.            if FIndex <> -1
  1969.            then
  1970.              begin
  1971.                PRect(Message.LParam)^.Left := LOff;
  1972.                PRect(Message.LParam)^.Right := ClientWidth - ROff;
  1973.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1974.                PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
  1975.              end
  1976.            else
  1977.              begin
  1978.                PRect(Message.LParam)^.Left := 1;
  1979.                PRect(Message.LParam)^.Right := ClientWidth - 1;
  1980.                PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
  1981.                PRect(Message.LParam)^.Bottom := ClientHeight - 1;
  1982.              end;
  1983.         tpBottom:
  1984.           if FIndex <> -1
  1985.           then
  1986.             begin
  1987.               PRect(Message.LParam)^.Left := LOff;
  1988.               PRect(Message.LParam)^.Right := ClientWidth - ROff;
  1989.               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
  1990.               PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 4 - BOff;
  1991.             end
  1992.           else
  1993.             begin
  1994.               PRect(Message.LParam)^.Left := 1;
  1995.               PRect(Message.LParam)^.Right := ClientWidth - 1;
  1996.               PRect(Message.LParam)^.Top := 1;
  1997.               PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 3;
  1998.             end;
  2000.       end;
  2001.     end
  2002.   else
  2003.     if Message.Msg = TCM_GETITEMRECT
  2004.     then
  2005.       begin
  2006.         inherited WndProc(Message);
  2007.         if Style = tsTabs
  2008.         then
  2009.           case TabPosition of
  2010.             tpLeft:
  2011.                 begin
  2012.                   PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  2013.                   PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  2014.                 end;
  2015.             tpRight:
  2016.                 begin
  2017.                   PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + 2;
  2018.                   PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 2;
  2019.                 end;
  2021.             tpTop:
  2022.                 begin
  2023.                   if not MultiLine
  2024.                   then
  2025.                     begin
  2026.                       PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  2027.                       PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  2028.                     end;
  2029.                   PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
  2030.                   PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom - 2;
  2031.                 end;
  2032.             tpBottom:
  2033.                 begin
  2034.                   if not MultiLine
  2035.                   then
  2036.                     begin
  2037.                       PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
  2038.                       PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
  2039.                     end;
  2040.                   PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top + 2;
  2041.                   PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
  2042.                 end;
  2043.           end;
  2044.       end
  2045.   else
  2046.   inherited WndProc(Message);
  2047.   if (Message.Msg = WM_SIZE) and (not MultiLine)
  2048.   then
  2049.     begin
  2050.       CheckScroll;
  2051.     end;
  2052. end;
  2054. function TbsSkinTabControl.GetItemRect(index: integer): TRect;
  2055. var
  2056.   R: TRect;
  2057. begin
  2058.   SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  2059.   Result := R;
  2060. end;
  2062. procedure TbsSkinTabControl.SetItemSize;
  2063. begin
  2064.   SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
  2065. end;
  2067. procedure TbsSkinTabControl.PaintWindow(DC: HDC);
  2068. var
  2069.   SaveIndex: Integer;
  2070.   RealPicture: TBitMap;
  2071. begin
  2072.   GetSkinData;
  2073.   SaveIndex := SaveDC(DC);
  2074.   try
  2075.     RealPicture := TBitMap.Create;
  2076.     Canvas.Handle := DC;
  2077.     RealPicture.Width := Width;
  2078.     RealPicture.Height := Height;
  2079.     if FIndex = -1
  2080.     then
  2081.       PaintDefaultWindow(RealPicture.Canvas)
  2082.     else
  2083.       PaintSkinWindow(RealPicture.Canvas);
  2084.     DrawTabs(RealPicture.Canvas);
  2085.     Canvas.Draw(0, 0, RealPicture);
  2086.     Canvas.Handle := 0;
  2087.     RealPicture.Free;
  2088.   finally
  2089.     RestoreDC(DC, SaveIndex);
  2090.   end;
  2091. end;
  2093. procedure TbsSkinTabControl.DrawTabs;
  2094. var
  2095.   i: integer;
  2096.   R: TRect;
  2097. begin
  2098.   for i := 0 to Tabs.Count-1 do
  2099.   begin
  2100.     R := GetItemRect(i);
  2101.     DrawTab(i, R, i = TabIndex, i = FActiveTab, Cnvs);
  2102.   end;
  2103. end;
  2105. procedure TbsSkinTabControl.UpDateTabs;
  2106. begin
  2107.   if FIndex <> -1
  2108.   then
  2109.     SetItemSize(0, RectHeight(TabRect))
  2110.   else
  2111.     SetItemSize(0, FDefaultItemHeight);
  2113.   if MultiLine and (FSkinUpDown <> nil)
  2114.   then
  2115.     HideSkinUpDown;
  2116.   ReAlign;
  2117. end;
  2119. procedure TbsSkinTabControl.DrawTab;
  2120. var
  2121.   R: TRect;
  2122.   S: String;
  2123.   TB: TBitMap;
  2124.   DrawGlyph: Boolean;
  2125.   W, H: Integer;
  2126. begin
  2127.   DrawGlyph := (Images <> nil) and (TI < Images.Count);
  2128.   S := Tabs[TI];
  2129.   TB := TBitMap.Create;
  2130.   if (TabPosition = tpTop) or (TabPosition = tpBottom)
  2131.   then
  2132.     begin
  2133.       W := RectWidth(Rct);
  2134.       H := RectHeight(Rct);
  2135.     end
  2136.   else
  2137.     begin
  2138.       H := RectWidth(Rct);
  2139.       W := RectHeight(Rct);
  2140.     end;
  2141.   R := Rect(0, 0, W, H);  
  2142.   if FIndex <> -1
  2143.   then
  2144.     begin
  2145.       if MouseIn and not Active and not IsNullRect(MouseInTabRect)
  2146.       then
  2147.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  2148.           TB, Picture, MouseInTabRect, W, H)
  2149.       else
  2150.       if Active and Focused
  2151.       then
  2152.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  2153.           TB, Picture, FocusTabRect, W, H)
  2154.       else
  2155.       if Active
  2156.       then
  2157.          CreateHSkinImage(TabLeftOffset, TabRightOffset,
  2158.           TB, Picture, ActiveTabRect, W, H)
  2159.       else
  2160.         CreateHSkinImage(TabLeftOffset, TabRightOffset,
  2161.           TB, Picture, TabRect, W, H);
  2162.       with TB.Canvas do
  2163.       begin
  2164.         Brush.Style := bsClear;
  2165.         if FUseSkinFont
  2166.         then
  2167.           begin
  2168.             Font.Name := FontName;
  2169.             Font.Style := FontStyle;
  2170.             Font.Height := FontHeight;
  2171.             Font.CharSet := Self.Font.CharSet;
  2172.           end
  2173.         else
  2174.            Font.Assign(Self.Font);
  2175.         if MouseIn and not Active
  2176.         then
  2177.           Font.Color := MouseInFontColor
  2178.         else
  2179.         if Active and Focused
  2180.         then
  2181.           Font.Color := FocusFontColor
  2182.         else
  2183.           if Active
  2184.           then Font.Color := ActiveFontColor
  2185.           else Font.Color := FontColor;
  2186.       end;
  2187.     end
  2188.   else
  2189.     begin
  2190.       TB.Width := W;
  2191.       TB.Height := H;
  2192.       if MouseIn and not Active
  2193.       then
  2194.         begin
  2195.           TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
  2196.           TB.Canvas.FillRect(R);
  2197.         end
  2198.       else
  2199.       if Active and Focused
  2200.       then
  2201.         begin
  2202.           Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
  2203.           TB.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
  2204.           TB.Canvas.FillRect(R);
  2205.         end
  2206.       else
  2207.       if Active
  2208.       then
  2209.         begin
  2210.           Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
  2211.           TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
  2212.           TB.Canvas.FillRect(R);
  2213.         end
  2214.       else
  2215.         begin
  2216.           TB.Canvas.Brush.Color := clBtnFace;
  2217.           TB.Canvas.FillRect(R);
  2218.         end;
  2219.       with TB.Canvas do
  2220.       begin
  2221.         Brush.Style := bsClear;
  2222.         Font.Assign(Self.Font);
  2223.       end;
  2224.     end;
  2225.   //
  2226.   if DrawGlyph
  2227.   then
  2228.     DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
  2229.                         Images, TI, True)
  2230.   else
  2231.     DrawText(TB.Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  2232.   if TabPosition = tpLeft
  2233.   then
  2234.     DrawRotate90_1(Cnvs, TB, Rct.Left, Rct.Top)
  2235.   else
  2236.   if TabPosition = tpRight
  2237.   then
  2238.     DrawRotate90_2(Cnvs, TB, Rct.Left, Rct.Top)
  2239.   else
  2240.     Cnvs.Draw(Rct.Left, Rct.Top, TB);
  2241.   TB.Free;
  2242. end;
  2245. end.