Browse Source

+ added utabs - unicode version of the tabs unit

git-svn-id: branches/unicodekvm@48852 -
nickysn 4 years ago
parent
commit
c1dca28cc5
5 changed files with 50 additions and 12 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      packages/fv/examples/testuapp.pas
  3. 11 0
      packages/fv/fpmake.pp
  4. 35 11
      packages/fv/src/tabs.inc
  5. 2 0
      packages/fv/src/utabs.pas

+ 1 - 0
.gitattributes

@@ -5053,6 +5053,7 @@ packages/fv/src/umenus.pas svneol=native#text/plain
 packages/fv/src/umsgbox.pas svneol=native#text/plain
 packages/fv/src/umsgbox.pas svneol=native#text/plain
 packages/fv/src/unixsmsg.inc svneol=native#text/plain
 packages/fv/src/unixsmsg.inc svneol=native#text/plain
 packages/fv/src/uoutline.pas svneol=native#text/plain
 packages/fv/src/uoutline.pas svneol=native#text/plain
+packages/fv/src/utabs.pas svneol=native#text/plain
 packages/fv/src/utimeddlg.pas svneol=native#text/plain
 packages/fv/src/utimeddlg.pas svneol=native#text/plain
 packages/fv/src/uvalidate.pas svneol=native#text/plain
 packages/fv/src/uvalidate.pas svneol=native#text/plain
 packages/fv/src/uviews.pas svneol=native#text/plain
 packages/fv/src/uviews.pas svneol=native#text/plain

+ 1 - 1
packages/fv/examples/testuapp.pas

@@ -3,7 +3,7 @@ program testuapp;
 {$codepage UTF8}
 {$codepage UTF8}
 
 
 uses
 uses
-  Objects, UDrivers, UViews, UMenus, UDialogs, UApp, UMsgBox, UInpLong, SysUtils;
+  Objects, UDrivers, UViews, UMenus, UDialogs, UApp, UMsgBox, UInpLong, UTabs, SysUtils;
 
 
 const
 const
   cmOrderNew    = 200;
   cmOrderNew    = 200;

+ 11 - 0
packages/fv/fpmake.pp

@@ -342,6 +342,17 @@ begin
           AddUnit('fvcommon');
           AddUnit('fvcommon');
           AddUnit('dialogs');
           AddUnit('dialogs');
         end;
         end;
+    T:=P.Targets.AddUnit('utabs.pas');
+      with T.Dependencies do
+        begin
+          AddInclude('tabs.inc');
+          AddInclude('platform.inc');
+          AddUnit('udrivers');
+          AddUnit('uviews');
+          AddUnit('fvconsts');
+          AddUnit('ufvcommon');
+          AddUnit('udialogs');
+        end;
     T:=P.Targets.AddUnit('timeddlg.pas');
     T:=P.Targets.AddUnit('timeddlg.pas');
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin

+ 35 - 11
packages/fv/src/tabs.inc

@@ -18,7 +18,11 @@
    MA 02110-1301, USA.
    MA 02110-1301, USA.
 
 
  ****************************************************************************}
  ****************************************************************************}
+{$ifdef FV_UNICODE}
+unit utabs;
+{$else FV_UNICODE}
 unit tabs;
 unit tabs;
+{$endif FV_UNICODE}
 
 
 {$I platform.inc}    (* Multi-platform support defines *)
 {$I platform.inc}    (* Multi-platform support defines *)
 {$CODEPAGE cp437}
 {$CODEPAGE cp437}
@@ -27,8 +31,15 @@ interface
 
 
 uses
 uses
   objects,
   objects,
+{$ifdef FV_UNICODE}
+  UFvCommon,
+  udrivers,
+  uviews,
+{$else FV_UNICODE}
+  FvCommon,
   drivers,
   drivers,
   views,
   views,
+{$endif FV_UNICODE}
   fvconsts;
   fvconsts;
 
 
 
 
@@ -43,7 +54,7 @@ type
     PTabDef = ^TTabDef;
     PTabDef = ^TTabDef;
     TTabDef = record
     TTabDef = record
       Next     : PTabDef;
       Next     : PTabDef;
-      Name     : PString;
+      Name     : Sw_PString;
       Items    : PTabItem;
       Items    : PTabItem;
       DefItem  : PView;
       DefItem  : PView;
       ShortCut : char;
       ShortCut : char;
@@ -78,7 +89,7 @@ type
 
 
 function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
 function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
 procedure DisposeTabItem(P: PTabItem);
 procedure DisposeTabItem(P: PTabItem);
