source: trunk/Components/TabbedNotebook2.pas@ 91

Last change on this file since 91 was 15, checked in by RBRi, 19 years ago

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