summaryrefslogtreecommitdiff
path: root/packages/fv/src/tabs.inc
diff options
context:
space:
mode:
Diffstat (limited to 'packages/fv/src/tabs.inc')
-rw-r--r--packages/fv/src/tabs.inc814
1 files changed, 814 insertions, 0 deletions
diff --git a/packages/fv/src/tabs.inc b/packages/fv/src/tabs.inc
new file mode 100644
index 0000000000..ffd082822b
--- /dev/null
+++ b/packages/fv/src/tabs.inc
@@ -0,0 +1,814 @@
+{
+
+ Tabbed group for TV/FV dialogs
+
+ Copyright 2000-4 by Free Pascal core team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free
+ Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ MA 02110-1301, USA.
+
+ ****************************************************************************}
+{$ifdef FV_UNICODE}
+unit utabs;
+{$else FV_UNICODE}
+unit tabs;
+{$endif FV_UNICODE}
+
+{$I platform.inc} (* Multi-platform support defines *)
+{$CODEPAGE cp437}
+
+interface
+
+uses
+ objects,
+{$ifdef FV_UNICODE}
+ UFvCommon,
+ udrivers,
+ uviews,
+{$else FV_UNICODE}
+ FvCommon,
+ drivers,
+ views,
+{$endif FV_UNICODE}
+ fvconsts;
+
+
+type
+ PTabItem = ^TTabItem;
+ TTabItem = record
+ Next : PTabItem;
+ View : PView;
+ Dis : boolean;
+ end;
+
+ PTabDef = ^TTabDef;
+ TTabDef = record
+ Next : PTabDef;
+ Name : Sw_PString;
+ Items : PTabItem;
+ DefItem : PView;
+ ShortCut : char;
+ end;
+
+ PTab = ^TTab;
+ TTab = object(TGroup)
+ TabDefs : PTabDef;
+ ActiveDef : SmallInt;
+ DefCount : word;
+ constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+ constructor Load (var S: TStream);
+ function AtTab(Index: SmallInt): PTabDef; virtual;
+ procedure SelectTab(Index: SmallInt); virtual;
+ procedure Store (var S: TStream);
+ function TabCount: SmallInt;
+ function Valid(Command: Word): Boolean; virtual;
+ procedure ChangeBounds(var Bounds: TRect); virtual;
+ procedure HandleEvent(var Event: TEvent); virtual;
+ function GetPalette: PPalette; virtual;
+ procedure Draw; virtual;
+ function DataSize: sw_word;virtual;
+ procedure SetData(var Rec);virtual;
+ procedure GetData(var Rec);virtual;
+ procedure SetState(AState: Word; Enable: Boolean); virtual;
+ destructor Done; virtual;
+ private
+ InDraw: boolean;
+ function FirstSelectable: PView;
+ function LastSelectable: PView;
+ end;
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function NewTabDef(AName: Sw_String; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+procedure RegisterTab;
+
+const
+ RTab: TStreamRec = (
+ ObjType: idTab;
+{$IFDEF BP_VMTLink} { BP style VMT link }
+ VmtLink: Ofs (TypeOf (TTab)^);
+{$ELSE BP_VMTLink} { Alt style VMT link }
+ VmtLink: TypeOf (TTab);
+{$ENDIF BP_VMTLink}
+ Load: @TTab.Load;
+ Store: @TTab.Store
+ );
+
+
+implementation
+
+uses
+{$ifdef FV_UNICODE}
+ Udialogs;
+{$else FV_UNICODE}
+ dialogs;
+{$endif FV_UNICODE}
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+ inherited Init(Bounds);
+ Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+ GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+ TabDefs:=ATabDef;
+ ActiveDef:=-1;
+ SelectTab(0);
+ ReDraw;
+end;
+
+constructor TTab.Load (var S: TStream);
+
+ function DoLoadTabItems (var XDefItem: PView; ActItem: longint): PTabItem;
+ var
+ Count: longint;
+ Cur, First: PTabItem;
+ Last: ^PTabItem;
+ begin
+ Cur := nil; { Preset nil }
+ Last := @First; { Start on first item }
+ S.Read (Count, SizeOf(Count)); { Read item count }
+ while (Count > 0) do
+ begin
+ New (Cur); { New status item }
+ Last^ := Cur; { First chain part }
+ if (Cur <> nil) then { Check pointer valid }
+ begin
+ Last := @Cur^.Next; { Chain complete }
+ S.Read (Cur^.Dis, SizeOf (Cur^.Dis));
+ Cur^.View := PView (S.Get);
+ if ActItem = 0 then
+ XDefItem := Cur^.View; { Find default view }
+ end;
+ Dec (Count); { One item loaded }
+ Dec (ActItem);
+ end;
+ Last^ := nil; { Now chain end }
+ DoLoadTabItems := First; { Return the list }
+ end;
+
+ function DoLoadTabDefs: PTabDef;
+ var
+ Count: longint;
+ Cur, First: PTabDef;
+ Last: ^PTabDef;
+ ActItem: longint;
+ begin
+ Last := @First; { Start on first }
+ Count := DefCount;
+ while (Count > 0) do
+ begin
+ New (Cur); { New status def }
+ Last^ := Cur; { First part of chain }
+ if (Cur <> nil) then { Check pointer valid }
+ begin
+ Last := @Cur^.Next; { Chain complete }
+{$ifdef FV_UNICODE}
+ Cur^.Name := S.ReadUnicodeString; { Read name }
+{$else FV_UNICODE}
+ Cur^.Name := S.ReadStr; { Read name }
+{$endif FV_UNICODE}
+ S.Read (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
+ S.Read (ActItem, SizeOf (ActItem));
+ Cur^.Items := DoLoadTabItems (Cur^.DefItem, ActItem); { Set pointer }
+ end;
+ Dec (Count); { One item loaded }
+ end;
+ Last^ := nil; { Now chain ends }
+ DoLoadTabDefs := First; { Return item list }
+ end;
+
+begin
+ inherited Load (S);
+ S.Read (DefCount, SizeOf (DefCount));
+ S.Read (ActiveDef, SizeOf (ActiveDef));
+ TabDefs := DoLoadTabDefs;
+end;
+
+procedure TTab.Store (var S: TStream);
+
+ procedure DoStoreTabItems (Cur: PTabItem; XDefItem: PView);
+ var
+ Count: longint;
+ T: PTabItem;
+ ActItem: longint;
+ begin
+ Count := 0; { Clear count }
+ T := Cur; { Start on current }
+ while (T <> nil) do
+ begin
+ if T^.View = XDefItem then { Current = active? }
+ ActItem := Count; { => set order }
+ Inc (Count); { Count items }
+ T := T^.Next; { Next item }
+ end;
+ S.Write (ActItem, SizeOf (ActItem));
+ S.Write (Count, SizeOf (Count)); { Write item count }
+ while (Cur <> nil) do
+ begin
+ S.Write (Cur^.Dis, SizeOf (Cur^.Dis));
+ S.Put (Cur^.View);
+ end;
+ end;
+
+ procedure DoStoreTabDefs (Cur: PTabDef);
+ begin
+ while (Cur <> nil) do
+ begin
+ with Cur^ do
+ begin
+{$ifdef FV_UNICODE}
+ S.WriteUnicodeString(Cur^.Name); { Write name }
+{$else FV_UNICODE}
+ S.WriteStr (Cur^.Name); { Write name }
+{$endif FV_UNICODE}
+ S.Write (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
+ DoStoreTabItems (Items, DefItem); { Store the items }
+ end;
+ Cur := Cur^.Next; { Next status item }
+ end;
+ end;
+
+begin
+ inherited Store (S);
+ S.Write (DefCount, SizeOf (DefCount));
+ S.Write (ActiveDef, SizeOf (ActiveDef));
+ DoStoreTabDefs (TabDefs);
+end;
+
+function TTab.TabCount: SmallInt;
+var i: SmallInt;
+ P: PTabDef;
+begin
+ I:=0; P:=TabDefs;
+ while (P<>nil) do
+ begin
+ Inc(I);
+ P:=P^.Next;
+ end;
+ TabCount:=I;
+end;
+
+
+function TTab.AtTab(Index: SmallInt): PTabDef;
+var i: SmallInt;
+ P: PTabDef;
+begin
+ i:=0; P:=TabDefs;
+ while (I<Index) do
+ begin
+ if P=nil then RunError($AA);
+ P:=P^.Next;
+ Inc(i);
+ end;
+ AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: SmallInt);
+var P: PTabItem;
+ V: PView;
+begin
+ if ActiveDef<>Index then
+ begin
+ if Owner<>nil then Owner^.Lock;
+ Lock;
+ { --- Update --- }
+ if TabDefs<>nil then
+ begin
+ DefCount:=1;
+ while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+ end
+ else DefCount:=0;
+ if ActiveDef<>-1 then
+ begin
+ P:=AtTab(ActiveDef)^.Items;
+ while P<>nil do
+ begin
+ if P^.View<>nil then Delete(P^.View);
+ P:=P^.Next;
+ end;
+ end;
+ ActiveDef:=Index;
+ P:=AtTab(ActiveDef)^.Items;
+ while P<>nil do
+ begin
+ if P^.View<>nil then Insert(P^.View);
+ P:=P^.Next;
+ end;
+ V:=AtTab(ActiveDef)^.DefItem;
+ if V<>nil then V^.Select;
+ ReDraw;
+ { --- Update --- }
+ UnLock;
+ if Owner<>nil then Owner^.UnLock;
+ DrawView;
+ end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+ R: TRect;
+begin
+ if P^.Owner=nil then Exit; { it think this is a bug in TV }
+ P^.CalcBounds(R, D);
+ P^.ChangeBounds(R);
+end;
+var
+ P: PTabItem;
+ I: SmallInt;
+begin
+ D.X := Bounds.B.X - Bounds.A.X - Size.X;
+ D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+ inherited ChangeBounds(Bounds);
+ for I:=0 to TabCount-1 do
+ if I<>ActiveDef then
+ begin
+ P:=AtTab(I)^.Items;
+ while P<>nil do
+ begin
+ if P^.View<>nil then DoCalcChange(P^.View);
+ P:=P^.Next;
+ end;
+ end;
+end;
+
+
+function TTab.FirstSelectable: PView;
+var
+ FV : PView;
+begin
+ FV := First;
+ while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+ FV:=FV^.Next;
+ if FV<>nil then
+ if (FV^.Options and ofSelectable)=0 then FV:=nil;
+ FirstSelectable:=FV;
+end;
+
+
+function TTab.LastSelectable: PView;
+var
+ LV : PView;
+begin
+ LV := Last;
+ while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+ LV:=LV^.Prev;
+ if LV<>nil then
+ if (LV^.Options and ofSelectable)=0 then LV:=nil;
+ LastSelectable:=LV;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : SmallInt;
+ I : SmallInt;
+ X : SmallInt;
+ Len : byte;
+ P : TPoint;
+ V : PView;
+ CallOrig: boolean;
+ LastV : PView;
+ FirstV: PView;
+begin
+ if (Event.What and evMouseDown)<>0 then
+ begin
+ MakeLocal(Event.Where,P);
+ if P.Y<3 then
+ begin
+ Index:=-1; X:=1;
+ for i:=0 to DefCount-1 do
+ begin
+ Len:=CStrLen(AtTab(i)^.Name Sw_PString_Deref);
+ if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+ X:=X+Len+3;
+ end;
+ if Index<>-1 then
+ SelectTab(Index);
+ end;
+ end;
+ if Event.What=evKeyDown then
+ begin
+ Index:=-1;
+ case Event.KeyCode of
+ kbTab,kbShiftTab :
+ if GetState(sfSelected) then
+ begin
+ if Current<>nil then
+ begin
+ LastV:=LastSelectable; FirstV:=FirstSelectable;
+ if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+ begin
+ if Owner<>nil then Owner^.SelectNext(true);
+ end else
+ if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+ begin
+ Lock;
+ if Owner<>nil then Owner^.SelectNext(false);
+ UnLock;
+ end else
+ SelectNext(Event.KeyCode=kbShiftTab);
+ ClearEvent(Event);
+ end;
+ end;
+ kbCtrlPgUp:
+ begin
+ if ActiveDef > 0 then
+ Index := Pred (ActiveDef)
+ else
+ Index := Pred (DefCount);
+ ClearEvent(Event);
+ end;
+ kbCtrlPgDn:
+ begin
+ if ActiveDef < Pred (DefCount) then
+ Index := Succ (ActiveDef)
+ else
+ Index := 0;
+ ClearEvent(Event);
+ end;
+ else
+ for I:=0 to DefCount-1 do
+ begin
+ if (AtTab(I)^.ShortCut <> #0) and
+ (Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut)
+ then begin
+ Index:=I;
+ ClearEvent(Event);
+ Break;
+ end;
+ end;
+ end;
+ if Index<>-1 then
+ begin
+ Select;
+ SelectTab(Index);
+ V:=AtTab(ActiveDef)^.DefItem;
+ if V<>nil then V^.Focus;
+ end;
+ end;
+ CallOrig:=true;
+ if Event.What=evKeyDown then
+ begin
+ if ((Owner<>nil) and (Owner^.Phase=phPostProcess)
+ and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+ then
+ else CallOrig:=false;
+ end;
+ if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+ GetPalette:=nil;
+end;
+
+{$define AVOIDTHREELINES}
+
+procedure TTab.Draw;
+const
+{$ifdef AVOIDTHREELINES}
+ UDL={$ifdef FV_UNICODE}#$2510{$else}#191{$endif};
+ LUR={$ifdef FV_UNICODE}#$2500{$else}#196{$endif};
+ URD={$ifdef FV_UNICODE}#$250C{$else}#218{$endif};
+{$else not AVOIDTHREELINES}
+ UDL={$ifdef FV_UNICODE}#$2524{$else}#180{$endif};
+ LUR={$ifdef FV_UNICODE}#$2534{$else}#193{$endif};
+ URD={$ifdef FV_UNICODE}#$251C{$else}#195{$endif};
+{$endif not AVOIDTHREELINES}
+
+
+var B : TDrawBuffer;
+ i : SmallInt;
+ C1,C2,C3,C : word;
+ HeaderLen : SmallInt;
+ X,X2 : SmallInt;
+ Name : Sw_PString;
+ ActiveKPos : SmallInt;
+ ActiveVPos : SmallInt;
+ FC : char;
+procedure SWriteBuf(X,Y,W,H: SmallInt; var Buf);
+var i: SmallInt;
+begin
+ if Y+H>Size.Y then H:=Size.Y-Y;
+ if X+W>Size.X then W:=Size.X-X;
+ if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+ else for i:=1 to H do
+ Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+ MoveChar(B,' ',C1,Size.X);
+end;
+begin
+ if InDraw then Exit;
+ InDraw:=true;
+ { - Start of TGroup.Draw - }
+{ if Buffer = nil then
+ begin
+ GetBuffer;
+ end; }
+ { - Start of TGroup.Draw - }
+
+ C1:=GetColor(1);
+ C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256;
+ C3:=GetColor(8)+GetColor({9}8)*256;
+
+ { Calculate the size of the headers }
+ HeaderLen:=0;
+ for i:=0 to DefCount-1 do
+ HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name Sw_PString_Deref)+3;
+ Dec(HeaderLen);
+ if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+ { --- 1. sor --- }
+ ClearBuf;
+ MoveChar(B[0],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1);
+ MoveChar(B[HeaderLen+1],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1);
+ X:=1;
+ for i:=0 to DefCount-1 do
+ begin
+ Name:=AtTab(i)^.Name; X2:=CStrLen(Name Sw_PString_Deref);
+ if i=ActiveDef
+ then begin
+ ActiveKPos:=X-1;
+ ActiveVPos:=X+X2+2;
+ if GetState(sfFocused) then C:=C3 else C:=C2;
+ end
+ else C:=C2;
+ MoveCStr(B[X],' '+Name Sw_PString_Deref+' ',C);
+ X:=X+X2+3;
+ MoveChar(B[X-1],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1);
+ end;
+ SWriteBuf(0,1,Size.X,1,B);
+
+ { --- 0. sor --- }
+ ClearBuf; MoveChar(B[0],{$ifdef FV_UNICODE}#$250C{$else}#218{$endif},C1,1);
+ X:=1;
+ for i:=0 to DefCount-1 do
+ begin
+{$ifdef AVOIDTHREELINES}
+ if I<ActiveDef then
+ FC:={$ifdef FV_UNICODE}#$250C{$else}#218{$endif}
+ else
+ FC:={$ifdef FV_UNICODE}#$2510{$else}#191{$endif};
+{$else not AVOIDTHREELINES}
+ FC:={$ifdef FV_UNICODE}#$252C{$else}#194{$endif};
+{$endif not AVOIDTHREELINES}
+ X2:=CStrLen(AtTab(i)^.Name Sw_PString_Deref)+2;
+ MoveChar(B[X+X2],FC,C1,1);
+ if i=DefCount-1 then X2:=X2+1;
+ if X2>0 then
+ MoveChar(B[X],{$ifdef FV_UNICODE}#$2500{$else}#196{$endif},C1,X2);
+ X:=X+X2+1;
+ end;
+ MoveChar(B[HeaderLen+1],{$ifdef FV_UNICODE}#$2510{$else}#191{$endif},C1,1);
+ MoveChar(B[ActiveKPos],{$ifdef FV_UNICODE}#$250C{$else}#218{$endif},C1,1);
+ MoveChar(B[ActiveVPos],{$ifdef FV_UNICODE}#$2510{$else}#191{$endif},C1,1);
+ SWriteBuf(0,0,Size.X,1,B);
+
+ { --- 2. sor --- }
+ MoveChar(B[1],{$ifdef FV_UNICODE}#$2500{$else}#196{$endif},C1,Max(HeaderLen,0));
+ MoveChar(B[HeaderLen+2],{$ifdef FV_UNICODE}#$2500{$else}#196{$endif},C1,Max(Size.X-HeaderLen-3,0));
+ MoveChar(B[HeaderLen+1],LUR,C1,1);
+ MoveChar(B[ActiveKPos],{$ifdef FV_UNICODE}#$2518{$else}#217{$endif},C1,1);
+ if ActiveDef=0 then
+ MoveChar(B[0],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1)
+ else
+ MoveChar(B[0],URD,C1,1);
+ MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+ MoveChar(B[ActiveVPos],{$ifdef FV_UNICODE}#$2514{$else}#192{$endif},C1,1);
+ if HeaderLen+1<Size.X-1 then
+ MoveChar(B[Size.X-1],{$ifdef FV_UNICODE}#$2510{$else}#191{$endif},C1,1)
+ else if (ActiveDef=DefCount-1) then
+ MoveChar(B[Size.X-1],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1)
+ else
+ MoveChar(B[Size.X-1],UDL,C1,1);
+ SWriteBuf(0,2,Size.X,1,B);
+
+ { --- marad‚k sor --- }
+ ClearBuf; MoveChar(B[0],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1);
+ MoveChar(B[Size.X-1],{$ifdef FV_UNICODE}#$2502{$else}#179{$endif},C1,1);
+ {SWriteBuf(0,3,Size.X,Size.Y-4,B);}
+ for i:=3 to Size.Y-1 do
+ SWriteBuf(0,i,Size.X,1,B);
+
+ { --- Size.X . sor --- }
+ MoveChar(B[0],{$ifdef FV_UNICODE}#$2514{$else}#192{$endif},C1,1);
+ MoveChar(B[1],{$ifdef FV_UNICODE}#$2500{$else}#196{$endif},C1,Max(Size.X-2,0));
+ MoveChar(B[Size.X-1],{$ifdef FV_UNICODE}#$2518{$else}#217{$endif},C1,1);
+ SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+ { - End of TGroup.Draw - }
+ if Buffer <> nil then
+ begin
+ Lock;
+ Redraw;
+ UnLock;
+ end;
+ if Buffer <> nil then
+ WriteBuf(0, 0, Size.X, Size.Y, Buffer^)
+ else
+ Redraw;
+ { - End of TGroup.Draw - }
+ InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+ PI : PTabItem;
+ OK : boolean;
+begin
+ OK:=true;
+ PT:=TabDefs;
+ while (PT<>nil) and (OK=true) do
+ begin
+ PI:=PT^.Items;
+ while (PI<>nil) and (OK=true) do
+ begin
+ if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+ PI:=PI^.Next;
+ end;
+ PT:=PT^.Next;
+ end;
+ Valid:=OK;
+end;
+
+
+procedure TTab.SetData(var Rec);
+type
+ Bytes = array[0..65534] of Byte;
+var
+ I: Sw_Word;
+ PT : PTabDef;
+ PI : PTabItem;
+begin
+ I := 0;
+ PT:=TabDefs;
+ while (PT<>nil) do
+ begin
+ PI:=PT^.Items;
+ while (PI<>nil) do
+ begin
+ if PI^.View<>nil then
+ begin
+ PI^.View^.SetData(Bytes(Rec)[I]);
+ Inc(I, PI^.View^.DataSize);
+ end;
+ PI:=PI^.Next;
+ end;
+ PT:=PT^.Next;
+ end;
+end;
+
+
+function TTab.DataSize: sw_word;
+var
+ I: Sw_Word;
+ PT : PTabDef;
+ PI : PTabItem;
+begin
+ I := 0;
+ PT:=TabDefs;
+ while (PT<>nil) do
+ begin
+ PI:=PT^.Items;
+ while (PI<>nil) do
+ begin
+ if PI^.View<>nil then
+ begin
+ Inc(I, PI^.View^.DataSize);
+ end;
+ PI:=PI^.Next;
+ end;
+ PT:=PT^.Next;
+ end;
+ DataSize:=i;
+end;
+
+
+procedure TTab.GetData(var Rec);
+type
+ Bytes = array[0..65534] of Byte;
+var
+ I: Sw_Word;
+ PT : PTabDef;
+ PI : PTabItem;
+begin
+ I := 0;
+ PT:=TabDefs;
+ while (PT<>nil) do
+ begin
+ PI:=PT^.Items;
+ while (PI<>nil) do
+ begin
+ if PI^.View<>nil then
+ begin
+ PI^.View^.GetData(Bytes(Rec)[I]);
+ Inc(I, PI^.View^.DataSize);
+ end;
+ PI:=PI^.Next;
+ end;
+ PT:=PT^.Next;
+ end;
+end;
+
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+var
+ LastV : PView;
+begin
+ inherited SetState(AState,Enable);
+ { Select first item }
+ if (AState and sfSelected)<>0 then
+ begin
+ LastV:=LastSelectable;
+ if LastV<>nil then
+ LastV^.Select;
+ end;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+ if P<>nil then Delete(P);
+end;
+begin
+ ForEach(TCallbackProcParam(@DeleteViews));
+ inherited Done;
+ P:=TabDefs;
+ while P<>nil do
+ begin
+ X:=P^.Next;
+ DisposeTabDef(P);
+ P:=X;
+ end;
+end;
+
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+ New(P); FillChar(P^,SizeOf(P^),0);
+ P^.Next:=ANext; P^.View:=AView;
+ NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+ if P<>nil then
+ begin
+ if P^.View<>nil then Dispose(P^.View, Done);
+ Dispose(P);
+ end;
+end;
+
+function NewTabDef(AName: Sw_String; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+ x: byte;
+begin
+ New(P);
+ P^.Next:=ANext; P^.Name:=Sw_NewStr(AName); P^.Items:=AItems;
+ x:=pos('~',AName);
+ if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+ else P^.ShortCut:=#0;
+ P^.DefItem:=ADefItem;
+ NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+{$ifndef FV_UNICODE}
+ DisposeStr(P^.Name);
+{$endif FV_UNICODE}
+ PI:=P^.Items;
+ while PI<>nil do
+ begin
+ X:=PI^.Next;
+ DisposeTabItem(PI);
+ PI:=X;
+ end;
+ Dispose(P);
+end;
+
+procedure RegisterTab;
+begin
+ RegisterType (RTab);
+end;
+
+
+begin
+ RegisterTab;
+end.