-function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+function  NewTabDef(AName: Sw_String; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
 procedure DisposeTabDef(P: PTabDef);
 procedure DisposeTabDef(P: PTabDef);
 
 
 procedure RegisterTab;
 procedure RegisterTab;
@@ -99,8 +110,11 @@ const
 implementation
 implementation
 
 
 uses
 uses
-  FvCommon,
+{$ifdef FV_UNICODE}
+  Udialogs;
+{$else FV_UNICODE}
   dialogs;
   dialogs;
+{$endif FV_UNICODE}
 
 
 constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
 constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
 begin
 begin
@@ -159,7 +173,11 @@ constructor TTab.Load (var S: TStream);
        if (Cur <> nil) then                           { Check pointer valid }
        if (Cur <> nil) then                           { Check pointer valid }
         begin
         begin
          Last := @Cur^.Next;                          { Chain complete }
          Last := @Cur^.Next;                          { Chain complete }
+{$ifdef FV_UNICODE}
+         Cur^.Name := S.ReadUnicodeString;            { Read name }
+{$else FV_UNICODE}
          Cur^.Name := S.ReadStr;                      { Read name }
          Cur^.Name := S.ReadStr;                      { Read name }
+{$endif FV_UNICODE}
          S.Read (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
          S.Read (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
          S.Read (ActItem, SizeOf (ActItem));
          S.Read (ActItem, SizeOf (ActItem));
          Cur^.Items := DoLoadTabItems (Cur^.DefItem, ActItem); { Set pointer }
          Cur^.Items := DoLoadTabItems (Cur^.DefItem, ActItem); { Set pointer }
@@ -209,7 +227,11 @@ procedure TTab.Store (var S: TStream);
      begin
      begin
       with Cur^ do
       with Cur^ do
        begin
        begin
+{$ifdef FV_UNICODE}
+        S.WriteUnicodeString(Cur^.Name);              { Write name }
+{$else FV_UNICODE}
         S.WriteStr (Cur^.Name);                       { Write name }
         S.WriteStr (Cur^.Name);                       { Write name }
+{$endif FV_UNICODE}
         S.Write (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
         S.Write (Cur^.ShortCut, SizeOf (Cur^.ShortCut));
         DoStoreTabItems (Items, DefItem);             { Store the items }
         DoStoreTabItems (Items, DefItem);             { Store the items }
        end;
        end;
@@ -367,7 +389,7 @@ begin
             Index:=-1; X:=1;
             Index:=-1; X:=1;
             for i:=0 to DefCount-1 do
             for i:=0 to DefCount-1 do
                 begin
                 begin
-                  Len:=CStrLen(AtTab(i)^.Name^);
+                  Len:=CStrLen(AtTab(i)^.Name Sw_PString_Deref);
                   if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
                   if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
                   X:=X+Len+3;
                   X:=X+Len+3;
                 end;
                 end;
@@ -471,7 +493,7 @@ var B     : TDrawBuffer;
     C1,C2,C3,C : word;
     C1,C2,C3,C : word;
     HeaderLen  : SmallInt;
     HeaderLen  : SmallInt;
     X,X2       : SmallInt;
     X,X2       : SmallInt;
-    Name       : PString;
+    Name       : Sw_PString;
     ActiveKPos : SmallInt;
     ActiveKPos : SmallInt;
     ActiveVPos : SmallInt;
     ActiveVPos : SmallInt;
     FC   : char;
     FC   : char;
@@ -505,7 +527,7 @@ begin
   { Calculate the size of the headers }
   { Calculate the size of the headers }
   HeaderLen:=0;
   HeaderLen:=0;
   for i:=0 to DefCount-1 do
   for i:=0 to DefCount-1 do
-    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3;
+    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name Sw_PString_Deref)+3;
   Dec(HeaderLen);
   Dec(HeaderLen);
   if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
   if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
 
 
@@ -516,7 +538,7 @@ begin
   X:=1;
   X:=1;
   for i:=0 to DefCount-1 do
   for i:=0 to DefCount-1 do
       begin
       begin
-        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name Sw_PString_Deref);
         if i=ActiveDef
         if i=ActiveDef
            then begin
            then begin
                   ActiveKPos:=X-1;
                   ActiveKPos:=X-1;
@@ -524,7 +546,7 @@ begin
                   if GetState(sfFocused) then C:=C3 else C:=C2;
                   if GetState(sfFocused) then C:=C3 else C:=C2;
                 end
                 end
            else C:=C2;
            else C:=C2;
-        MoveCStr(B[X],' '+Name^+' ',C);
+        MoveCStr(B[X],' '+Name Sw_PString_Deref+' ',C);
         X:=X+X2+3;
         X:=X+X2+3;
         MoveChar(B[X-1],'³',C1,1);
         MoveChar(B[X-1],'³',C1,1);
       end;
       end;
@@ -543,7 +565,7 @@ begin
 {$else not AVOIDTHREELINES}
 {$else not AVOIDTHREELINES}
         FC:='Â';
         FC:='Â';
 {$endif not AVOIDTHREELINES}
 {$endif not AVOIDTHREELINES}
-        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        X2:=CStrLen(AtTab(i)^.Name Sw_PString_Deref)+2;
         MoveChar(B[X+X2],FC,C1,1);
         MoveChar(B[X+X2],FC,C1,1);
         if i=DefCount-1 then X2:=X2+1;
         if i=DefCount-1 then X2:=X2+1;
         if X2>0 then
         if X2>0 then
@@ -752,12 +774,12 @@ begin
   end;
   end;
 end;
 end;
 
 
-function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+function NewTabDef(AName: Sw_String; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
 var P: PTabDef;
 var P: PTabDef;
     x: byte;
     x: byte;
 begin
 begin
   New(P);
   New(P);
-  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  P^.Next:=ANext; P^.Name:=Sw_NewStr(AName); P^.Items:=AItems;
   x:=pos('~',AName);
   x:=pos('~',AName);
   if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
   if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
                                   else P^.ShortCut:=#0;
                                   else P^.ShortCut:=#0;
@@ -768,7 +790,9 @@ end;
 procedure DisposeTabDef(P: PTabDef);
 procedure DisposeTabDef(P: PTabDef);
 var PI,X: PTabItem;
 var PI,X: PTabItem;
 begin
 begin
+{$ifndef FV_UNICODE}
   DisposeStr(P^.Name);
   DisposeStr(P^.Name);
+{$endif FV_UNICODE}
   PI:=P^.Items;
   PI:=P^.Items;
   while PI<>nil do
   while PI<>nil do
     begin
     begin

+ 2 - 0
packages/fv/src/utabs.pas

@@ -0,0 +1,2 @@
+{$DEFINE FV_UNICODE}
+{$I tabs.inc}