home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / TABCTRLS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-17  |  101KB  |  3,314 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit TabCtrls;
  11.  
  12. Interface
  13.  
  14. Uses SysUtils,Classes,Forms,Buttons,StdCtrls,ExtCtrls,Dialogs;
  15.  
  16. Type
  17.     {$M+}
  18.     TTabStyle=(tsStandard,tsOwnerDraw);
  19.  
  20.     TTabAlignment=(taBottom,taTop);
  21.     {$M-}
  22.  
  23.     TTabSet=Class;
  24.  
  25.     TTabChangeEvent=Procedure(Sender:TObject;NewTab:LongInt;
  26.          Var AllowChange:Boolean) Of Object;
  27.     TMeasureTabEvent=Procedure(Sender:TObject;Index:LongInt;
  28.          Var TabSize:LongInt) Of Object;
  29.     TDrawTabEvent=Procedure(Sender:TObject;TabCanvas:TCanvas;rec:TRect;
  30.          Index:LongInt;Selected:Boolean) Of Object;
  31.  
  32.     TTabSet=Class(TControl)
  33.       Private
  34.          FTabs:TStrings;
  35.          FTabPositions:TList;
  36.          FTabStyle:TTabStyle;
  37.          FTabIndex:LongInt;
  38.          FTabHeight:LongInt;
  39.          FFirstIndex:LongInt;
  40.          FLastIndex:LongInt;
  41.          FAutoScroll:Boolean;
  42.          FAlignment:TTabAlignment;
  43.          FSelectedColor:TColor;
  44.          FUnSelectedColor:TColor;
  45.          FDitherBackground:Boolean;
  46.          FStartMargin:LongInt;
  47.          FEndMargin:LongInt;
  48.          FVisibleTabs:LongInt;
  49.          FLeftScroll:TSpeedButton;
  50.          FRightScroll:TSpeedButton;
  51.          FTabFocus:LongInt;
  52.          FOnClick:TNotifyEvent;
  53.          FOnChange:TTabChangeEvent;
  54.          FOnMeasureTab:TMeasureTabEvent;
  55.          FOnDrawTab:TDrawTabEvent;
  56.          Procedure SetTabs(Value:TStrings);
  57.          Procedure SetTabStyle(Value:TTabStyle);
  58.          Procedure SetTabIndex(Value:LongInt);
  59.          Procedure SetTabHeight(Value:LongInt);
  60.          Procedure SetFirstIndex(Value:LongInt);
  61.          Procedure SetAutoScroll(Value:Boolean);
  62.          Procedure SetAlignment(Value:TTabAlignment);
  63.          Procedure SetSelectedColor(Value:TColor);
  64.          Procedure SetUnselectedColor(Value:TColor);
  65.          Procedure SetDitherBackground(Value:Boolean);
  66.          Procedure SetStartMargin(Value:LongInt);
  67.          Procedure SetEndMargin(Value:LongInt);
  68.          Procedure ArrangeTabs;
  69.          Procedure SetButtons;
  70.          Procedure UpdateButtons;
  71.          Procedure EvScroll(Sender:TObject);
  72.          Procedure EvTabsChange(Sender:TObject);
  73.       Protected
  74.          Procedure SetupComponent;Override;
  75.          Procedure SetupShow;Override;
  76.          Procedure Resize;Override;
  77.          Procedure FontChange;Override;
  78.          Procedure SetFocus;Override;
  79.          Procedure KillFocus;Override;
  80.          Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
  81.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
  82.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  83.          Function CanChange(NewIndex:LongInt):Boolean;Virtual;
  84.          Function GetTabColor(Index:LongInt):TColor;Virtual;
  85.          Procedure MeasureTab(Index:LongInt;Var TabSize:LongInt);Virtual;
  86.          Procedure DrawTab(TabCanvas:TCanvas;rec:TRect;Index:LongInt;
  87.                            Selected:Boolean);Virtual;
  88.          Procedure RedrawBottom(Const rec:TRect);Virtual;
  89.          Procedure RedrawTop(Const rec:TRect);Virtual;
  90.       Public
  91.          Destructor Destroy;Override;
  92.          Procedure Redraw(Const rec:TRect);Override;
  93.          Procedure Click;
  94.          Procedure SelectNext(Direction:Boolean);
  95.          Function ItemAtPos(Pos:TPoint):LongInt;
  96.          Function ItemRect(Item:LongInt):TRect;
  97.          Procedure GetChildren(Proc:TGetChildProc);Override;
  98.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  99.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  100.          Property VisibleTabs:LongInt Read FVisibleTabs;
  101.          Property XAlign;
  102.          Property XStretch;
  103.          Property YAlign;
  104.          Property YStretch;
  105.       Published
  106.          Property Align;
  107.          Property Alignment:TTabAlignment Read FAlignment Write SetAlignment;
  108.          Property AutoScroll:Boolean Read FAutoScroll Write SetAutoScroll;
  109.          Property Color;
  110.          Property DitherBackground:Boolean Read FDitherBackground Write SetDitherBackground;
  111.          Property DragCursor;
  112.          Property DragMode;
  113.          Property Enabled;
  114.          Property EndMargin:LongInt Read FEndMargin Write SetEndMargin;
  115.          Property FirstIndex:LongInt Read FFirstIndex Write SetFirstIndex;
  116.          Property Font;
  117.          Property ParentFont;
  118.          Property ParentShowHint;
  119.          Property ParentColor;
  120.          Property ParentPenColor;
  121.          Property PenColor;
  122.          Property SelectedColor:TColor Read FSelectedColor Write SetSelectedColor;
  123.          Property ShowHint;
  124.          Property StartMargin:LongInt Read FStartMargin Write SetStartMargin;
  125.          Property TabHeight:LongInt Read FTabHeight Write SetTabHeight;
  126.          Property TabIndex:LongInt Read FTabIndex Write SetTabIndex;
  127.          Property Tabs:TStrings Read FTabs Write SetTabs;
  128.          Property TabStop;
  129.          Property TabStyle:TTabStyle Read FTabStyle Write SetTabStyle;
  130.          Property UnselectedColor:TColor Read FUnSelectedColor Write SetUnselectedColor;
  131.          Property Visible;
  132.          Property ZOrder;
  133.  
  134.          Property OnCanDrag;
  135.          Property OnChange:TTabChangeEvent Read FOnChange Write FOnChange;
  136.          Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
  137.          Property OnDragDrop;
  138.          Property OnDragOver;
  139.          Property OnDrawTab:TDrawTabEvent Read FOnDrawTab Write FOnDrawTab;
  140.          Property OnEndDrag;
  141.          Property OnEnter;
  142.          Property OnExit;
  143.          Property OnFontChange;
  144.          Property OnMeasureTab:TMeasureTabEvent Read FOnMeasureTab Write FOnMeasureTab;
  145.          Property OnSetupShow;
  146.          Property OnStartDrag;
  147.     End;
  148.  
  149.  
  150.     TPage=Class(TControl)
  151.       Private
  152.          SubCount:LongInt;
  153.          SubIndex:LongInt;
  154.          MainIndex:LongInt;
  155.          PopupEntry:TMenuItem;
  156.          FIsSubPage:Boolean;
  157.       Protected
  158.          Procedure SetupComponent;Override;
  159.          Procedure CreateWnd;Override;
  160.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  161.          Procedure Paint(Const rec:TRect);Override;
  162.          Property OnMouseClick;
  163.          Property OnMouseDblClick;
  164.          Property OnMouseDown;
  165.          Property OnMouseUp;
  166.          Property OnMouseMove;
  167.       Public
  168.          Procedure BringToFront;Override;
  169.          Property IsSubPage:Boolean Read FIsSubPage;
  170.          Property Color;
  171.          Property PenColor;
  172.          Property DragCursor;
  173.          Property DragMode;
  174.          Property Enabled;
  175.          Property Font;
  176.          Property ParentColor;
  177.          Property ParentPenColor;
  178.          Property ParentFont;
  179.          Property ParentShowHint;
  180.          Property ShowHint;
  181.  
  182.          Property OnCommand;
  183.          Property OnDragDrop;
  184.          Property OnDragOver;
  185.          Property OnEndDrag;
  186.          Property OnEnter;
  187.          Property OnExit;
  188.          Property OnFontChange;
  189.          Property OnPaint;
  190.          Property OnResize;
  191.          Property OnSetupShow;
  192.       Published
  193.          Property Caption;
  194.          Property Hint;
  195.     End;
  196.  
  197.  
  198.     TTabPage=Class(TPage)
  199.     End;
  200.  
  201.  
  202.     TTabSheet=Class(TPage)
  203.     End;
  204.  
  205.  
  206.     TNoteBook=Class;
  207.  
  208.     TPageAccess=Class(TStrings)
  209.       Private
  210.          FPages:TList;
  211.          FNotebook:TNoteBook;
  212.          FOnChange:TNotifyEvent;
  213.       Private
  214.          Function GetPage(Index:LongInt):TPage;
  215.       Protected
  216.          Function GetCount: LongInt; Override;
  217.          Function Get(Index: LongInt): String; Override;
  218.          Procedure Put(Index: LongInt; Const S: String); Override;
  219.          Function GetObject(Index: LongInt): TObject; Override;
  220.       Public
  221.          Procedure Clear; Override;
  222.          Procedure Delete(Index: LongInt); Override;
  223.          Procedure Insert(Index: LongInt; Const S: String); Override;
  224.          Procedure Move(CurIndex, NewIndex: LongInt); Override;
  225.          Property Pages[Index:LongInt]:TPage Read GetPage;
  226.          Property NoteBook:TNoteBook Read FNotebook;
  227.          Property OnChange:TNotifyEvent Read FOnChange;
  228.     End;
  229.  
  230.  
  231.     TNoteBook=Class(TControl)
  232.       Private
  233.          FPages:TList;
  234.          FAccess:TPageAccess;
  235.          FPageIndex:LongInt;
  236.          FOnPageChanged:TNotifyEvent;
  237.          Function GetActivePage:String;
  238.          Procedure SetActivePage(Const Value:String);
  239.          Procedure SetPageIndex(Value:LongInt);
  240.          Procedure SetPages(Value:TPageAccess);
  241.       Protected
  242.          Procedure SetupComponent;Override;
  243.          Procedure SetupShow;Override;
  244.          Procedure GetChildren(Proc:TGetChildProc);Override;
  245.          Procedure LoadingFromSCU(SCUParent:TComponent);Override;
  246.       Public
  247.          Destructor Destroy;Override;
  248.          Procedure GetDesignerPopupEvents(AString:TStringList);Override;
  249.          Procedure DesignerPopupEvent(Id:LongInt);Override;
  250.          Property XAlign;
  251.          Property XStretch;
  252.          Property YAlign;
  253.          Property YStretch;
  254.       Published
  255.          Property ActivePage:String Read GetActivePage Write SetActivePage; stored False;
  256.          Property Align;
  257.          Property Color;
  258.          Property PenColor;
  259.          Property DragCursor;
  260.          Property DragMode;
  261.          Property Enabled;
  262.          Property Font;
  263.          Property PageIndex:LongInt Read FPageIndex Write SetPageIndex;
  264.          Property Pages:TPageAccess Read FAccess Write SetPages;
  265.          Property ParentColor;
  266.          Property ParentPenColor;
  267.          Property ParentFont;
  268.          Property ParentShowHint;
  269.          Property PopupMenu;
  270.          Property ShowHint;
  271.          Property TabOrder;
  272.          Property TabStop;
  273.          Property Visible;
  274.          Property ZOrder;
  275.  
  276.          Property OnCanDrag;
  277.          Property OnDblClick;
  278.          Property OnDragDrop;
  279.          Property OnDragOver;
  280.          Property OnEndDrag;
  281.          Property OnEnter;
  282.          Property OnExit;
  283.          Property OnFontChange;
  284.          Property OnMouseClick;
  285.          Property OnMouseDblClick;
  286.          Property OnMouseDown;
  287.          Property OnMouseMove;
  288.          Property OnMouseUp;
  289.          Property OnPageChanged:TNotifyEvent Read FOnPageChanged Write FOnPageChanged;
  290.          Property OnSetupShow;
  291.          Property OnStartDrag;
  292.     End;
  293.  
  294.  
  295.     {$M+}
  296.     TTabbedNotebookStyle=(nsDefault,nsWarp4,nsWin32);
  297.     {$M-}
  298.  
  299.     TTabbedNotebook=Class(TControl)
  300.       Private
  301.          FTabSet:TTabSet;
  302.          FNotebook:TNoteBook;
  303.          FPageHint:TLabel;
  304.          FPageCount:TLabel;
  305.          FEdge:TImage;
  306.          FAutoPopup:Boolean;
  307.          FStyle:TTabbedNotebookStyle;
  308.          FColorTabs:Boolean;
  309.          FShowPageHint:Boolean;
  310.          FRectangleTabs:Boolean;
  311.          EdgeDraggingMinus:Boolean;
  312.          EdgeDraggingPlus:Boolean;
  313.          LastEdgeBmpId:String[30];
  314.          IgnoreTabClick:Boolean;
  315.          PagesPopup:TPopupMenu;
  316.          FOnPageChanged:TNotifyEvent;
  317.          Function GetActivePage:String;
  318.          Procedure SetActivePage(Value:String);
  319.          Function GetPageIndex:LongInt;
  320.          Procedure SetPageIndex(Value:LongInt);
  321.          Function GetPages:TPageAccess;
  322.          Procedure SetPages(Value:TPageAccess);
  323.          Function GetTabFont:TFont;
  324.          Procedure SetTabFont(Value:TFont);
  325.          Function GetTabAlignment:TTabAlignment;
  326.          Procedure SetTabAlignment(Value:TTabAlignment);
  327.          Procedure SetStyle(Value:TTabbedNotebookStyle);
  328.          Procedure SetColorTabs(Value:Boolean);
  329.          Procedure SetShowPageHint(Value:Boolean);
  330.          Procedure SetRectangleTabs(Value:Boolean);
  331.          Function GetTabHeight:LongInt;
  332.          Procedure SetTabHeight(Value:LongInt);
  333.          Function GetPageHint:String;
  334.          Procedure SetPageHint(Const Value:String);
  335.          Function GetPageRect:TRect;
  336.          Procedure LoadEdge;
  337.          Procedure ArrangeSubPages;
  338.          Function Tab2Page(TabIdx:LongInt):LongInt;
  339.          Function Page2Tab(PageIdx:LongInt):LongInt;
  340.          Procedure EvTabSetClicked(Sender:TObject);
  341.          Procedure EvPageIndexChanged(Sender:TObject);
  342.          Procedure EvPageAccessChanged(Sender:TObject);
  343.          Procedure EvCanChange(Sender:TObject;NewTab:LongInt;Var AllowChange:Boolean);
  344.          Procedure EvMeasureTab(Sender:TObject;Index:LongInt;Var TabSize:LongInt);
  345.          Procedure EvDrawTab(Sender:TObject;TabCanvas:TCanvas;rec:TRect;Index:LongInt;Selected:Boolean);
  346.          Function SignFromPos(X,Y:LongInt):Boolean;
  347.          Procedure EvEdgeMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:LongInt);
  348.          Procedure EvEdgeMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:LongInt);
  349.          Procedure EvMouseClick(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  350.          Procedure EvPopupClicked(Sender:TObject);
  351.          Procedure EvQueryTabColor(Sender:TObject;Index:LongInt;Var TabColor:TColor);
  352.       Protected
  353.          Procedure SetupComponent;Override;
  354.          Procedure SetupShow;Override;
  355.          Procedure FontChange;Override;
  356.          Procedure Resize;Override;
  357.          Procedure GetChildren(Proc:TGetChildProc);Override;
  358.          Procedure LoadingFromSCU(SCUParent:TComponent);Override;
  359.          Procedure LoadedFromSCU(SCUParent:TComponent);Override;
  360.          Function EvaluateShortCut(KeyCode:TKeyCode):Boolean;Override;
  361.       Public
  362.          Procedure Redraw(Const rec:TRect);Override;
  363.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  364.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  365.          Procedure GetDesignerPopupEvents(AString:TStringList);Override;
  366.          Procedure DesignerPopupEvent(Id:LongInt);Override;
  367.          Property ColorTabs:Boolean Read FColorTabs Write SetColorTabs;
  368.          Property ShowPageHint:Boolean Read FShowPageHint Write SetShowPageHint;
  369.          Property RectangleTabs:Boolean Read FRectangleTabs Write SetRectangleTabs;
  370.          Property PageHint:String Read GetPageHint Write SetPageHint;
  371.          Property PageRect:TRect Read GetPageRect;
  372.          Property XAlign;
  373.          Property XStretch;
  374.          Property YAlign;
  375.          Property YStretch;
  376.       Published
  377.          Property ActivePage:String Read GetActivePage Write SetActivePage; stored False;
  378.          Property Align;
  379.          Property AutoPopup:Boolean Read FAutoPopup Write FAutoPopup;
  380.          Property Color;
  381.          Property PenColor;
  382.          Property DragCursor;
  383.          Property DragMode;
  384.          Property Enabled;
  385.          Property Font;
  386.          Property PageIndex:LongInt Read GetPageIndex Write SetPageIndex;
  387.          Property Pages:TPageAccess Read GetPages Write SetPages;
  388.          Property ParentColor;
  389.          Property ParentPenColor;
  390.          Property ParentFont;
  391.          Property ParentShowHint;
  392.          Property ShowHint;
  393.          Property Style:TTabbedNotebookStyle Read FStyle Write SetStyle;
  394.          Property TabAlignment:TTabAlignment Read GetTabAlignment Write SetTabAlignment;
  395.          Property TabFont:TFont Read GetTabFont Write SetTabFont;
  396.          Property TabHeight:LongInt Read GetTabHeight Write SetTabHeight;
  397.          Property TabOrder;
  398.          Property TabStop;
  399.          Property Visible;
  400.          Property ZOrder;
  401.  
  402.          Property OnCanDrag;
  403.          Property OnDragDrop;
  404.          Property OnDragOver;
  405.          Property OnEndDrag;
  406.          Property OnEnter;
  407.          Property OnExit;
  408.          Property OnFontChange;
  409.          Property OnMouseMove;
  410.          Property OnPageChanged:TNotifyEvent Read FOnPageChanged Write FOnPageChanged;
  411.          Property OnSetupShow;
  412.          Property OnStartDrag;
  413.     End;
  414.  
  415.  
  416.     TPageControl=Class(TTabbedNotebook)
  417.     End;
  418.  
  419.  
  420. Function InsertTabSet(parent:TControl;Left,Bottom,Width,Height:LongInt):TTabSet;
  421. Function InsertNotebook(parent:TControl;Left,Bottom,Width,Height:LongInt):TNoteBook;
  422. Function InsertTabbedNotebook(parent:TControl;Left,Bottom,Width,Height:LongInt):TTabbedNotebook;
  423.  
  424.  
  425. Implementation
  426.  
  427. {$IFDEF OS2}
  428. Uses PmGpi,PmWin;
  429. {$ENDIF}
  430.  
  431. {$IFDEF WIN32}
  432. Uses WinUser;
  433. {$ENDIF}
  434.  
  435. {$R TabCtrls}
  436.  
  437. Function InsertTabSet(parent:TControl;Left,Bottom,Width,Height:LongInt):TTabSet;
  438. Begin
  439.      Result.Create(parent);
  440.      Result.SetWindowPos(Left,Bottom,Width,Height);
  441.      Result.parent := parent;
  442. End;
  443.  
  444.  
  445. Function InsertNotebook(parent:TControl;Left,Bottom,Width,Height:LongInt):TNoteBook;
  446. Begin
  447.      Result.Create(parent);
  448.      Result.SetWindowPos(Left,Bottom,Width,Height);
  449.      Result.parent := parent;
  450. End;
  451.  
  452.  
  453. Function InsertTabbedNotebook(parent:TControl;Left,Bottom,Width,Height:LongInt):TTabbedNotebook;
  454. Begin
  455.      Result.Create(parent);
  456.      Result.SetWindowPos(Left,Bottom,Width,Height);
  457.      Result.parent := parent;
  458. End;
  459.  
  460.  
  461.  
  462. Type
  463.     TTabPos=Record
  464.          Size,Start:Word;
  465.     End;
  466.  
  467. Const
  468.     EdgeWidth=9;
  469.     TopMargin=2;
  470.     BottomMargin=2;
  471.     ScrollWidth=11;
  472.     ScrollHeight=15;
  473.  
  474. Type
  475.     TTabSetScroller=Class(TSpeedButton)
  476.       Private
  477.          FArrowLeft:Boolean;
  478.       Public
  479.          Procedure Redraw(Const rec:TRect);Override;
  480.     End;
  481.  
  482.  
  483. Procedure TTabSetScroller.Redraw(Const rec:TRect);
  484. Var  mpt:TPoint;
  485.      rc:TRect;
  486.      trial:Array[0..2] Of TPoint;
  487. Begin
  488.      Inherited Redraw(rec);
  489.  
  490.      mpt := Point(ScrollWidth Div 2, ScrollHeight Div 2);
  491.      If Down Then
  492.      Begin
  493.           Inc(mpt.X);
  494.           Dec(mpt.Y);
  495.      End;
  496.      rc := ClientRect;
  497.      Canvas.Pen.color := clBlack;
  498.      Canvas.Rectangle(rc);
  499.  
  500.      If Enabled Then Canvas.Pen.color := clBlack
  501.      Else Canvas.Pen.color := clDkGray;
  502.  
  503.      If FArrowLeft Then
  504.      Begin
  505.           trial[0].X := mpt.X - 3;
  506.           trial[0].Y := mpt.Y;
  507.           trial[1].X := mpt.X + 1;
  508.           trial[1].Y := mpt.Y - 4;
  509.           trial[2].X := mpt.X + 1;
  510.           trial[2].Y := mpt.Y + 4;
  511.      End
  512.      Else
  513.      Begin
  514.           trial[0].X := mpt.X + 2;
  515.           trial[0].Y := mpt.Y;
  516.           trial[1].X := mpt.X - 2;
  517.           trial[1].Y := mpt.Y - 4;
  518.           trial[2].X := mpt.X - 2;
  519.           trial[2].Y := mpt.Y + 4;
  520.      End;
  521.      Canvas.BeginPath;
  522.      Canvas.PolyLine(trial);
  523.      Canvas.EndPath;
  524.      Canvas.FillPath;
  525. End;
  526.  
  527.  
  528. {***************************************************************************}
  529.  
  530. Procedure TTabSet.SetupComponent;
  531. Begin
  532.      Inherited SetupComponent;
  533.  
  534.      Name := 'TabSet';
  535.      Ownerdraw := True;
  536.      Width := 185;
  537.      Height := 25;
  538.      ParentPenColor := True;
  539.      ParentColor := False;
  540.      Color := clDlgWindow;
  541.      TabStop := False;
  542.  
  543.      FTabs := TStringList.Create;
  544.      TStringList(FTabs).OnChange := EvTabsChange;
  545.      FTabPositions.Create;
  546.      FTabStyle := tsStandard;
  547.      FTabIndex := -1;
  548.      FFirstIndex := 0;
  549.      FLastIndex := 0;
  550.      FSelectedColor := clDlgWindow;
  551.      FUnSelectedColor := clWindow;
  552.      FDitherBackground := True;
  553.      FStartMargin := 5;
  554.      FEndMargin := 5;
  555.      FVisibleTabs := 0;
  556.      FTabHeight := 20;
  557.      FAutoScroll := True;
  558.      FAlignment := taBottom;
  559. End;
  560.  
  561.  
  562. Procedure TTabSet.SetupShow;
  563. Begin
  564.      Inherited SetupShow;
  565.  
  566.      ArrangeTabs;
  567. End;
  568.  
  569.  
  570. Destructor TTabSet.Destroy;
  571. Begin
  572.      TStringList(FTabs).OnChange := Nil;
  573.      FTabs.Destroy;
  574.      FTabs := Nil;
  575.      FTabPositions.Destroy;
  576.      FTabPositions := Nil;
  577.  
  578.      Inherited Destroy;
  579. End;
  580.  
  581.  
  582. Procedure TTabSet.Resize;
  583. Begin
  584.      Inherited Resize;
  585.  
  586.      ArrangeTabs;
  587. End;
  588.  
  589.  
  590. Procedure TTabSet.FontChange;
  591. Begin
  592.      ArrangeTabs;
  593.  
  594.      Inherited FontChange;
  595. End;
  596.  
  597. {$HINTS OFF}
  598. Procedure TTabSet.EvTabsChange(Sender:TObject);
  599. Begin
  600.      ArrangeTabs;
  601.      Invalidate;
  602. End;
  603. {$HINTS ON}
  604.  
  605. Procedure TTabSet.SetTabs(Value:TStrings);
  606. Begin
  607.      If Value <> FTabs Then FTabs.Assign(Value);
  608. End;
  609.  
  610.  
  611. Procedure TTabSet.SetTabStyle(Value:TTabStyle);
  612. Begin
  613.      If FTabStyle <> Value Then
  614.      Begin
  615.           FTabStyle := Value;
  616.           ArrangeTabs;
  617.           Invalidate;
  618.      End;
  619. End;
  620.  
  621.  
  622. Procedure TTabSet.SetSelectedColor(Value:TColor);
  623. Begin
  624.      If FSelectedColor <> Value Then
  625.      Begin
  626.           FSelectedColor := Value;
  627.           Invalidate;
  628.      End;
  629. End;
  630.  
  631.  
  632. Procedure TTabSet.SetUnselectedColor(Value:TColor);
  633. Begin
  634.      If FUnSelectedColor <> Value Then
  635.      Begin
  636.           FUnSelectedColor := Value;
  637.           Invalidate;
  638.      End;
  639. End;
  640.  
  641.  
  642. Procedure TTabSet.SetDitherBackground(Value:Boolean);
  643. Begin
  644.      If FDitherBackground <> Value Then
  645.      Begin
  646.           FDitherBackground := Value;
  647.           Invalidate;
  648.      End;
  649. End;
  650.  
  651.  
  652. Procedure TTabSet.SetStartMargin(Value:LongInt);
  653. Begin
  654.      If FStartMargin <> Value Then
  655.      Begin
  656.           FStartMargin := Value;
  657.           ArrangeTabs;
  658.           Invalidate;
  659.      End;
  660. End;
  661.  
  662.  
  663. Procedure TTabSet.SetEndMargin(Value:LongInt);
  664. Begin
  665.      If FEndMargin <> Value Then
  666.      Begin
  667.           FEndMargin := Value;
  668.           ArrangeTabs;
  669.           Invalidate;
  670.      End;
  671. End;
  672.  
  673.  
  674. Procedure TTabSet.SetTabIndex(Value:LongInt);
  675. Begin
  676.      FTabFocus := Value;
  677.  
  678.      If ComponentState * [csReading] <> [] Then
  679.      Begin
  680.           FTabIndex := Value;
  681.           Exit;
  682.      End;
  683.  
  684.      If (Value < 0) Or (Value >= FTabs.Count) Then Exit;
  685.      If FTabIndex <> Value Then
  686.        If CanChange(Value) Then
  687.        Begin
  688.             FTabIndex := Value;
  689.             ArrangeTabs;
  690.             Invalidate;
  691.             Click;
  692.        End;
  693. End;
  694.  
  695.  
  696. Procedure TTabSet.SetTabHeight(Value:LongInt);
  697. Begin
  698.      If FTabHeight <> Value Then
  699.      Begin
  700.           FTabHeight := Value;
  701.           If FTabStyle = tsOwnerDraw Then Invalidate;
  702.      End;
  703. End;
  704.  
  705.  
  706. Procedure TTabSet.SetFirstIndex(Value:LongInt);
  707. Begin
  708.      If ComponentState * [csReading] <> [] Then
  709.      Begin
  710.           FFirstIndex := Value;
  711.           Exit;
  712.      End;
  713.  
  714.      If (Value < 0) Or (Value >= FTabs.Count) Then Exit;
  715.      If FFirstIndex <> Value Then
  716.      Begin
  717.           FFirstIndex := Value;
  718.           ArrangeTabs;
  719.           Invalidate;
  720.      End;
  721. End;
  722.  
  723.  
  724. Procedure TTabSet.SetAutoScroll(Value:Boolean);
  725. Begin
  726.      If FAutoScroll <> Value Then
  727.      Begin
  728.           FAutoScroll := Value;
  729.           SetButtons;
  730.           Invalidate;
  731.      End;
  732. End;
  733.  
  734.  
  735. Procedure TTabSet.SetAlignment(Value:TTabAlignment);
  736. Begin
  737.      If FAlignment <> Value Then
  738.      Begin
  739.           FAlignment := Value;
  740.           ArrangeTabs;
  741.           SetButtons;
  742.           Invalidate;
  743.      End;
  744. End;
  745.  
  746.  
  747. Procedure TTabSet.SetButtons;
  748. Begin
  749.      If FAutoScroll And (FVisibleTabs < FTabs.Count) Then
  750.      Begin
  751.           If FLeftScroll = Nil Then
  752.           Begin
  753.                FLeftScroll := TTabSetScroller.Create(Self);
  754.                Include(FLeftScroll.ComponentState, csDetail);
  755.                FLeftScroll.Visible := False;
  756.                InsertControl(FLeftScroll);
  757.                FLeftScroll.OnClick := EvScroll;
  758.                TTabSetScroller(FLeftScroll).FArrowLeft := True;
  759.           End;
  760.           If FAlignment = taBottom
  761.           Then FLeftScroll.SetBounds(Width-2*ScrollWidth, TopMargin+1,
  762.                                      ScrollWidth, ScrollHeight)
  763.           Else FLeftScroll.SetWindowPos(Width-2*ScrollWidth, BottomMargin+1,
  764.                                         ScrollWidth, ScrollHeight);
  765.           FLeftScroll.SetDesigning(False);
  766.  
  767.           If FRightScroll = Nil Then
  768.           Begin
  769.                FRightScroll := TTabSetScroller.Create(Self);
  770.                Include(FRightScroll.ComponentState, csDetail);
  771.                FRightScroll.Visible := False;
  772.                InsertControl(FRightScroll);
  773.                FRightScroll.OnClick := EvScroll;
  774.                TTabSetScroller(FRightScroll).FArrowLeft := False;
  775.           End;
  776.           If FAlignment = taBottom
  777.           Then FRightScroll.SetBounds(Width-ScrollWidth-1, TopMargin+1,
  778.                                       ScrollWidth, ScrollHeight)
  779.           Else FRightScroll.SetWindowPos(Width-ScrollWidth-1, BottomMargin+1,
  780.                                          ScrollWidth, ScrollHeight);
  781.           FRightScroll.SetDesigning(False);
  782.           UpdateButtons;
  783.      End
  784.      Else
  785.      Begin
  786.           If FLeftScroll <> Nil Then FLeftScroll.Destroy;
  787.           FLeftScroll := Nil;
  788.           If FRightScroll <> Nil Then FRightScroll.Destroy;
  789.           FRightScroll := Nil;
  790.      End;
  791. End;
  792.  
  793.  
  794. Procedure TTabSet.UpdateButtons;
  795. Begin
  796.      If FLeftScroll <> Nil Then
  797.      Begin
  798.           FLeftScroll.Enabled := FFirstIndex > 0;
  799.           FLeftScroll.Visible := True;
  800.      End;
  801.      If FRightScroll <> Nil Then
  802.      Begin
  803.           FRightScroll.Enabled := FFirstIndex + FVisibleTabs < FTabs.Count;
  804.           FRightScroll.Visible := True;
  805.      End;
  806. End;
  807.  
  808.  
  809. Procedure TTabSet.EvScroll(Sender:TObject);
  810. Begin
  811.      If Sender = FLeftScroll Then SetFirstIndex(FFirstIndex - 1);
  812.      If Sender = FRightScroll Then SetFirstIndex(FFirstIndex + 1);
  813. End;
  814.  
  815.  
  816. Procedure TTabSet.Click;
  817. Begin
  818.      If FOnClick <> Nil Then FOnClick(Self); {switch the NoteBook page}
  819. End;
  820.  
  821.  
  822. Function TTabSet.CanChange(NewIndex:LongInt):Boolean;
  823. Begin
  824.      Result := True;
  825.      If FOnChange <> Nil Then FOnChange(Self,NewIndex,Result);
  826. End;
  827.  
  828.  
  829. Function TTabSet.GetTabColor(Index:LongInt):TColor;
  830. Begin
  831.      If Index = FTabIndex Then Result := FSelectedColor
  832.      Else Result := FUnSelectedColor;
  833. End;
  834.  
  835.  
  836. {initialisiert mit Textbreite}
  837. Procedure TTabSet.MeasureTab(Index:LongInt;Var TabSize:LongInt); {Width Or Height}
  838. Begin
  839.      If FOnMeasureTab <> Nil Then FOnMeasureTab(Self,Index,TabSize);
  840. End;
  841.  
  842.  
  843. {zeichne TabInhalt}
  844. Procedure TTabSet.DrawTab(TabCanvas:TCanvas;rec:TRect;Index:LongInt;Selected:Boolean);
  845. Begin
  846.      If FOnDrawTab <> Nil Then FOnDrawTab(Self,TabCanvas,rec,Index,Selected);
  847. End;
  848.  
  849.  
  850. Procedure TTabSet.SelectNext(Direction:Boolean);
  851. Var  idx:LongInt;
  852. Begin
  853.      If Tabs.Count > 1 Then
  854.      Begin
  855.           If Direction Then idx := FTabIndex + 1
  856.           Else idx := FTabIndex - 1;
  857.           If idx < 0 Then idx := Tabs.Count-1;
  858.           If idx >= Tabs.Count Then idx := 0;
  859.           SetTabIndex(idx);
  860.      End;
  861. End;
  862.  
  863.  
  864. Function TTabSet.ItemAtPos(Pos:TPoint):LongInt;
  865. Var  TabPos:TTabPos;
  866.      I:LongInt;
  867. Begin
  868.      Result := -1;
  869.      If Not PointInRect(Pos,ClientRect) Then Exit;
  870.  
  871.      For I := 0 To FTabPositions.Count-1 Do
  872.      Begin
  873.           TabPos := TTabPos(FTabPositions[I]);
  874.           If (TabPos.Start <= Pos.X) And (TabPos.Start + TabPos.Size >= Pos.X) Then
  875.           Begin
  876.                Result := I;
  877.                Exit;
  878.           End;
  879.      End;
  880. End;
  881.  
  882.  
  883. Function TTabSet.ItemRect(Item:LongInt):TRect;
  884. Var  TabPos:TTabPos;
  885.      EdgeWidthDiv2:LongInt;
  886.      Y,CY:LongInt;
  887. Begin
  888.      Result := Rect(0,0,0,0);
  889.  
  890.      If (Item < 0) Or (Item >= FTabPositions.Count) Then Exit;
  891.  
  892.      EdgeWidthDiv2 := EdgeWidth Div 2;
  893.      TabPos := TTabPos(FTabPositions[Item]);
  894.      If FTabStyle = tsOwnerDraw Then CY := FTabHeight
  895.      Else CY := Canvas.TextHeight('M');
  896.  
  897.      If FAlignment = taBottom Then
  898.      Begin
  899.           Y := Height - TopMargin - CY - BottomMargin;
  900.           Result := Rect(TabPos.Start - EdgeWidthDiv2, Y,
  901.                          TabPos.Start + TabPos.Size + EdgeWidthDiv2,
  902.                          Height - TopMargin);
  903.      End
  904.      Else
  905.      Begin
  906.           Result := Rect(TabPos.Start - EdgeWidthDiv2, 0,
  907.                          TabPos.Start + TabPos.Size + EdgeWidthDiv2,
  908.                          BottomMargin + CY + TopMargin);
  909.      End;
  910. End;
  911.  
  912.  
  913. Procedure TTabSet.SetFocus;
  914. Begin
  915.      Inherited SetFocus;
  916.      Invalidate;
  917. End;
  918.  
  919.  
  920. Procedure TTabSet.KillFocus;
  921. Begin
  922.      Inherited KillFocus;
  923.      Invalidate;
  924. End;
  925.  
  926.  
  927. {$HINTS OFF}
  928. Procedure TTabSet.CharEvent(Var key:Char;RepeatCount:Byte);
  929. Var  S:String;
  930.      P:Integer;
  931.      I:LongInt;
  932. Begin
  933.      If key = ' ' Then
  934.      Begin
  935.           If FTabFocus <> FTabIndex Then SetTabIndex(FTabFocus);
  936.           key := #0;
  937.           Exit;
  938.      End;
  939.  
  940.      For I := 0 To FTabs.Count-1 Do
  941.      Begin
  942.           S := FTabs[I];
  943.           P := Pos('~',S);   { & }
  944.           If (P > 0) And (P < Length(S)) Then
  945.           Begin
  946.                If UpCase(key) = UpCase(S[P+1]) Then
  947.                Begin
  948.                     SetTabIndex(I);
  949.                     If I >= FFirstIndex + FVisibleTabs Then
  950.                     Begin
  951.                          While (I >= FFirstIndex + FVisibleTabs) And
  952.                                (I > FLastIndex) Do
  953.                          Begin
  954.                               SetFirstIndex(FFirstIndex + 1);
  955.                          End;
  956.                     End
  957.                     Else If I < FFirstIndex Then SetFirstIndex(I);
  958.                     key := #0;
  959.                     Exit;
  960.                End;
  961.           End;
  962.      End;
  963.  
  964.      Inherited CharEvent(key,RepeatCount);
  965. End;
  966.  
  967.  
  968. Procedure TTabSet.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  969. Begin
  970.      If TabStop Then
  971.      Begin
  972.           Case KeyCode Of
  973.             kbCLeft:
  974.             Begin
  975.                  If FTabFocus > 0 Then
  976.                  Begin
  977.                       FTabFocus := FTabFocus -1;
  978.                       If FTabFocus < FFirstIndex Then SetFirstIndex(FTabFocus);
  979.                       Invalidate;
  980.                  End;
  981.                  KeyCode := kbNull;
  982.             End;
  983.             kbCRight:
  984.             Begin
  985.                  If FTabFocus < FTabs.Count-1 Then
  986.                  Begin
  987.                       FTabFocus := FTabFocus +1;
  988.                       While (FTabFocus >= FFirstIndex + FVisibleTabs) And
  989.                             (FTabFocus > FLastIndex) Do
  990.                       Begin
  991.                            SetFirstIndex(FFirstIndex + 1);
  992.                       End;
  993.                       Invalidate;
  994.                  End;
  995.                  KeyCode := kbNull;
  996.             End;
  997.             {$IFDEF OS2}
  998.             kbEnter,
  999.             {$ENDIF}
  1000.             kbCR:
  1001.             Begin
  1002.                  If FTabFocus <> FTabIndex Then SetTabIndex(FTabFocus);
  1003.                  KeyCode := kbNull;
  1004.             End;
  1005.             Else Inherited ScanEvent(KeyCode,RepeatCount);
  1006.           End;
  1007.      End
  1008.      Else Inherited ScanEvent(KeyCode,RepeatCount);
  1009. End;
  1010.  
  1011.  
  1012. Procedure TTabSet.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  1013. Var  idx:LongInt;
  1014. Begin
  1015.      Inherited MouseDown(Button,ShiftState,X,Y);
  1016.  
  1017.      If Button = mbLeft Then
  1018.      Begin
  1019.           idx := ItemAtPos(Point(X,Y));
  1020.           If idx >= 0 Then
  1021.             If PointInRect(Point(X,Y), ItemRect(idx)) Then
  1022.             Begin
  1023.                  If TabStop Then
  1024.                    If FTabIndex = idx + FFirstIndex Then Focus;
  1025.                  SetTabIndex(idx + FFirstIndex);
  1026.             End;
  1027.      End;
  1028. End;
  1029. {$HINTS ON}
  1030.  
  1031.  
  1032. Procedure TTabSet.ArrangeTabs;
  1033. Var  TabPos:TTabPos;
  1034.      tabstart,tabend:LongInt;
  1035.      Index:LongInt;
  1036.      CX:LongInt;
  1037. Begin
  1038.      If Canvas = Nil Then Exit;
  1039.      FTabPositions.Count := 0;
  1040.  
  1041.      FVisibleTabs := 0;
  1042.      tabstart := FStartMargin + EdgeWidth;
  1043.      tabend := Width - FEndMargin;
  1044.      Index := FFirstIndex;
  1045.      While (Index < FTabs.Count) And (tabstart < tabend) Do
  1046.      Begin
  1047.           TabPos.Start := tabstart;
  1048.           CX := Canvas.TextWidth(FTabs[Index]);
  1049.  
  1050.           TabPos.Start := tabstart;
  1051.           If FTabStyle = tsOwnerDraw Then MeasureTab(Index, CX);
  1052.  
  1053.           TabPos.Size := CX;
  1054.           Inc(tabstart, CX + EdgeWidth);
  1055.  
  1056.           If tabstart <= tabend Then
  1057.           Begin
  1058.                FTabPositions.Add(Pointer(TabPos));
  1059.                FLastIndex := Index;
  1060.                Inc(Index);
  1061.                Inc(FVisibleTabs);
  1062.           End;
  1063.      End;
  1064.      SetButtons;
  1065. End;
  1066.  
  1067.  
  1068. Procedure TTabSet.Redraw(Const rec:TRect);
  1069. Begin
  1070.      If FAlignment = taBottom Then RedrawBottom(rec)
  1071.      Else RedrawTop(rec);
  1072. End;
  1073.  
  1074.  
  1075. Type
  1076.     TShortPos=Record
  1077.          X,Y:Integer;
  1078.     End;
  1079.  
  1080.     PPointArray=^TPointArray;
  1081.     TPointArray=Array[0..1000] Of TPoint;
  1082.  
  1083.  
  1084. {$HINTS OFF}
  1085. Procedure TTabSet.RedrawBottom(Const rec:TRect);
  1086. Var  rc:TRect;
  1087.      I:LongInt;
  1088.      TabPos:TTabPos;
  1089.      Y,CY:LongInt;
  1090.      IsSelected:Boolean;
  1091.      fullleft,fullright:Boolean;
  1092.      poly:Array[1..4] Of TPoint;
  1093.      shadow:Array[0..2] Of TPoint;
  1094.      wabe:Array[0..5] Of TPoint;
  1095.      topline1,topline2:TPoint;
  1096.      EdgeWidthDiv2:LongInt;
  1097.      OutlineList:TList;
  1098.      p1,p2:TShortPos;
  1099.      pPoly:PPointArray;
  1100. Begin
  1101.      Canvas.Brush.Style := bsSolid;
  1102.  
  1103.      If FTabStyle = tsOwnerDraw Then CY := FTabHeight
  1104.      Else CY := Canvas.TextHeight('M');
  1105.  
  1106.      EdgeWidthDiv2 := (EdgeWidth + 1) Div 2;
  1107.      topline1.X := 0;
  1108.      topline1.Y := Height - 1;
  1109.      topline2.X := Width -1;
  1110.      topline2.Y := Height - 1;
  1111.      {textline}
  1112.      Y := Height - TopMargin - CY;
  1113.  
  1114.      OutlineList.Create;
  1115.      p1.X := 0;
  1116.      p1.Y := Height - 2;
  1117.      OutlineList.Add(Pointer(p1));
  1118.  
  1119.      For I := 0 To FTabPositions.Count-1 Do
  1120.      Begin
  1121.           TabPos := TTabPos(FTabPositions[I]);
  1122.           rc := Rect(TabPos.Start, Y, TabPos.Start+TabPos.Size-1, Y+CY-1);
  1123.  
  1124.           IsSelected := (I + FFirstIndex) = FTabIndex;
  1125.           fullleft := IsSelected Or (I = 0);
  1126.           fullright := (I + FFirstIndex <> FTabIndex - 1) Or
  1127.                        (I = FTabPositions.Count-1);
  1128.  
  1129.  
  1130.           If fullleft Then
  1131.           Begin
  1132.                wabe[0].X := rc.Left - EdgeWidth;
  1133.                wabe[0].Y := rc.Top + 2;
  1134.                wabe[1] := wabe[0];
  1135.                {prevent flickering ON Top Line}
  1136.                If Not IsSelected Then Dec(wabe[0].Y, 2);
  1137.           End
  1138.           Else
  1139.           Begin
  1140.                wabe[0].X := rc.Left - 1;
  1141.                wabe[0].Y := rc.Top;
  1142.                wabe[1].X := rc.Left - EdgeWidthDiv2;
  1143.                wabe[1].Y := rc.Bottom + (rc.Top - rc.Bottom) Div 2;
  1144.           End;
  1145.  
  1146.           wabe[2] := Point(rc.Left, rc.Bottom - 1);
  1147.           wabe[3] := Point(rc.Right, rc.Bottom - 1);
  1148.  
  1149.           If fullright Then
  1150.           Begin
  1151.                wabe[4].X := rc.Right + EdgeWidth;
  1152.                wabe[4].Y := rc.Top + 2;
  1153.                wabe[5] := wabe[4];
  1154.                {$IFDEF OS2}
  1155.                {prevent flickering on Top Line}
  1156.                If Not IsSelected Then Dec(wabe[5].Y, 2);
  1157.                {$ENDIF}
  1158.           End
  1159.           Else
  1160.           Begin
  1161.                wabe[4].X := rc.Right + EdgeWidthDiv2;
  1162.                wabe[4].Y := rc.Bottom + (rc.Top - rc.Bottom) Div 2;
  1163.                wabe[5].X := rc.Right + 1;
  1164.                wabe[5].Y := rc.Top;
  1165.           End;
  1166.  
  1167.           Canvas.Pen.color := GetTabColor(I + FFirstIndex);
  1168.  
  1169.           Canvas.BeginPath;
  1170.           Canvas.PolyLine(wabe);
  1171.           Canvas.EndPath;
  1172.           Canvas.FillPath;
  1173.  
  1174.           If I > 0 Then {Redraw the Last border segment Of the previous tab}
  1175.           Begin
  1176.                Canvas.Pen.color := clBlack;
  1177.                Canvas.Line(poly[3].X,poly[3].Y,poly[4].X,poly[4].Y);
  1178.           End;
  1179.  
  1180.           {border Line}
  1181.           Canvas.Pen.color := clBlack;
  1182.           poly[1].X := wabe[1].X;
  1183.           poly[1].Y := wabe[1].Y-1;
  1184.           poly[2].X := wabe[2].X;
  1185.           poly[2].Y := wabe[2].Y-1;
  1186.           poly[3].X := wabe[3].X;
  1187.           poly[3].Y := wabe[3].Y-1;
  1188.           poly[4].X := wabe[4].X;
  1189.           poly[4].Y := wabe[4].Y-1;
  1190.           Canvas.PolyLine(poly);
  1191.  
  1192.  
  1193.           p1.X := poly[1].X;
  1194.           p1.Y := poly[1].Y;
  1195.           OutlineList.Add(Pointer(p1));
  1196.           p1.X := poly[2].X;
  1197.           p1.Y := poly[2].Y;
  1198.           OutlineList.Add(Pointer(p1));
  1199.           p1.X := poly[3].X;
  1200.           p1.Y := poly[3].Y;
  1201.           OutlineList.Add(Pointer(p1));
  1202.           p1.X := poly[4].X;
  1203.           p1.Y := poly[4].Y;
  1204.           OutlineList.Add(Pointer(p1));
  1205.  
  1206.           If I = FTabPositions.Count-1 Then
  1207.           Begin
  1208.                p1.X := Width-1;
  1209.                p1.Y := poly[4].Y;
  1210.                OutlineList.Add(Pointer(p1));
  1211.                p1.X := Width-1;
  1212.                p1.Y := Height-1;
  1213.                OutlineList.Add(Pointer(p1));
  1214.           End;
  1215.  
  1216.  
  1217.           If IsSelected Then {split topline}
  1218.           Begin
  1219.                Canvas.Pen.color := clBlack;
  1220.                Canvas.Line(topline1.X, topline1.Y, wabe[0].X, wabe[0].Y);
  1221.                Canvas.Pen.color := clBtnShadow;
  1222.                Canvas.Line(topline1.X, topline1.Y-1, wabe[0].X, wabe[0].Y-1);
  1223.                topline1 := wabe[5];
  1224.                {3D}
  1225.                shadow[0] := wabe[2];
  1226.                shadow[1] := wabe[3];
  1227.                shadow[2] := wabe[4];
  1228.                Canvas.PolyLine(shadow);
  1229.                Canvas.Line(shadow[1].X,shadow[1].Y+1,shadow[2].X-1,shadow[2].Y);
  1230.  
  1231.                Canvas.Pen.color := clBtnHighlight;
  1232.                Canvas.Line(wabe[0].X, wabe[0].Y, wabe[2].X, wabe[2].Y);
  1233.                Canvas.Line(wabe[0].X+1, wabe[0].Y, wabe[2].X, wabe[2].Y+1);
  1234.           End;
  1235.  
  1236.  
  1237.           If FTabStyle = tsOwnerDraw Then
  1238.           Begin
  1239.                DrawTab(Canvas, rc, I + FFirstIndex, IsSelected);
  1240.           End
  1241.           Else
  1242.           Begin
  1243.                Canvas.Pen.color := PenColor;
  1244.                Canvas.Brush.Mode := bmTransparent;
  1245.                Canvas.TextOut(rc.Left,rc.Bottom,FTabs[I + FirstIndex]);
  1246.           End;
  1247.      End;
  1248.  
  1249.      {Draw rest Of topline}
  1250.      Canvas.Pen.color := clBlack;
  1251.      Canvas.Line(topline1.X, topline1.Y, topline2.X, topline2.Y);
  1252.      Canvas.Pen.color := clBtnShadow;
  1253.      Canvas.Line(topline1.X, topline1.Y-1, topline2.X, topline2.Y-1);
  1254.  
  1255.  
  1256.      p1.X := 0;  {Start & End}
  1257.      p1.Y := Height-1;
  1258.      OutlineList.Add(Pointer(p1));
  1259.  
  1260.      GetMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  1261.  
  1262.      For I := 0 To OutlineList.Count-1 Do
  1263.      Begin
  1264.           p2 := TShortPos(OutlineList[I]);
  1265.           pPoly^[I].X := p2.X;
  1266.           pPoly^[I].Y := p2.Y;
  1267.      End;
  1268.      pPoly^[OutlineList.Count].X := p1.X;
  1269.      pPoly^[OutlineList.Count].Y := p1.Y;
  1270.  
  1271.      Canvas.BeginPath;
  1272.      Canvas.PolyLine(Slice(pPoly^,OutlineList.Count));
  1273.      Canvas.EndPath;
  1274.      Canvas.PathToClipRegion(paDiff);
  1275.  
  1276.      FreeMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  1277.      OutlineList.Destroy;
  1278.  
  1279.  
  1280.      If FDitherBackground Then
  1281.      Begin
  1282.           {$IFDEF OS2}
  1283.           Canvas.Pen.color := color;
  1284.           Canvas.Brush.color := clWhite;
  1285.           Canvas.Brush.Style := bsDiagCross;
  1286.           {$ENDIF}
  1287.           {$IFDEF WIN32}
  1288.           Canvas.Brush.Color := cl3DLight;
  1289.           Canvas.Brush.Style := bsSolid;
  1290.           {$ENDIF}
  1291.      End
  1292.      Else
  1293.      Begin
  1294.           Canvas.Pen.color := color;
  1295.           Canvas.Brush.Style := bsSolid;
  1296.      End;
  1297.  
  1298.      Canvas.Brush.Mode := bmOpaque;
  1299.      Canvas.Box(ClientRect); {background}
  1300. End;
  1301. {$HINTS ON}
  1302.  
  1303.  
  1304. {$HINTS OFF}
  1305. Procedure TTabSet.RedrawTop(Const rec:TRect);
  1306. Var  rc:TRect;
  1307.      I:LongInt;
  1308.      TabPos:TTabPos;
  1309.      Y,CY:LongInt;
  1310.      IsSelected:Boolean;
  1311.      fullleft,fullright:Boolean;
  1312.      poly:Array[1..4] Of TPoint;
  1313.      Light:Array[0..2] Of TPoint;
  1314.      wabe:Array[0..5] Of TPoint;
  1315.      topline1,topline2:TPoint;
  1316.      poly3,poly4:TPoint;
  1317.      EdgeWidthDiv2:LongInt;
  1318.      OutlineList:TList;
  1319.      p1,p2:TShortPos;
  1320.      pPoly:PPointArray;
  1321. Begin
  1322.      Canvas.Brush.Style := bsSolid;
  1323.  
  1324.      If FTabStyle = tsOwnerDraw Then CY := FTabHeight
  1325.      Else CY := Canvas.TextHeight('M');
  1326.  
  1327.      EdgeWidthDiv2 := (EdgeWidth + 1) Div 2;
  1328.      topline1.X := 0;
  1329.      topline1.Y := 0;
  1330.      topline2.X := Width -1;
  1331.      topline2.Y := 0;
  1332.      {textline}
  1333.      Y := 2;
  1334.  
  1335.      OutlineList.Create;
  1336.      p1.X := 0;
  1337.      p1.Y := 1;
  1338.      OutlineList.Add(Pointer(p1));
  1339.  
  1340.  
  1341.      For I := 0 To FTabPositions.Count-1 Do
  1342.      Begin
  1343.           TabPos := TTabPos(FTabPositions[I]);
  1344.           rc := Rect(TabPos.Start, Y, TabPos.Start+TabPos.Size-1, Y+CY-1);
  1345.  
  1346.           IsSelected := (I + FFirstIndex) = FTabIndex;
  1347.           fullleft := IsSelected Or (I = 0);
  1348.           fullright := (I + FFirstIndex <> FTabIndex - 1) Or
  1349.                        (I = FTabPositions.Count-1);
  1350.  
  1351.  
  1352.           If fullleft Then
  1353.           Begin
  1354.                wabe[0].X := rc.Left - EdgeWidth;
  1355.                wabe[0].Y := rc.Bottom - 2;
  1356.                wabe[1] := wabe[0];
  1357.                {prevent flickering on Top Line}
  1358.                If Not IsSelected Then Inc(wabe[0].Y, 2);
  1359.           End
  1360.           Else
  1361.           Begin
  1362.                wabe[0].X := rc.Left - 1;
  1363.                wabe[0].Y := rc.Bottom;
  1364.                wabe[1].X := rc.Left - EdgeWidthDiv2;
  1365.                wabe[1].Y := rc.Bottom + (rc.Top - rc.Bottom) Div 2;
  1366.           End;
  1367.  
  1368.           wabe[2] := Point(rc.Left, rc.Top + 1);
  1369.           wabe[3] := Point(rc.Right, rc.Top + 1);
  1370.  
  1371.           If fullright Then
  1372.           Begin
  1373.                wabe[4].X := rc.Right + EdgeWidth;
  1374.                wabe[4].Y := rc.Bottom - 2;
  1375.                wabe[5] := wabe[4];
  1376.                {$IFDEF OS2}
  1377.                {prevent flickering ON Top Line}
  1378.                If Not IsSelected Then Inc(wabe[5].Y, 2);
  1379.                {$ENDIF}
  1380.           End
  1381.           Else
  1382.           Begin
  1383.                wabe[4].X := rc.Right + EdgeWidthDiv2;
  1384.                wabe[4].Y := rc.Bottom + (rc.Top - rc.Bottom) Div 2;
  1385.                wabe[5].X := rc.Right + 1;
  1386.                wabe[5].Y := rc.Bottom;
  1387.           End;
  1388.  
  1389.           Canvas.Pen.color := GetTabColor(I + FFirstIndex);
  1390.  
  1391.           Canvas.BeginPath;
  1392.           Canvas.PolyLine(wabe);
  1393.           Canvas.EndPath;
  1394.           Canvas.FillPath;
  1395.  
  1396.           If I > 0 Then
  1397.           Begin {Redraw the Last border segment Of the previous tab}
  1398.                poly3 := poly[3];
  1399.                poly4 := poly[4];
  1400.  
  1401.                If fullleft Then
  1402.                Begin {Redraw Last border before Current border}
  1403.                     Canvas.Pen.color := clBtnShadow;
  1404.                     Canvas.Line(poly3.X,poly3.Y,poly4.X,poly4.Y);
  1405.                     Canvas.Pen.color := clBlack;
  1406.                     Canvas.Line(poly3.X+1,poly3.Y,poly4.X+1,poly4.Y);
  1407.                End;
  1408.           End;
  1409.  
  1410.           {border Line}
  1411.           Canvas.Pen.color := clBtnHighlight;
  1412.           poly[1].X := wabe[1].X;
  1413.           poly[1].Y := wabe[1].Y+1;
  1414.           poly[2].X := wabe[2].X;
  1415.           poly[2].Y := wabe[2].Y+1;
  1416.           poly[3].X := wabe[3].X;
  1417.           poly[3].Y := wabe[3].Y+1;
  1418.           poly[4].X := wabe[4].X;
  1419.           poly[4].Y := wabe[4].Y+1;
  1420.           Canvas.Line(poly[1].X,poly[1].Y,poly[2].X,poly[2].Y);
  1421.           Canvas.Line(poly[2].X,poly[2].Y,poly[3].X,poly[3].Y);
  1422.           Canvas.Pen.color := clBtnShadow;
  1423.           Canvas.Line(poly[3].X,poly[3].Y,poly[4].X,poly[4].Y);
  1424.           Canvas.Pen.color := clBlack;
  1425.           Canvas.Line(poly[3].X+1,poly[3].Y,poly[4].X+1,poly[4].Y);
  1426.  
  1427.           If I > 0 Then
  1428.           Begin {Redraw the Last border segment Of the previous tab}
  1429.                If Not fullleft Then
  1430.                Begin {Redraw Last border after Current border}
  1431.                     Canvas.Pen.color := clBtnShadow;
  1432.                     Canvas.Line(poly3.X,poly3.Y,poly4.X,poly4.Y);
  1433.                     Canvas.Pen.color := clBlack;
  1434.                     Canvas.Line(poly3.X+1,poly3.Y,poly4.X+1,poly4.Y);
  1435.                End;
  1436.           End;
  1437.  
  1438.  
  1439.           p1.X := poly[1].X;
  1440.           p1.Y := poly[1].Y;
  1441.           OutlineList.Add(Pointer(p1));
  1442.           p1.X := poly[2].X;
  1443.           p1.Y := poly[2].Y;
  1444.           OutlineList.Add(Pointer(p1));
  1445.           p1.X := poly[3].X+1;
  1446.           p1.Y := poly[3].Y;
  1447.           OutlineList.Add(Pointer(p1));
  1448.           p1.X := poly[4].X+1;
  1449.           p1.Y := poly[4].Y;
  1450.           OutlineList.Add(Pointer(p1));
  1451.  
  1452.           If I = FTabPositions.Count-1 Then
  1453.           Begin
  1454.                p1.X := Width-1;
  1455.                p1.Y := poly[4].Y;
  1456.                OutlineList.Add(Pointer(p1));
  1457.                p1.X := Width-1;
  1458.                p1.Y := 0;
  1459.                OutlineList.Add(Pointer(p1));
  1460.           End;
  1461.  
  1462.           If IsSelected Then {split topline}
  1463.           Begin
  1464.                Canvas.Pen.color := clBtnHighlight;
  1465.                Canvas.Line(topline1.X, topline1.Y, wabe[0].X, wabe[0].Y);
  1466.                Canvas.Line(topline1.X, topline1.Y+1, wabe[0].X, wabe[0].Y+1);
  1467.                topline1 := wabe[5];
  1468.                {3D}
  1469.                Light[0] := wabe[1];
  1470.                Light[1] := wabe[2];
  1471.                Light[2] := wabe[3];
  1472.                Canvas.PolyLine(Light);
  1473.                Canvas.Line(Light[1].X,Light[1].Y+1,Light[2].X+1,Light[2].Y+1);
  1474.  
  1475.                Canvas.Pen.color := clBtnShadow;
  1476.                Canvas.Line(wabe[3].X, wabe[3].Y, wabe[4].X, wabe[4].Y);
  1477.                Canvas.Line(wabe[3].X+1, wabe[3].Y, wabe[4].X, wabe[4].Y+1);
  1478.           End;
  1479.  
  1480.  
  1481.           If FTabStyle = tsOwnerDraw Then
  1482.           Begin
  1483.                DrawTab(Canvas, rc, I + FFirstIndex, IsSelected);
  1484.           End
  1485.           Else
  1486.           Begin
  1487.                Canvas.Pen.color := PenColor;
  1488.                Canvas.Brush.Mode := bmTransparent;
  1489.                Canvas.TextOut(rc.Left,rc.Bottom,FTabs[I + FirstIndex]);
  1490.           End;
  1491.      End;
  1492.  
  1493.      {Draw rest Of topline}
  1494.      Canvas.Pen.color := clBtnHighlight;
  1495.      Canvas.Line(topline1.X, topline1.Y, topline2.X, topline2.Y);
  1496.      Canvas.Line(topline1.X, topline1.Y+1, topline2.X, topline2.Y+1);
  1497.  
  1498.      p1.X := 0;  {Start & End}
  1499.      p1.Y := 0;
  1500.      OutlineList.Add(Pointer(p1));
  1501.  
  1502.      GetMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  1503.  
  1504.      For I := 0 To OutlineList.Count-1 Do
  1505.      Begin
  1506.           p2 := TShortPos(OutlineList[I]);
  1507.           pPoly^[I].X := p2.X;
  1508.           pPoly^[I].Y := p2.Y;
  1509.      End;
  1510.      pPoly^[OutlineList.Count].X := p1.X;
  1511.      pPoly^[OutlineList.Count].Y := p1.Y;
  1512.  
  1513.      Canvas.BeginPath;
  1514.      Canvas.PolyLine(Slice(pPoly^,OutlineList.Count));
  1515.      Canvas.EndPath;
  1516.      Canvas.PathToClipRegion(paDiff);
  1517.  
  1518.      FreeMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  1519.      OutlineList.Destroy;
  1520.  
  1521.  
  1522.      If FDitherBackground Then
  1523.      Begin
  1524.           {$IFDEF OS2}
  1525.           Canvas.Pen.color := color;
  1526.           Canvas.Brush.color := clWhite;
  1527.           Canvas.Brush.Style := bsDiagCross;
  1528.           {$ENDIF}
  1529.           {$IFDEF WIN32}
  1530.           Canvas.Brush.Color:=cl3DLight;
  1531.           Canvas.Brush.Style := bsSolid;
  1532.           {$ENDIF}
  1533.      End
  1534.      Else
  1535.      Begin
  1536.           Canvas.Pen.color := color;
  1537.           Canvas.Brush.Style := bsSolid;
  1538.      End;
  1539.  
  1540.      Canvas.Brush.Mode := bmOpaque;
  1541.      Canvas.Box(ClientRect); {background}
  1542. End;
  1543. {$HINTS ON}
  1544.  
  1545.  
  1546. {$HINTS OFF}
  1547. Procedure TTabSet.GetChildren(Proc:TGetChildProc);
  1548. Begin
  1549. End;
  1550. {$HINTS ON}
  1551.  
  1552.  
  1553. Function TTabSet.WriteSCUResource(Stream:TResourceStream):Boolean;
  1554. Var  aText:PChar;
  1555. Begin
  1556.      Result := Inherited WriteSCUResource(Stream);
  1557.      If Not Result Then Exit;
  1558.  
  1559.      aText := Tabs.GetText;
  1560.      If aText <> Nil Then
  1561.      Begin
  1562.           Result := Stream.NewResourceEntry(rnTabs,aText^,Length(aText^)+1);
  1563.           StrDispose(aText);
  1564.      End;
  1565. End;
  1566.  
  1567.  
  1568. Procedure TTabSet.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  1569. Var  aText:PChar;
  1570. Begin
  1571.      If ResName = rnTabs Then
  1572.      Begin
  1573.           aText := @Data;
  1574.           Tabs.SetText(aText);
  1575.      End
  1576.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  1577. End;
  1578.  
  1579.  
  1580. {
  1581. ╔═══════════════════════════════════════════════════════════════════════════╗
  1582. ║                                                                           ║
  1583. ║ Speed-Pascal/2 Version 2.0                                                ║
  1584. ║                                                                           ║
  1585. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1586. ║                                                                           ║
  1587. ║ This section: TPage Class Implementation                                  ║
  1588. ║                                                                           ║
  1589. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1590. ║                                                                           ║
  1591. ╚═══════════════════════════════════════════════════════════════════════════╝
  1592. }
  1593.  
  1594. Procedure TPage.SetupComponent;
  1595. Begin
  1596.      Inherited SetupComponent;
  1597.  
  1598.      Name := 'Page';
  1599.      ZOrder := zoNone;
  1600.      Align := alClient;
  1601.      ParentFont := True;
  1602.      ParentPenColor := True;
  1603.      ParentColor := True;
  1604.      ShowHint := False;
  1605.      ParentShowHint := True;
  1606.      TabStop := False;
  1607.      Visible := False;
  1608.      Include(ComponentState, csDetail);
  1609.      Include(ComponentState, csAcceptsControls);
  1610.      If Designed Then CreateCanvas;
  1611. End;
  1612.  
  1613.  
  1614. Procedure TPage.LoadedFromSCU(SCUParent:TComponent);
  1615. Begin
  1616.      Inherited LoadedFromSCU(SCUParent);
  1617.  
  1618.      If SCUParent Is TNoteBook Then
  1619.      Begin
  1620.           TNoteBook(SCUParent).FPages.Add(Self);
  1621.           {redirect the Owner}
  1622.           If Owner <> Nil Then Owner.RemoveComponent(Self);
  1623.           SCUParent.InsertComponent(Self);
  1624.      End;
  1625. End;
  1626.  
  1627.  
  1628. Procedure TPage.Paint(Const rec:TRect);
  1629. Var  rc1:TRect;
  1630. Begin
  1631.      Inherited Paint(rec);
  1632.  
  1633.      If Designed Then
  1634.      Begin
  1635.           rc1 := ClientRect;
  1636.           Canvas.Pen.Style := psDash;
  1637.           Canvas.Rectangle(rc1);
  1638.      End;
  1639. End;
  1640.  
  1641.  
  1642. Procedure TPage.BringToFront;
  1643. Var  NoteBook:TNoteBook;
  1644. Begin
  1645.      If parent Is TNoteBook Then
  1646.      Begin
  1647.           NoteBook := TNoteBook(parent);
  1648.           If NoteBook.FPages.IndexOf(Self) <> (NoteBook.FPageIndex)
  1649.           Then NoteBook.SetPageIndex(NoteBook.FPages.IndexOf(Self));
  1650.      End;
  1651.      Inherited BringToFront;
  1652. End;
  1653.  
  1654.  
  1655. Procedure TPage.CreateWnd;
  1656. Var  NoteBook:TNoteBook;
  1657. Begin
  1658.      If parent Is TNoteBook Then
  1659.      Begin
  1660.           NoteBook := TNoteBook(parent);
  1661.           If NoteBook.FPages.IndexOf(Self) <> (NoteBook.FPageIndex) Then Exit;
  1662.      End;
  1663.  
  1664.      Inherited CreateWnd;
  1665. End;
  1666.  
  1667. {
  1668. ╔═══════════════════════════════════════════════════════════════════════════╗
  1669. ║                                                                           ║
  1670. ║ Speed-Pascal/2 Version 2.0                                                ║
  1671. ║                                                                           ║
  1672. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1673. ║                                                                           ║
  1674. ║ This section: TPageAccess Class Implementation                            ║
  1675. ║                                                                           ║
  1676. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1677. ║                                                                           ║
  1678. ╚═══════════════════════════════════════════════════════════════════════════╝
  1679. }
  1680.  
  1681.  
  1682. Function TPageAccess.GetPage(Index:LongInt):TPage;
  1683. Begin
  1684.      Result:=FPages.Items[Index];
  1685. End;
  1686.  
  1687. Function TPageAccess.GetCount: LongInt;
  1688. Begin
  1689.      Result := FPages.Count;
  1690. End;
  1691.  
  1692.  
  1693. Function TPageAccess.Get(Index: LongInt): String;
  1694. Var  page:TPage;
  1695. Begin
  1696.      page := TPage(FPages[Index]);
  1697.      Result := page.Caption;
  1698. End;
  1699.  
  1700.  
  1701. Procedure TPageAccess.Put(Index: LongInt; Const S: String);
  1702. Var  page:TPage;
  1703. Begin
  1704.      page := TPage(FPages[Index]);
  1705.      page.Caption := GetShortHint(S);
  1706.      page.Hint := GetLongHint(S);
  1707.      page.ShowHint := False;
  1708.      If FOnChange <> Nil Then FOnChange(Self);
  1709. End;
  1710.  
  1711.  
  1712. Function TPageAccess.GetObject(Index: LongInt): TObject;
  1713. Begin
  1714.      Result := TPage(FPages[Index]);
  1715. End;
  1716.  
  1717.  
  1718. Procedure TPageAccess.Clear;
  1719. Var  page:TPage;
  1720.      I:LongInt;
  1721. Begin
  1722.      For I := 0 To FPages.Count-1 Do
  1723.      Begin
  1724.           page := TPage(FPages[I]);
  1725.           page.Destroy;
  1726.      End;
  1727.      FPages.Clear;
  1728.      If FOnChange <> Nil Then FOnChange(Self);
  1729. End;
  1730.  
  1731.  
  1732. Procedure TPageAccess.Delete(Index: LongInt);
  1733. Var  page:TPage;
  1734. Begin
  1735.      page := TPage(FPages[Index]);
  1736.      page.Destroy;
  1737.      FPages.Delete(Index);
  1738.      NoteBook.PageIndex := 0;
  1739.      If FOnChange <> Nil Then FOnChange(Self);
  1740. End;
  1741.  
  1742.  
  1743. Procedure TPageAccess.Insert(Index: LongInt; Const S: String);
  1744. Var  page:TPage;
  1745. Begin
  1746.      page.Create(NoteBook);
  1747.      NoteBook.InsertControl(page);
  1748.      page.Caption := GetShortHint(S);
  1749.      page.Hint := GetLongHint(S);
  1750.      FPages.Insert(Index, page);
  1751.  
  1752.      NoteBook.PageIndex := Index;
  1753.      If FOnChange <> Nil Then FOnChange(Self);
  1754. End;
  1755.  
  1756.  
  1757. Procedure TPageAccess.Move(CurIndex, NewIndex: LongInt);
  1758. Var  page:TObject;
  1759. Begin
  1760.      If CurIndex <> NewIndex Then
  1761.      Begin
  1762.           page := FPages[CurIndex];
  1763.           FPages[CurIndex] := FPages[NewIndex];
  1764.           FPages[NewIndex] := page;
  1765.      End;
  1766.      If FOnChange <> Nil Then FOnChange(Self);
  1767. End;
  1768.  
  1769.  
  1770. {
  1771. ╔═══════════════════════════════════════════════════════════════════════════╗
  1772. ║                                                                           ║
  1773. ║ Speed-Pascal/2 Version 2.0                                                ║
  1774. ║                                                                           ║
  1775. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1776. ║                                                                           ║
  1777. ║ This section: TNoteBook Class Implementation                              ║
  1778. ║                                                                           ║
  1779. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1780. ║                                                                           ║
  1781. ╚═══════════════════════════════════════════════════════════════════════════╝
  1782. }
  1783.  
  1784. Const
  1785.    TPageRegistered:Boolean=False;
  1786.  
  1787. Procedure TNoteBook.SetupComponent;
  1788. Begin
  1789.      Inherited SetupComponent;
  1790.  
  1791.      FPages.Create;
  1792.      FPageIndex := -1;
  1793.      FAccess.Create;
  1794.      FAccess.FPages := FPages;
  1795.      FAccess.FNotebook := Self;
  1796.      FAccess.Add('Default');
  1797.      PageIndex := 0;
  1798.  
  1799.      Name := 'Notebook';
  1800.      Width := 200;
  1801.      Height := 200;
  1802.      ParentPenColor := True;
  1803.      ParentColor := True;
  1804.  
  1805.      If Not TPageRegistered Then
  1806.      Begin
  1807.           RegisterClasses([TPage]); {RuntimeSCU}
  1808.           TPageRegistered := True;
  1809.      End;
  1810. End;
  1811.  
  1812.  
  1813. Procedure TNoteBook.SetupShow;
  1814. Var  page:TPage;
  1815. Begin
  1816.      Inherited SetupShow;
  1817.  
  1818.      If (FPageIndex >= 0) And (FPageIndex < FPages.Count) Then
  1819.      Begin
  1820.           page := FPages.Items[FPageIndex];
  1821.           page.CreateWnd;
  1822.           page.BringToFront;
  1823.           page.Show;
  1824.      End
  1825.      Else FPageIndex := -1;
  1826. End;
  1827.  
  1828.  
  1829. Destructor TNoteBook.Destroy;
  1830. Begin
  1831.      FPages.Destroy;
  1832.      FPages := Nil;
  1833.      FAccess.Destroy;
  1834.      FAccess := Nil;
  1835.  
  1836.      Inherited Destroy;
  1837. End;
  1838.  
  1839.  
  1840. Procedure TNoteBook.GetDesignerPopupEvents(AString:TStringList);
  1841. Begin
  1842.      AddDesignerPopupEvent(AString, LoadNLSStr(SNextPage), 1);
  1843.      AddDesignerPopupEvent(AString, LoadNLSStr(SPreviousPage), -1);
  1844. End;
  1845.  
  1846.  
  1847. Procedure TNoteBook.DesignerPopupEvent(Id:LongInt);
  1848. Begin
  1849.      Case Id Of
  1850.         1: If PageIndex < Pages.Count-1 Then PageIndex := PageIndex + 1;
  1851.        -1: If PageIndex > 0 Then PageIndex := PageIndex - 1;
  1852.      End;
  1853. End;
  1854.  
  1855.  
  1856. Procedure TNoteBook.GetChildren(Proc:TGetChildProc);
  1857. Var  page:TPage;
  1858.      I:LongInt;
  1859. Begin
  1860.      For I := 0 To FPages.Count-1 Do
  1861.      Begin
  1862.           page := TPage(FPages[I]);
  1863.           Proc(page);
  1864.      End;
  1865. End;
  1866.  
  1867.  
  1868. Procedure TNoteBook.LoadingFromSCU(SCUParent:TComponent);
  1869. Begin
  1870.      Inherited LoadingFromSCU(SCUParent);
  1871.  
  1872.      FPages.Clear;
  1873. End;
  1874.  
  1875.  
  1876. Function TNoteBook.GetActivePage:String;
  1877. Begin
  1878.      Result := '';
  1879.      If (FPageIndex < 0) Or (FPageIndex >= FAccess.Count) Then Exit;
  1880.      Result := GetShortHint(FAccess[FPageIndex]);
  1881. End;
  1882.  
  1883.  
  1884. Procedure TNoteBook.SetActivePage(Const Value:String);
  1885. Begin
  1886.      SetPageIndex(FAccess.IndexOf(Value));
  1887. End;
  1888.  
  1889.  
  1890. Procedure TNoteBook.SetPageIndex(Value:LongInt);
  1891. Var  page,OldPage:TPage;
  1892.      OldPageIndex:LongInt;
  1893.      Control:TControl;
  1894.      I:LongInt;
  1895. Begin
  1896.      If ComponentState * [csReading] <> [] Then
  1897.      Begin
  1898.           FPageIndex := Value;
  1899.           Exit;
  1900.      End;
  1901.  
  1902.      If Value = FPageIndex Then Exit;
  1903.      If (Value < 0) Or (Value >= FPages.Count) Then Exit;
  1904.  
  1905.      OldPageIndex := FPageIndex;
  1906.      FPageIndex := Value;
  1907.  
  1908.      If Handle <> 0 Then
  1909.      Begin
  1910.           If (OldPageIndex >= 0) And (OldPageIndex < FPages.Count) Then
  1911.           Begin
  1912.                OldPage := FPages.Items[OldPageIndex];
  1913.                OldPage.Hide;
  1914.           End
  1915.           Else OldPage := Nil; {wozu}
  1916.  
  1917.           page := FPages.Items[FPageIndex];
  1918.           page.Show;
  1919.           page.BringToFront;
  1920.  
  1921.           {Focus First Control}
  1922.           {$IFDEF OS2} //Redraw Fehler in Win32 fⁿr Controls, au▀erdem gings nicht...
  1923.           If Not Designed Then
  1924.             If Form <> Nil Then
  1925.               If Not (Form.ActiveControl Is TTabSet) Then
  1926.           Begin
  1927.                Page.Focus;
  1928.                For I := 0 To Page.ControlCount-1 Do
  1929.                Begin
  1930.                     Control := Page.Controls[I];
  1931.                     If Control.Visible Then
  1932.                       If Control.TabStop Then
  1933.                       Begin
  1934.                            Control.Focus;
  1935.                            break;
  1936.                       End;
  1937.                End;
  1938.           End;
  1939.           {$ENDIF}
  1940.      End;
  1941.      If FOnPageChanged <> Nil Then FOnPageChanged(Self);
  1942. End;
  1943.  
  1944.  
  1945. Procedure TNoteBook.SetPages(Value:TPageAccess);
  1946. Begin
  1947.      If Value <> FAccess Then FAccess.Assign(Value);
  1948. End;
  1949.  
  1950. {
  1951. ╔═══════════════════════════════════════════════════════════════════════════╗
  1952. ║                                                                           ║
  1953. ║ Speed-Pascal/2 Version 2.0                                                ║
  1954. ║                                                                           ║
  1955. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1956. ║                                                                           ║
  1957. ║ This section: TNotebookTabSet Class Implementation                        ║
  1958. ║                                                                           ║
  1959. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1960. ║                                                                           ║
  1961. ╚═══════════════════════════════════════════════════════════════════════════╝
  1962. }
  1963.  
  1964. Type
  1965.     TQueryTabColorEvent=Procedure(Sender:TObject;Index:LongInt;
  1966.                                   Var TabColor:TColor) Of Object;
  1967.  
  1968.     TNotebookTabSet=Class(TTabSet)
  1969.       Private
  1970.          TabbedNotebook:TTabbedNotebook;
  1971.          FOnQueryTabColor:TQueryTabColorEvent;
  1972.       Protected
  1973.          Procedure SetupComponent;Override;
  1974.          Function GetTabColor(Index:LongInt):TColor;Override;
  1975.          Procedure RedrawBottom(Const rec:TRect);Override;
  1976.          Procedure RedrawTop(Const rec:TRect);Override;
  1977.       Public
  1978.          Property OnQueryTabColor:TQueryTabColorEvent
  1979.                   Read FOnQueryTabColor Write FOnQueryTabColor;
  1980.     End;
  1981.  
  1982.  
  1983. Procedure TNotebookTabSet.SetupComponent;
  1984. Begin
  1985.     Inherited SetupComponent;
  1986.     {$IFDEF WIN32}
  1987.     Color:=clLtGray;
  1988.     {$ENDIF}
  1989. End;
  1990.  
  1991.  
  1992. Function TNotebookTabSet.GetTabColor(Index:LongInt):TColor;
  1993. Begin
  1994.      Result := Inherited GetTabColor(Index);
  1995.  
  1996.      If FOnQueryTabColor <> Nil
  1997.      Then FOnQueryTabColor(Self,Index,Result);
  1998. End;
  1999.  
  2000.  
  2001. Procedure TNotebookTabSet.RedrawBottom(Const rec:TRect);
  2002. Var  rc:TRect;
  2003.      I:LongInt;
  2004.      TabPos:TTabPos;
  2005.      Y,CY:LongInt;
  2006.      IsSelected:Boolean;
  2007.      wabe:TRect;
  2008.      leftvis,rightvis:Boolean;
  2009.      topline1,topline2:TPoint;
  2010.      EdgeWidthDiv2:LongInt;
  2011.      OutlineList:TList;
  2012.      p1,p2:TShortPos;
  2013.      pPoly:PPointArray;
  2014. Begin
  2015.      If TabbedNotebook.FRectangleTabs Then
  2016.      Begin
  2017.           Canvas.Brush.Style := bsSolid;
  2018.  
  2019.           EdgeWidthDiv2 := (EdgeWidth + 1) Div 2;   {Left side Of tab}
  2020.           topline1.X := 0;
  2021.           topline1.Y := Height - 1;
  2022.           topline2.X := Width - 1;
  2023.           topline2.Y := Height - 1;
  2024.           CY := FTabHeight;
  2025.           Y := Height - TopMargin - CY;   {textline}
  2026.  
  2027.           OutlineList.Create;
  2028.           p1.X := 0;
  2029.           p1.Y := Height - 2;
  2030.           OutlineList.Add(Pointer(p1));
  2031.  
  2032.           For I := 0 To FTabPositions.Count-1 Do
  2033.           Begin
  2034.                TabPos := TTabPos(FTabPositions[I]);
  2035.                rc := Rect(TabPos.Start, Y, TabPos.Start+TabPos.Size-1, Y+CY-1);
  2036.  
  2037.                IsSelected := (I + FFirstIndex) = FTabIndex;
  2038.                leftvis := (I + FirstIndex <> FTabIndex + 1) Or (I = 0);
  2039.                rightvis := (I + FirstIndex <> FTabIndex - 1) Or (I = FTabPositions.Count-1);
  2040.  
  2041.                wabe := rc;
  2042.                Dec(wabe.Left, (EdgeWidthDiv2 - 2));   {BorderWidth = 2}
  2043.                Inc(wabe.Right, (EdgeWidth - EdgeWidthDiv2 - 2));
  2044.  
  2045.                If IsSelected Then
  2046.                Begin
  2047.                     Forms.InflateRect(wabe, 2, 2);
  2048.                End;
  2049.  
  2050.                Canvas.Pen.color := GetTabColor(I + FFirstIndex);
  2051.  
  2052.                Canvas.BeginPath;
  2053.                Canvas.Rectangle(wabe);
  2054.                Canvas.EndPath;
  2055.                Canvas.FillPath;
  2056.  
  2057.                If leftvis Then
  2058.                Begin
  2059.                     Canvas.Pen.color := clLtGray;
  2060.                     Canvas.Line(wabe.Left-1,wabe.Bottom,wabe.Left-1,wabe.Top);
  2061.                     Canvas.Pen.color := clBtnHighlight;
  2062.                     Canvas.Line(wabe.Left-2,wabe.Bottom,wabe.Left-2,wabe.Top);
  2063.                     Canvas.Pixels[wabe.Left-1,wabe.Bottom-1] := clBtnHighlight;
  2064.                End;
  2065.  
  2066.                If I = 0 Then
  2067.                Begin
  2068.                     p1.X := wabe.Left-2;
  2069.                     p1.Y := Height-2;
  2070.                     OutlineList.Add(Pointer(p1));
  2071.                End;
  2072.                p1.X := wabe.Left-2;
  2073.                p1.Y := wabe.Bottom;
  2074.                OutlineList.Add(Pointer(p1));
  2075.  
  2076.                Canvas.Pen.color := clBtnShadow;
  2077.                Canvas.Line(wabe.Left,wabe.Bottom-1,wabe.Right,wabe.Bottom-1);
  2078.                Canvas.Pen.color := clBlack;
  2079.                Canvas.Line(wabe.Left+1,wabe.Bottom-2,wabe.Right,wabe.Bottom-2);
  2080.  
  2081.                p1.X := wabe.Left;
  2082.                p1.Y := wabe.Bottom-2;
  2083.                OutlineList.Add(Pointer(p1));
  2084.                p1.X := wabe.Right;
  2085.                p1.Y := wabe.Bottom-2;
  2086.                OutlineList.Add(Pointer(p1));
  2087.  
  2088.                If rightvis Then
  2089.                Begin
  2090.                     Canvas.Pixels[wabe.Right+1,wabe.Bottom-1] := clBlack;
  2091.                     Canvas.Pen.color := clBtnShadow;
  2092.                     Canvas.Line(wabe.Right+1,wabe.Bottom,wabe.Right+1,wabe.Top);
  2093.                     Canvas.Pen.color := clBlack;
  2094.                     Canvas.Line(wabe.Right+2,wabe.Bottom,wabe.Right+2,wabe.Top);
  2095.                End;
  2096.  
  2097.                p1.X := wabe.Right+2;
  2098.                p1.Y := wabe.Bottom;
  2099.                OutlineList.Add(Pointer(p1));
  2100.                If I = FTabPositions.Count-1 Then
  2101.                Begin
  2102.                     p1.X := wabe.Right+2;
  2103.                     p1.Y := Height-2;
  2104.                     OutlineList.Add(Pointer(p1));
  2105.                     p1.X := Width-1;
  2106.                     p1.Y := Height-2;
  2107.                     OutlineList.Add(Pointer(p1));
  2108.                     p1.X := Width-1;
  2109.                     p1.Y := Height-1;
  2110.                     OutlineList.Add(Pointer(p1));
  2111.                End;
  2112.  
  2113.  
  2114.                If IsSelected Then {split topline}
  2115.                Begin
  2116.                     If I > 0 Then
  2117.                     Begin
  2118.                          Canvas.Pen.color := clBlack;
  2119.                          Canvas.Line(topline1.X, topline1.Y-1, wabe.Left-3,topline1.Y-1);
  2120.                          Canvas.Pen.color := clBtnShadow;
  2121.                          Canvas.Line(topline1.X, topline1.Y, wabe.Left-2,topline1.Y);
  2122.                     End;
  2123.  
  2124.                     topline1.X := wabe.Right+2;
  2125.                End;
  2126.  
  2127.                DrawTab(Canvas, rc, I + FFirstIndex, IsSelected);
  2128.           End;
  2129.  
  2130.           {Draw rest Of topline}
  2131.           Canvas.Pen.color := clBlack;
  2132.           Canvas.Line(topline1.X, topline1.Y-1, topline2.X, topline2.Y-1);
  2133.           Canvas.Pen.color := clBtnShadow;
  2134.           Canvas.Line(topline1.X, topline1.Y, topline2.X, topline2.Y);
  2135.  
  2136.           Canvas.Pixels[topline2.X, topline2.Y] := clBlack;
  2137.  
  2138.  
  2139.           p1.X := 0;  {Start & End}
  2140.           p1.Y := Height-1;
  2141.           OutlineList.Add(Pointer(p1));
  2142.  
  2143.           GetMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  2144.  
  2145.           For I := 0 To OutlineList.Count-1 Do
  2146.           Begin
  2147.                p2 := TShortPos(OutlineList[I]);
  2148.                pPoly^[I].X := p2.X;
  2149.                pPoly^[I].Y := p2.Y;
  2150.           End;
  2151.           pPoly^[OutlineList.Count].X := p1.X;
  2152.           pPoly^[OutlineList.Count].Y := p1.Y;
  2153.  
  2154.           Canvas.BeginPath;
  2155.           Canvas.PolyLine(Slice(pPoly^,OutlineList.Count));
  2156.           Canvas.EndPath;
  2157.           Canvas.PathToClipRegion(paDiff);
  2158.  
  2159.           FreeMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  2160.           OutlineList.Destroy;
  2161.  
  2162.           {background}
  2163.           Canvas.Brush.Color := Color;
  2164.           Canvas.Pen.Color := Color;
  2165.           Canvas.Brush.Style := bsSolid;
  2166.           Canvas.Brush.Mode := bmOpaque;
  2167.           Canvas.Box(ClientRect);
  2168.      End
  2169.      Else Inherited RedrawBottom(rec);
  2170. End;
  2171.  
  2172.  
  2173. Procedure TNotebookTabSet.RedrawTop(Const rec:TRect);
  2174. Var  rc:TRect;
  2175.      I:LongInt;
  2176.      TabPos:TTabPos;
  2177.      Y,CY:LongInt;
  2178.      IsSelected:Boolean;
  2179.      wabe:TRect;
  2180.      leftvis,rightvis:Boolean;
  2181.      topline1,topline2:TPoint;
  2182.      EdgeWidthDiv2:LongInt;
  2183.      OutlineList:TList;
  2184.      p1,p2:TShortPos;
  2185.      pPoly:PPointArray;
  2186. Begin
  2187.      If TabbedNotebook.FRectangleTabs Then
  2188.      Begin
  2189.           Canvas.Brush.Style := bsSolid;
  2190.           Canvas.Brush.Mode := bmOpaque;
  2191.  
  2192.           EdgeWidthDiv2 := (EdgeWidth + 1) Div 2;   {Left side Of tab}
  2193.           topline1.X := 0;
  2194.           topline1.Y := 0;
  2195.           topline2.X := Width -1;
  2196.           topline2.Y := 0;
  2197.           CY := FTabHeight;
  2198.           Y := 2; {textline}
  2199.  
  2200.           OutlineList.Create;
  2201.           p1.X := 0;
  2202.           p1.Y := 1;
  2203.           OutlineList.Add(Pointer(p1));
  2204.  
  2205.           For I := 0 To FTabPositions.Count-1 Do
  2206.           Begin
  2207.                TabPos := TTabPos(FTabPositions[I]);
  2208.                rc := Rect(TabPos.Start, Y, TabPos.Start+TabPos.Size-1, Y+CY-1);
  2209.  
  2210.                IsSelected := (I + FFirstIndex) = FTabIndex;
  2211.                leftvis := (I + FirstIndex <> FTabIndex + 1) Or (I = 0);
  2212.                rightvis := (I + FirstIndex <> FTabIndex - 1) Or (I = FTabPositions.Count-1);
  2213.  
  2214.                wabe := rc;
  2215.                Dec(wabe.Left, (EdgeWidthDiv2 - 2));   {BorderWidth = 2}
  2216.                Inc(wabe.Right, (EdgeWidth - EdgeWidthDiv2 - 2));
  2217.  
  2218.                If IsSelected Then
  2219.                Begin
  2220.                     Forms.InflateRect(wabe, 2, 2);
  2221.                End;
  2222.  
  2223.                Canvas.Pen.color := GetTabColor(I + FFirstIndex);
  2224.  
  2225.                Canvas.BeginPath;
  2226.                Canvas.Rectangle(wabe);
  2227.                Canvas.EndPath;
  2228.                Canvas.FillPath;
  2229.  
  2230.                If leftvis Then
  2231.                Begin
  2232.                     Canvas.Pen.color := clLtGray;
  2233.                     Canvas.Line(wabe.Left-1,rc.Bottom-1,wabe.Left-1,wabe.Top);
  2234.                     Canvas.Pen.color := clBtnHighlight;
  2235.                     Canvas.Line(wabe.Left-2,rc.Bottom-1,wabe.Left-2,wabe.Top);
  2236.                     Canvas.Pixels[wabe.Left-1,wabe.Top+1] := clBtnHighlight;
  2237.                End;
  2238.  
  2239.                If I = 0 Then
  2240.                Begin
  2241.                     p1.X := wabe.Left-2;
  2242.                     p1.Y := 1;
  2243.                     OutlineList.Add(Pointer(p1));
  2244.                End;
  2245.                p1.X := wabe.Left-2;
  2246.                p1.Y := wabe.Top;
  2247.                OutlineList.Add(Pointer(p1));
  2248.  
  2249.                Canvas.Pen.color := clBtnHighlight;
  2250.                Canvas.Line(wabe.Left,wabe.Top+2,wabe.Right,wabe.Top+2);
  2251.                Canvas.Pen.color := clLtGray;
  2252.                Canvas.Line(wabe.Left,wabe.Top+1,wabe.Right,wabe.Top+1);
  2253.  
  2254.                p1.X := wabe.Left;
  2255.                p1.Y := wabe.Top+2;
  2256.                OutlineList.Add(Pointer(p1));
  2257.                p1.X := wabe.Right;
  2258.                p1.Y := wabe.Top+2;
  2259.                OutlineList.Add(Pointer(p1));
  2260.  
  2261.                If rightvis Then
  2262.                Begin
  2263.                     Canvas.Pixels[wabe.Right+1,wabe.Top+1] := clBtnHighlight;
  2264.                     Canvas.Pen.color := clBtnShadow;
  2265.                     Canvas.Line(wabe.Right+1,rc.Bottom-1,wabe.Right+1,wabe.Top);
  2266.                     Canvas.Pen.color := clBlack;
  2267.                     Canvas.Line(wabe.Right+2,rc.Bottom,wabe.Right+2,wabe.Top);
  2268.                End;
  2269.  
  2270.                p1.X := wabe.Right+2;
  2271.                p1.Y := wabe.Top;
  2272.                OutlineList.Add(Pointer(p1));
  2273.                If I = FTabPositions.Count-1 Then
  2274.                Begin
  2275.                     p1.X := wabe.Right+2;
  2276.                     p1.Y := 1;
  2277.                     OutlineList.Add(Pointer(p1));
  2278.                     p1.X := Width-1;
  2279.                     p1.Y := 1;
  2280.                     OutlineList.Add(Pointer(p1));
  2281.                     p1.X := Width-1;
  2282.                     p1.Y := 0;
  2283.                     OutlineList.Add(Pointer(p1));
  2284.                End;
  2285.  
  2286.                If IsSelected Then {split topline}
  2287.                Begin
  2288.                     If I > 0 Then
  2289.                     Begin
  2290.                          Canvas.Pen.color := clLtGray;
  2291.                          Canvas.Line(topline1.X, topline1.Y, wabe.Left,topline1.Y);
  2292.                          Canvas.Pen.color := clBtnHighlight;
  2293.                          Canvas.Line(topline1.X, topline1.Y+1, wabe.Left-2,topline1.Y+1);
  2294.                     End;
  2295.  
  2296.                     topline1.X := wabe.Right+2;
  2297.                End;
  2298.  
  2299.                DrawTab(Canvas, rc, I + FFirstIndex, IsSelected);
  2300.           End;
  2301.  
  2302.           {Draw rest Of topline}
  2303.           Canvas.Pen.color := clLtGray;
  2304.           Canvas.Line(topline1.X-1, topline1.Y, topline2.X, topline2.Y);
  2305.           Canvas.Pen.color := clBtnHighlight;
  2306.           Canvas.Line(topline1.X, topline1.Y+1, topline2.X, topline2.Y+1);
  2307.  
  2308.           Canvas.Pixels[0, 0] := clBtnHighlight;
  2309.           Canvas.Pixels[1, 0] := clLtGray;
  2310.           Canvas.Pixels[topline2.X, topline2.Y] := clBlack;
  2311.           Canvas.Pixels[topline2.X, topline2.Y+1] := clBlack;
  2312.           Canvas.Pixels[topline2.X-1, topline2.Y] := clDkGray;
  2313.           Canvas.Pixels[topline2.X-1, topline2.Y+1] := clDkGray;
  2314.  
  2315.           p1.X := 0;  {Start & End}
  2316.           p1.Y := 0;
  2317.           OutlineList.Add(Pointer(p1));
  2318.  
  2319.           GetMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  2320.  
  2321.           For I := 0 To OutlineList.Count-1 Do
  2322.           Begin
  2323.                p2 := TShortPos(OutlineList[I]);
  2324.                pPoly^[I].X := p2.X;
  2325.                pPoly^[I].Y := p2.Y;
  2326.           End;
  2327.           pPoly^[OutlineList.Count].X := p1.X;
  2328.           pPoly^[OutlineList.Count].Y := p1.Y;
  2329.  
  2330.           Canvas.BeginPath;
  2331.           Canvas.PolyLine(Slice(pPoly^,OutlineList.Count));
  2332.           Canvas.EndPath;
  2333.           Canvas.PathToClipRegion(paDiff);
  2334.  
  2335.           FreeMem(pPoly, SizeOf(TPoint) * (OutlineList.Count+1));
  2336.           OutlineList.Destroy;
  2337.  
  2338.           {background}
  2339.           Canvas.Brush.Color := Color;
  2340.           Canvas.Pen.Color := Color;
  2341.           Canvas.Brush.Style := bsSolid;
  2342.           Canvas.Brush.Mode := bmOpaque;
  2343.           Canvas.Box(ClientRect);
  2344.      End
  2345.      Else Inherited RedrawTop(rec);
  2346. End;
  2347.  
  2348.  
  2349. {
  2350. ╔═══════════════════════════════════════════════════════════════════════════╗
  2351. ║                                                                           ║
  2352. ║ Speed-Pascal/2 Version 2.0                                                ║
  2353. ║                                                                           ║
  2354. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2355. ║                                                                           ║
  2356. ║ This section: TTabbedNotebook Class Implementation                        ║
  2357. ║                                                                           ║
  2358. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2359. ║                                                                           ║
  2360. ╚═══════════════════════════════════════════════════════════════════════════╝
  2361. }
  2362.  
  2363. Const
  2364.      NotebookMargin=10;
  2365.      HintMargin=30;
  2366.      HintIndent=5;
  2367.      PopupCmdBase=cmUser-100;
  2368.  
  2369.  
  2370. Procedure TTabbedNotebook.SetupComponent;
  2371. Begin
  2372.      Inherited SetupComponent;
  2373.  
  2374.      Name := 'TabbedNotebook';
  2375.      Width := 200;
  2376.      Height := 200;
  2377.      Color := clDlgWindow;
  2378.      TabStop := False;
  2379.  
  2380.      FTabSet := TNotebookTabSet.Create(Self);
  2381.      TNotebookTabSet(FTabSet).TabbedNotebook := Self;
  2382.      FTabSet.Align := alTop;
  2383.      FTabSet.Alignment := taTop;
  2384.      FTabSet.ParentColor := True;
  2385.      FTabSet.DitherBackground := False;
  2386.      FTabSet.SelectedColor := Color;
  2387.      FTabSet.UnselectedColor := clDkGray; {??}
  2388.      FTabSet.Height := 25;
  2389.      FTabSet.TabHeight := 21;
  2390.      FTabSet.TabStop := True;
  2391.      FTabSet.OnClick := EvTabSetClicked;
  2392.      FTabSet.OnChange := EvCanChange;
  2393.      FTabSet.OnMeasureTab := EvMeasureTab;
  2394.      FTabSet.OnDrawTab := EvDrawTab;
  2395.      FTabSet.OnMouseClick := EvMouseClick;
  2396.      TNotebookTabSet(FTabSet).OnQueryTabColor := EvQueryTabColor;
  2397.      FTabSet.SetDesigning(Designed);
  2398.      FTabSet.TabStyle := tsOwnerDraw;
  2399.      Include(FTabSet.ComponentState, csDetail);
  2400.      InsertControl(FTabSet);
  2401.  
  2402.      FNotebook.Create(Self);
  2403.      FNotebook.TabStop := False;
  2404.      FNotebook.OnPageChanged := EvPageIndexChanged;
  2405.      FNotebook.FAccess.FOnChange := EvPageAccessChanged;
  2406.      FNotebook.SetDesigning(Designed);
  2407.      Include(FNotebook.ComponentState, csDetail);
  2408.      InsertControl(FNotebook);
  2409.  
  2410.      FAutoPopup := False;
  2411.      Style := nsDefault;
  2412.  
  2413.      EvPageAccessChanged(Nil);
  2414.      Resize;
  2415.      OnMouseClick := EvMouseClick;
  2416.      {clip TabSet At runtime}
  2417.      If Not Designed Then Include(ComponentState, csAcceptsControls);
  2418. End;
  2419.  
  2420.  
  2421. Procedure TTabbedNotebook.SetupShow;
  2422. Begin
  2423.      Inherited SetupShow;
  2424.  
  2425.      Resize;
  2426. End;
  2427.  
  2428.  
  2429. Procedure TTabbedNotebook.FontChange;
  2430. Begin
  2431.      Resize;
  2432.  
  2433.      Inherited FontChange;
  2434. End;
  2435.  
  2436.  
  2437. Procedure TTabbedNotebook.Resize;
  2438. Var  rcNotebook:TRect;
  2439.      yhint,yedge,xedge:LongInt;
  2440.      PageCountIndent:LongInt;
  2441. Begin
  2442.      Inherited Resize;
  2443.  
  2444.      If TabAlignment = taTop Then
  2445.      Begin
  2446.           rcNotebook := Rect(NotebookMargin,
  2447.                              NotebookMargin,
  2448.                              Width - NotebookMargin,
  2449.                              Height - FTabSet.Height - NotebookMargin);
  2450.  
  2451.           If FShowPageHint Then
  2452.           Begin
  2453.                Forms.InflateRect(rcNotebook, -5, -5);
  2454.                Dec(rcNotebook.Top, HintMargin);
  2455.  
  2456.                yhint := rcNotebook.Top + 5;
  2457.                yedge := rcNotebook.Top + 3;
  2458.           End;
  2459.      End
  2460.      Else
  2461.      Begin
  2462.           rcNotebook := Rect(NotebookMargin,
  2463.                              NotebookMargin + FTabSet.Height,
  2464.                              Width - NotebookMargin,
  2465.                              Height - NotebookMargin);
  2466.  
  2467.           If FShowPageHint Then
  2468.           Begin
  2469.                Forms.InflateRect(rcNotebook, -5, -5);
  2470.                Inc(rcNotebook.Bottom, HintMargin);
  2471.  
  2472.                yhint := rcNotebook.Bottom - 10 - 20;
  2473.                yedge := rcNotebook.Bottom - HintMargin - 2;
  2474.           End;
  2475.      End;
  2476.  
  2477.      FNotebook.SetWindowPos(rcNotebook.Left,
  2478.                             rcNotebook.Bottom,
  2479.                             rcNotebook.Right - rcNotebook.Left,
  2480.                             rcNotebook.Top - rcNotebook.Bottom);
  2481.  
  2482.      If FEdge <> Nil Then
  2483.      Begin
  2484.           xedge := FNotebook.Left + FNotebook.Width - HintMargin + 2;
  2485.  
  2486.           FEdge.SetWindowPos(xedge,
  2487.                              yedge,
  2488.                              HintMargin,
  2489.                              HintMargin);
  2490.      End;
  2491.  
  2492.      If Canvas <> Nil Then PageCountIndent := Canvas.TextWidth('Page 9 of 9')
  2493.      Else PageCountIndent := 100;
  2494.  
  2495.      If FPageCount <> Nil
  2496.      Then FPageCount.SetWindowPos(xedge-PageCountIndent,
  2497.                                   yhint,
  2498.                                   PageCountIndent,
  2499.                                   20);
  2500.  
  2501.      If FPageHint <> Nil
  2502.      Then FPageHint.SetWindowPos(rcNotebook.Left+HintIndent,
  2503.                                  yhint,
  2504.                                  FNotebook.Width-2*HintIndent-HintMargin,
  2505.                                  20);
  2506. End;
  2507.  
  2508.  
  2509. Procedure TTabbedNotebook.GetChildren(Proc:TGetChildProc);
  2510. Begin
  2511.      FNotebook.GetChildren(Proc);
  2512. End;
  2513.  
  2514.  
  2515. Procedure TTabbedNotebook.LoadingFromSCU(SCUParent:TComponent);
  2516. Begin
  2517.      Inherited LoadingFromSCU(SCUParent);
  2518.  
  2519.      FNotebook.Pages.Clear;
  2520. End;
  2521.  
  2522.  
  2523. Procedure TTabbedNotebook.LoadedFromSCU(SCUParent:TComponent);
  2524. Var  I:LongInt;
  2525.      page:TControl;
  2526. Begin
  2527.      Inherited LoadedFromSCU(SCUParent);
  2528.  
  2529.      For I := ControlCount-1 DownTo 0 Do
  2530.      Begin
  2531.           page := Controls[I];
  2532.           If page Is TPage Then
  2533.           Begin
  2534.                FNotebook.FPages.Insert(0,page);
  2535.                page.parent := FNotebook;
  2536.                {redirect the Owner}
  2537.                If page.Owner <> Nil Then page.Owner.RemoveComponent(page);
  2538.                FNotebook.InsertComponent(page);
  2539.           End;
  2540.      End;
  2541.  
  2542.      EvPageAccessChanged(Nil);
  2543.      Resize; {Resize the NoteBook}
  2544. End;
  2545.  
  2546.  
  2547. Function TTabbedNotebook.GetActivePage:String;
  2548. Begin
  2549.      Result := FNotebook.ActivePage;
  2550. End;
  2551.  
  2552.  
  2553. Procedure TTabbedNotebook.SetActivePage(Value:String);
  2554. Begin
  2555.      FNotebook.ActivePage := Value;
  2556. End;
  2557.  
  2558.  
  2559. Function TTabbedNotebook.GetPageRect:TRect;
  2560. Begin
  2561.     Result:=FNotebook.BoundsRect;
  2562. End;
  2563.  
  2564.  
  2565. Function TTabbedNotebook.GetPageIndex:LongInt;
  2566. Begin
  2567.      Result := FNotebook.PageIndex;
  2568. End;
  2569.  
  2570.  
  2571. Procedure TTabbedNotebook.SetPageIndex(Value:LongInt);
  2572. Var  page:TPage;
  2573. Begin
  2574.      IgnoreTabClick := True;   {ignore the event handler}
  2575.      If ComponentState * [csReading] <> [] Then
  2576.      Begin
  2577.           FNotebook.FPageIndex := Value; {Update With NoteBook.SetupShow}
  2578.      End
  2579.      Else
  2580.      Begin
  2581.           page := TPage(FNotebook.Pages.Objects[Value]);
  2582.           If page.Enabled Then FNotebook.PageIndex := Value;
  2583.      End;
  2584.      IgnoreTabClick := False;
  2585. End;
  2586.  
  2587.  
  2588. Function TTabbedNotebook.GetPages:TPageAccess;
  2589. Begin
  2590.      Result := FNotebook.Pages;
  2591. End;
  2592.  
  2593.  
  2594. Procedure TTabbedNotebook.SetPages(Value:TPageAccess);
  2595. Begin
  2596.      FNotebook.Pages := Value;
  2597. End;
  2598.  
  2599.  
  2600. Function TTabbedNotebook.GetTabFont:TFont;
  2601. Begin
  2602.      Result := FTabSet.Font;
  2603. End;
  2604.  
  2605.  
  2606. Procedure TTabbedNotebook.SetTabFont(Value:TFont);
  2607. Begin
  2608.      FTabSet.Font := Value;
  2609. End;
  2610.  
  2611.  
  2612. Function TTabbedNotebook.GetTabAlignment:TTabAlignment;
  2613. Begin
  2614.      Result := FTabSet.Alignment;
  2615. End;
  2616.  
  2617.  
  2618. Procedure TTabbedNotebook.SetTabAlignment(Value:TTabAlignment);
  2619. Begin
  2620.      If FTabSet.Alignment <> Value Then
  2621.      Begin
  2622.           FTabSet.Alignment := Value;
  2623.           If FTabSet.Alignment = taTop Then FTabSet.Align := alTop
  2624.           Else FTabSet.Align := alBottom;
  2625.           LoadEdge;
  2626.           Resize;
  2627.           Invalidate;
  2628.      End;
  2629. End;
  2630.  
  2631.  
  2632. Procedure TTabbedNotebook.SetStyle(Value:TTabbedNotebookStyle);
  2633. Begin
  2634.      FStyle := Value;
  2635.  
  2636.      Case Value Of
  2637.        nsDefault:
  2638.        Begin
  2639.             {$IFDEF OS2}
  2640.             ColorTabs := True;
  2641.             ShowPageHint := True;
  2642.             RectangleTabs := False;
  2643.             {$ENDIF}
  2644.             {$IFDEF Win95}
  2645.             ColorTabs := False;
  2646.             ShowPageHint := True;
  2647.             RectangleTabs := True; //????????
  2648.             {$ENDIF}
  2649.        End;
  2650.        nsWarp4:
  2651.        Begin
  2652.             ColorTabs := True;
  2653.             ShowPageHint := True;
  2654.             RectangleTabs := False;
  2655.        End;
  2656.        nsWin32:
  2657.        Begin
  2658.             ColorTabs := False;
  2659.             ShowPageHint := False;
  2660.             RectangleTabs := True;
  2661.        End;
  2662.      End;
  2663. End;
  2664.  
  2665.  
  2666. Procedure TTabbedNotebook.SetColorTabs(Value:Boolean);
  2667. Begin
  2668.      If FColorTabs <> Value Then
  2669.      Begin
  2670.           FColorTabs := Value;
  2671.           FTabSet.Invalidate;
  2672.      End;
  2673. End;
  2674.  
  2675.  
  2676. Procedure TTabbedNotebook.SetShowPageHint(Value:Boolean);
  2677. Begin
  2678.      If FShowPageHint <> Value Then
  2679.      Begin
  2680.           FShowPageHint := Value;
  2681.           If FShowPageHint Then
  2682.           Begin
  2683.                If FEdge = Nil Then FEdge.Create(Self);
  2684.                Include(FEdge.ComponentState, csDetail);
  2685.                FEdge.ZOrder := zoTop;
  2686.                FEdge.SetDesigning(Designed);
  2687.                LoadEdge;
  2688.                FEdge.OnMouseDown := EvEdgeMouseDown;
  2689.                FEdge.OnMouseUp := EvEdgeMouseUp;
  2690.                FEdge.OnMouseClick := EvMouseClick;
  2691.                InsertControl(FEdge);
  2692.  
  2693.                If FPageCount = Nil Then FPageCount.Create(Self);
  2694.                Include(FPageCount.ComponentState, csDetail);
  2695.                FPageCount.Alignment := taRightJustify;
  2696.                FPageCount.ZOrder := zoTop;
  2697.                FPageCount.SetDesigning(Designed);
  2698.                FPageCount.OnMouseClick := EvMouseClick;
  2699.                InsertControl(FPageCount);
  2700.  
  2701.                If FPageHint = Nil Then FPageHint.Create(Self);
  2702.                Include(FPageHint.ComponentState, csDetail);
  2703.                FPageHint.ZOrder := zoBottom;
  2704.                FPageHint.SetDesigning(Designed);
  2705.                FPageHint.OnMouseClick := EvMouseClick;
  2706.                InsertControl(FPageHint);
  2707.  
  2708.                {Update labels}
  2709.                EvPageIndexChanged(Nil);
  2710.           End
  2711.           Else
  2712.           Begin
  2713.                If FEdge <> Nil Then FEdge.Destroy;
  2714.                FEdge := Nil;
  2715.                LastEdgeBmpId := '';
  2716.  
  2717.                If FPageCount <> Nil Then FPageCount.Destroy;
  2718.                FPageCount := Nil;
  2719.  
  2720.                If FPageHint <> Nil Then FPageHint.Destroy;
  2721.                FPageHint := Nil;
  2722.           End;
  2723.           Resize;
  2724.           Invalidate;
  2725.      End;
  2726. End;
  2727.  
  2728.  
  2729. Procedure TTabbedNotebook.SetRectangleTabs(Value:Boolean);
  2730. Begin
  2731.      If FRectangleTabs <> Value Then
  2732.      Begin
  2733.           FRectangleTabs := Value;
  2734.           If Value Then
  2735.           Begin
  2736.                FTabSet.FTabHeight := FTabSet.Height - 6;
  2737.                FTabSet.FStartMargin := -2;
  2738.                FTabSet.FEndMargin := -3;
  2739.           End
  2740.           Else
  2741.           Begin
  2742.                FTabSet.FTabHeight := FTabSet.Height - 4;
  2743.                FTabSet.FStartMargin := 5;
  2744.                FTabSet.FEndMargin := 5;
  2745.           End;
  2746.           FTabSet.ArrangeTabs;
  2747.           FTabSet.Invalidate;
  2748.      End;
  2749. End;
  2750.  
  2751.  
  2752. Function TTabbedNotebook.GetTabHeight:LongInt;
  2753. Begin
  2754.      Result := FTabSet.Height;
  2755. End;
  2756.  
  2757.  
  2758. Procedure TTabbedNotebook.SetTabHeight(Value:LongInt);
  2759. Begin
  2760.      FTabSet.Height := Value;
  2761.      If FRectangleTabs Then FTabSet.TabHeight := Value - 6
  2762.      Else FTabSet.TabHeight := Value - 4;
  2763.      Resize;
  2764. End;
  2765.  
  2766.  
  2767. Function TTabbedNotebook.GetPageHint:String;
  2768. Begin
  2769.      If FPageHint <> Nil Then Result := FPageHint.Caption
  2770.      Else Result := '';
  2771. End;
  2772.  
  2773.  
  2774. Procedure TTabbedNotebook.SetPageHint(Const Value:String);
  2775. Begin
  2776.      If FPageHint <> Nil Then
  2777.        If FPageHint.Caption <> Value Then FPageHint.Caption := Value;
  2778. End;
  2779.  
  2780.  
  2781. Procedure TTabbedNotebook.LoadEdge;
  2782. Var  NewEdgeBmpId:String[30];
  2783. Begin
  2784.      If FEdge = Nil Then Exit;
  2785.  
  2786.      If TabAlignment = taTop Then
  2787.      Begin
  2788.           If FNotebook.PageIndex = 0 Then NewEdgeBmpId := 'StdBmpEdgeTopPlus'
  2789.           Else If FNotebook.PageIndex = FNotebook.Pages.Count-1
  2790.                Then NewEdgeBmpId := 'StdBmpEdgeTopMinus'
  2791.                Else NewEdgeBmpId := 'StdBmpEdgeTop';
  2792.      End
  2793.      Else
  2794.      Begin
  2795.           If FNotebook.PageIndex = 0 Then NewEdgeBmpId := 'StdBmpEdgeBottomPlus'
  2796.           Else If FNotebook.PageIndex = FNotebook.Pages.Count-1
  2797.                Then NewEdgeBmpId := 'StdBmpEdgeBottomMinus'
  2798.                Else NewEdgeBmpId := 'StdBmpEdgeBottom';
  2799.      End;
  2800.  
  2801.      If NewEdgeBmpId <> LastEdgeBmpId Then
  2802.      Begin
  2803.           FEdge.Bitmap.LoadFromResourceName(NewEdgeBmpId);
  2804.           FEdge.Invalidate;
  2805.           LastEdgeBmpId := NewEdgeBmpId;
  2806.      End;
  2807. End;
  2808.  
  2809.  
  2810. Procedure TTabbedNotebook.ArrangeSubPages;
  2811. Var  page:TPage;
  2812.      LastMainPage:TPage;
  2813.      SubCount:LongInt;
  2814.      SubIndex:LongInt;
  2815.      MainIndex:LongInt;
  2816.      I:LongInt;
  2817. Begin
  2818.      If FNotebook.Pages.Count = 0 Then Exit;
  2819.      SubCount := 0;
  2820.      SubIndex := 1;
  2821.      MainIndex := 0;
  2822.      LastMainPage := TPage(FNotebook.Pages.Objects[0]);
  2823.  
  2824.      For I := 0 To FNotebook.Pages.Count-1 Do
  2825.      Begin
  2826.           page := TPage(FNotebook.Pages.Objects[I]);
  2827.  
  2828.           If (page.Caption <> '') Or (I = 0) Then   {main page}
  2829.           Begin
  2830.                LastMainPage.SubCount := SubCount;
  2831.                page.SubCount := 0;
  2832.                page.SubIndex := 0;
  2833.                page.MainIndex := MainIndex;
  2834.                page.FIsSubPage := False;
  2835.                SubCount := 0;
  2836.                SubIndex := 1;
  2837.                Inc(MainIndex);
  2838.                LastMainPage := page;
  2839.           End
  2840.           Else
  2841.           Begin
  2842.                page.SubCount := 0;
  2843.                page.SubIndex := SubIndex;
  2844.                page.MainIndex := MainIndex-1;
  2845.                page.FIsSubPage := True;
  2846.                Inc(SubIndex);
  2847.                Inc(SubCount);
  2848.           End;
  2849.      End;
  2850.  
  2851.      LastMainPage.SubCount := SubCount;
  2852. End;
  2853.  
  2854.  
  2855. Function TTabbedNotebook.Tab2Page(TabIdx:LongInt):LongInt;
  2856. Var  page:TPage;
  2857.      PageIdx:LongInt;
  2858.      I:LongInt;
  2859. Begin
  2860.      PageIdx := -1;
  2861.      For I := 0 To FNotebook.Pages.Count-1 Do
  2862.      Begin
  2863.           page := TPage(FNotebook.Pages.Objects[I]);
  2864.           If page.SubIndex = 0 Then Inc(PageIdx); {main page}
  2865.  
  2866.           Result := I;
  2867.           If TabIdx = PageIdx Then Exit;
  2868.      End;
  2869.      Result := -1;
  2870. End;
  2871.  
  2872.  
  2873. Function TTabbedNotebook.Page2Tab(PageIdx:LongInt):LongInt;
  2874. Var  page:TPage;
  2875.      I:LongInt;
  2876. Begin
  2877.      Result := 0;
  2878.      For I := 1 To PageIdx Do
  2879.      Begin
  2880.           page := TPage(FNotebook.Pages.Objects[I]);
  2881.           If page.SubIndex = 0 Then Inc(Result); {main page}
  2882.      End;
  2883. End;
  2884.  
  2885.  
  2886. {$HINTS OFF}
  2887. Procedure TTabbedNotebook.EvTabSetClicked(Sender:TObject);
  2888. Begin
  2889.      {ignore TabSet.OnClick If it was Not A mouse event}
  2890.      If Not IgnoreTabClick
  2891.      Then FNotebook.PageIndex := Tab2Page(FTabSet.TabIndex);
  2892. End;
  2893.  
  2894.  
  2895. Procedure TTabbedNotebook.EvPageIndexChanged(Sender:TObject);
  2896. Var  page:TPage;
  2897.      LastMainPage:TPage;
  2898.      S:String;
  2899. Begin
  2900.      {Test If Pages available And page (PageIndex) can exist}
  2901.      If (FNotebook.PageIndex < 0) Or
  2902.         (FNotebook.PageIndex >= FNotebook.Pages.Count) Then Exit;
  2903.  
  2904.      FTabSet.TabIndex := Page2Tab(FNotebook.PageIndex);
  2905.  
  2906.      If FShowPageHint Then
  2907.      Begin
  2908.           LoadEdge;
  2909.           page := TPage(FNotebook.Pages.Objects[FNotebook.PageIndex]);
  2910.           If FPageHint <> Nil Then FPageHint.Text := page.Hint;
  2911.           If FPageCount <> Nil Then
  2912.           Begin
  2913.                If (page.SubIndex > 0) Or (page.SubCount > 0) Then
  2914.                Begin
  2915.                     LastMainPage := TPage(FNotebook.Pages.Objects[FNotebook.PageIndex-page.SubIndex]);
  2916.                     S := 'Page ' + tostr(page.SubIndex+1) + ' of ' +
  2917.                                    tostr(LastMainPage.SubCount+1);
  2918.                     FPageCount.Text := S;
  2919.                     FPageCount.Visible := True;
  2920.                End
  2921.                Else
  2922.                Begin
  2923.                     FPageCount.Text := '';
  2924.                     FPageCount.Visible := False;
  2925.                End;
  2926.           End;
  2927.      End;
  2928.  
  2929.      If Sender <> Nil Then {no manual call}
  2930.        If FOnPageChanged <> Nil Then FOnPageChanged(Self);
  2931. End;
  2932.  
  2933.  
  2934. Procedure TTabbedNotebook.EvPageAccessChanged(Sender:TObject);
  2935. Var  PackedPages:TStringList;
  2936.      I:LongInt;
  2937. Begin
  2938.      ArrangeSubPages;
  2939.  
  2940.      PackedPages.Create;
  2941.      PackedPages.Assign(FNotebook.Pages);
  2942.      For I := PackedPages.Count-1 DownTo 1 Do
  2943.      Begin
  2944.           If PackedPages[I] = '' Then PackedPages.Delete(I);
  2945.      End;
  2946.      FTabSet.Tabs := PackedPages;
  2947.      PackedPages.Destroy;
  2948.  
  2949.      EvPageIndexChanged(Nil);
  2950.  
  2951.      If PagesPopup <> Nil Then
  2952.      Begin
  2953.           PagesPopup.Destroy;
  2954.           PagesPopup := Nil;
  2955.      End;
  2956. End;
  2957.  
  2958.  
  2959. Procedure TTabbedNotebook.EvCanChange(Sender:TObject;NewTab:LongInt;Var AllowChange:Boolean);
  2960. Var  page:TPage;
  2961. Begin
  2962.      page := TPage(FNotebook.Pages.Objects[Tab2Page(NewTab)]);
  2963.      AllowChange := page.Enabled;
  2964. End;
  2965.  
  2966.  
  2967. Procedure TTabbedNotebook.EvMeasureTab(Sender:TObject;Index:LongInt;Var TabSize:LongInt);
  2968. Begin
  2969.      TabSize := TabSize + 15;
  2970. End;
  2971.  
  2972.  
  2973. Procedure TTabbedNotebook.EvDrawTab(Sender:TObject;TabCanvas:TCanvas;rec:TRect;Index:LongInt;Selected:Boolean);
  2974. Var  S:String;
  2975.      P:Integer;
  2976.      X,Y,CX,CY:LongInt;
  2977.      allow:Boolean;
  2978.      OldTabFont:TFont;
  2979. Begin
  2980.      If FColorTabs Then TabCanvas.Pen.color := PenColor
  2981.      Else TabCanvas.Pen.color := OppositeRGB(color);
  2982.  
  2983.      EvCanChange(FTabSet,Index,allow);
  2984.      If Not allow Then
  2985.        If Not FColorTabs Then TabCanvas.Pen.color := clDkGray;
  2986.  
  2987.      If Selected Then
  2988.      Begin
  2989.           OldTabFont := FTabSet.Font;
  2990.           If OldTabFont.FaceName = 'WarpSans' Then
  2991.             If Not (faBold In OldTabFont.Attributes)
  2992.             Then TabCanvas.Font := Screen.GetFontFromPointSize(
  2993.                                  OldTabFont.FaceName + ' Bold',
  2994.                                  OldTabFont.PointSize);
  2995.      End;
  2996.  
  2997.      S := FTabSet.Tabs[Index];
  2998.      P := Pos('~',S);  { & }
  2999.      If P = Length(S) Then P := 0;
  3000.      If P > 0 Then Delete(S,P,1);
  3001.      TabCanvas.GetTextExtent(S,CX,CY);
  3002.      X := rec.Left + (rec.Right - rec.Left - CX) Div 2;
  3003.      Y := rec.Bottom + (rec.Top - rec.Bottom - CY) Div 2;
  3004.      TabCanvas.Brush.Mode := bmTransparent;
  3005.      If P = 0 Then TabCanvas.TextOut(X,Y, FTabSet.Tabs[Index])
  3006.      Else TabCanvas.MnemoTextOut(X,Y, FTabSet.Tabs[Index]);
  3007.  
  3008.      If FTabSet.HasFocus And (Index = FTabSet.FTabFocus) Then
  3009.      Begin // Draw the Focus Rect around the tab Text
  3010.           TabCanvas.DrawFocusRect(Rect(X,Y,X+CX,Y+CY));
  3011.      End;
  3012.  
  3013.      If Selected Then
  3014.      Begin
  3015.           TabCanvas.Font := OldTabFont;
  3016.      End;
  3017.  
  3018.      Canvas.Brush.Mode := bmOpaque;
  3019. End;
  3020.  
  3021.  
  3022. Function TTabbedNotebook.SignFromPos(X,Y:LongInt):Boolean; {True +, False -}
  3023. Begin
  3024.      If TabAlignment = taTop Then
  3025.      Begin
  3026.           Result := (X - 1) + (Y - 1) > HintMargin;
  3027.      End
  3028.      Else
  3029.      Begin
  3030.           Result := X - Y > 0;
  3031.      End;
  3032. End;
  3033.  
  3034.  
  3035. Procedure TTabbedNotebook.EvEdgeMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:LongInt);
  3036. Begin
  3037.      If Button <> mbLeft Then Exit;
  3038.  
  3039.      EdgeDraggingMinus := False;
  3040.      EdgeDraggingPlus := False;
  3041.      If SignFromPos(X,Y) Then EdgeDraggingPlus := True
  3042.      Else EdgeDraggingMinus := True;
  3043.      FEdge.MouseCapture := True;
  3044. End;
  3045.  
  3046.  
  3047. Procedure TTabbedNotebook.EvEdgeMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:LongInt);
  3048. Begin
  3049.      If Button <> mbLeft Then Exit;
  3050.  
  3051.      If PointInRect(Point(X,Y),FEdge.ClientRect) Then
  3052.      Begin
  3053.           If SignFromPos(X,Y) Then
  3054.           Begin
  3055.                If EdgeDraggingPlus Then
  3056.                  If PageIndex < Pages.Count-1 Then
  3057.                Begin
  3058.                     PageIndex := PageIndex + 1;
  3059.                     While (PageIndex >= FTabSet.FFirstIndex + FTabSet.FVisibleTabs) And
  3060.                           (PageIndex > Tab2Page(FTabSet.FLastIndex)) Do
  3061.                     Begin
  3062.                          FTabSet.SetFirstIndex(FTabSet.FFirstIndex + 1);
  3063.                     End;
  3064.                End;
  3065.           End
  3066.           Else
  3067.           Begin
  3068.                If EdgeDraggingMinus Then
  3069.                  If PageIndex > 0 Then
  3070.                Begin
  3071.                     PageIndex := PageIndex - 1;
  3072.                     If PageIndex < FTabSet.FFirstIndex Then FTabSet.SetFirstIndex(PageIndex);
  3073.                End;
  3074.           End;
  3075.      End;
  3076.      EdgeDraggingMinus := False;
  3077.      EdgeDraggingPlus := False;
  3078.      FEdge.MouseCapture := False;
  3079. End;
  3080.  
  3081.  
  3082. Procedure TTabbedNotebook.EvMouseClick(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  3083. Var  entry,SubEntry:TMenuItem;
  3084.      page,LastMainPage:TPage;
  3085.      I:LongInt;
  3086.      pt:TPoint;
  3087. Begin
  3088.      If Button = mbRight Then
  3089.        If FAutoPopup Then
  3090.      Begin
  3091.           If PagesPopup = Nil Then
  3092.           Begin
  3093.                PagesPopup.Create(Self);
  3094.  
  3095.                For I := 0 To FNotebook.Pages.Count-1 Do
  3096.                Begin
  3097.                     page := TPage(FNotebook.Pages.Objects[I]);
  3098.  
  3099.                     If page.SubIndex > 0 Then
  3100.                     Begin
  3101.                          SubEntry.Create(PagesPopup);
  3102.                          SubEntry.Caption := 'Page ' + tostr(page.SubIndex+1)
  3103.                                     + ' of ' + tostr(LastMainPage.SubCount+1);
  3104.                          SubEntry.Command := PopupCmdBase + I;
  3105.                          SubEntry.OnClick := EvPopupClicked;
  3106.                          entry.Add(SubEntry);
  3107.                          page.PopupEntry := SubEntry;
  3108.                     End
  3109.                     Else
  3110.                     Begin
  3111.                          LastMainPage := page;
  3112.                          entry.Create(PagesPopup);
  3113.                          entry.Caption := page.Caption;
  3114.                          PagesPopup.Items.Add(entry);
  3115.  
  3116.                          If page.SubCount > 0 Then
  3117.                          Begin
  3118.                               SubEntry.Create(PagesPopup);
  3119.                               SubEntry.Caption := 'Page ' + tostr(page.SubIndex+1)
  3120.                                     + ' of ' + tostr(LastMainPage.SubCount+1);
  3121.                               SubEntry.Command := PopupCmdBase + I;
  3122.                               SubEntry.OnClick := EvPopupClicked;
  3123.                               entry.Add(SubEntry);
  3124.                               page.PopupEntry := SubEntry;
  3125.                          End
  3126.                          Else
  3127.                          Begin
  3128.                               entry.Command := PopupCmdBase + I;
  3129.                               entry.OnClick := EvPopupClicked;
  3130.                               page.PopupEntry := entry;
  3131.                          End;
  3132.                     End;
  3133.                End;
  3134.           End;
  3135.  
  3136.           {check the Right entry}
  3137.           For I := 0 To FNotebook.Pages.Count-1 Do
  3138.           Begin
  3139.                page := TPage(FNotebook.Pages.Objects[I]);
  3140.                entry := page.PopupEntry;
  3141.                If entry <> Nil Then
  3142.                Begin
  3143.                     entry.Checked := I = FNotebook.PageIndex;
  3144.                     entry.Enabled := page.Enabled;
  3145.                End;
  3146.           End;
  3147.  
  3148.           pt := TControl(Sender).ClientToScreen(Point(X,Y));
  3149.           PagesPopup.Popup(pt.X,pt.Y);
  3150.      End;
  3151. End;
  3152.  
  3153.  
  3154. Procedure TTabbedNotebook.EvPopupClicked(Sender:TObject);
  3155. Var  entry:TMenuItem;
  3156. Begin
  3157.      entry := TMenuItem(Sender);
  3158.      PageIndex := entry.Command - PopupCmdBase;
  3159. End;
  3160.  
  3161.  
  3162. Const
  3163.     PastelColors:Array[0..9,0..2] Of Byte = (
  3164.          (95,  223, 255),
  3165.          (95,  223, 127),
  3166.          (95,  127, 255),
  3167.          (191, 159, 159),
  3168.          (255, 255, 127),
  3169.          (127, 127, 159),
  3170.          (255, 127, 63),
  3171.          (255, 191, 0),
  3172.          (255, 159, 159),
  3173.          (255, 191, 127));
  3174.  
  3175. Procedure TTabbedNotebook.EvQueryTabColor(Sender:TObject;Index:LongInt;Var TabColor:TColor);
  3176. Var  TmpColor:TColor;
  3177. Begin
  3178.      If FColorTabs Then
  3179.      Begin
  3180.           Index := Index Mod 10;
  3181.           TabColor := ValuesToRGB(PastelColors[Index,0],
  3182.                                   PastelColors[Index,1],
  3183.                                   PastelColors[Index,2]);
  3184.           {$IFDEF OS2}
  3185.           TmpColor := GpiQueryNearestColor(Canvas.Handle,0,TabColor);
  3186.           If TmpColor >= 0 Then TabColor := TmpColor;
  3187.           {$ENDIF}
  3188.      End
  3189.      Else TabColor := color;
  3190. End;
  3191. {$HINTS ON}
  3192.  
  3193.  
  3194. Procedure TTabbedNotebook.Redraw(Const rec:TRect);
  3195. Var  rc:TRect;
  3196.      CL:TColor;
  3197.      rcHint:TRect;
  3198.      yline:LongInt;
  3199.      ypage:LongInt;
  3200. Begin
  3201.      rc := ClientRect;
  3202.      Canvas.ShadowedBorder(rc,clWhite,clBlack);
  3203.      Forms.InflateRect(rc,-1,-1);
  3204.      Canvas.ShadowedBorder(rc,clLtGray,clDkGray);
  3205.      Forms.InflateRect(rc,-1,-1);
  3206.      rc := Forms.IntersectRect(rc,rec);
  3207.  
  3208.      Inherited Redraw(rc);
  3209.  
  3210.      If FShowPageHint Then
  3211.      Begin
  3212.           rcHint := FNotebook.WindowRect;
  3213.           Inc(rcHint.Right);
  3214.           Inc(rcHint.Top);
  3215.  
  3216.           Forms.InflateRect(rcHint, 3, 3);
  3217.           If TabAlignment = taTop Then
  3218.           Begin
  3219.                yline := rcHint.Top;
  3220.                Inc(rcHint.Top, HintMargin);
  3221.                ypage := rcHint.Top - 2;
  3222.           End
  3223.           Else
  3224.           Begin
  3225.                yline := rcHint.Bottom;
  3226.                Dec(rcHint.Bottom, HintMargin);
  3227.                ypage := rcHint.Bottom + 2;
  3228.           End;
  3229.           Canvas.ShadowedBorder(rcHint, clDkGray, clWhite);
  3230.           Canvas.Pen.color := clDkGray;
  3231.           {page Line}
  3232.           Canvas.Line(rcHint.Left,ypage,rcHint.Right-HintMargin,ypage);
  3233.           Canvas.Line(rcHint.Right-3,rcHint.Bottom+1,rcHint.Right-3,rcHint.Top-1);
  3234.           {Cut Line}
  3235.           Canvas.Line(rcHint.Left+HintIndent,yline,
  3236.                       rcHint.Right-HintIndent-HintMargin,yline);
  3237.           Dec(yline);
  3238.           Canvas.Pen.color := clWhite;
  3239.           Canvas.Line(rcHint.Left+HintIndent,yline,
  3240.                       rcHint.Right-HintIndent-HintMargin,yline);
  3241.      End;
  3242.  
  3243.      If parent <> Nil Then CL := parent.color
  3244.      Else CL := clBackGround;
  3245.      If CL <> FTabSet.color Then FTabSet.color := CL;
  3246. End;
  3247.  
  3248.  
  3249. Function TTabbedNotebook.WriteSCUResource(Stream:TResourceStream):Boolean;
  3250. Begin
  3251.      Result := Inherited WriteSCUResource(Stream);
  3252.      If Not Result Then Exit;
  3253.  
  3254.      Result := TabFont.WriteSCUResourceName(Stream,rnTabFont);
  3255. End;
  3256.  
  3257.  
  3258. Procedure TTabbedNotebook.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  3259. Begin
  3260.      If ResName = rnTabFont Then
  3261.      Begin
  3262.           If DataLen <> 0 Then TabFont := ReadSCUFont(Data,DataLen);
  3263.      End
  3264.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  3265. End;
  3266.  
  3267.  
  3268. Function TTabbedNotebook.EvaluateShortCut(KeyCode:TKeyCode):Boolean;
  3269. Var  S:String;
  3270.      P:Integer;
  3271.      I:LongInt;
  3272.      key:TKeyCode;
  3273. Begin
  3274.      For I := 0 To Pages.Count-1 Do
  3275.      Begin
  3276.           S := Pages[I];
  3277.           P := Pos('~',S);   { & }
  3278.           If (P > 0) And (P < Length(S)) Then
  3279.           Begin
  3280.                key := (Ord(S[P+1]) Or $20) + kb_Alt + kb_Char;
  3281.                If key = KeyCode Then
  3282.                Begin
  3283.                     PageIndex := I;
  3284.                     Result := True;
  3285.                     Exit;
  3286.                End;
  3287.           End;
  3288.      End;
  3289.      Result := Inherited EvaluateShortCut(KeyCode);
  3290. End;
  3291.  
  3292.  
  3293. Procedure TTabbedNotebook.GetDesignerPopupEvents(AString:TStringList);
  3294. Begin
  3295.      AddDesignerPopupEvent(AString, LoadNLSStr(SNextPage), 1);
  3296.      AddDesignerPopupEvent(AString, LoadNLSStr(SPreviousPage), -1);
  3297. End;
  3298.  
  3299.  
  3300. Procedure TTabbedNotebook.DesignerPopupEvent(Id:LongInt);
  3301. Begin
  3302.      Case Id Of
  3303.         1: PageIndex := PageIndex + 1;
  3304.        -1: PageIndex := PageIndex - 1;
  3305.      End;
  3306. End;
  3307.  
  3308.  
  3309.  
  3310. Begin
  3311. End.
  3312.  
  3313.  
  3314.