Przeglądaj źródła

+ Implemented wraptext

michael 20 lat temu
rodzic
commit
aa96eb6ceb
2 zmienionych plików z 73 dodań i 2 usunięć
  1. 67 1
      rtl/objpas/sysutils/sysstr.inc
  2. 6 1
      rtl/objpas/sysutils/sysstrh.inc

+ 67 - 1
rtl/objpas/sysutils/sysstr.inc

@@ -2176,6 +2176,69 @@ begin
   Result:=FindCmdLineSwitch(Switch,SwitchChars,False);
 end;
 
+function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet;  MaxCol: Integer): string;
+
+const
+  Quotes = ['''', '"'];
+
+Var
+  L : String;
+  C,LQ,BC : Char;
+  P,BLen,Len : Integer;
+  HB,IBC : Boolean;
+  
+begin 
+  Result:='';
+  L:=Line;
+  Blen:=Length(BreakStr);
+  If (BLen>0) then
+    BC:=BreakStr[1]
+  else
+    BC:=#0;
+  Len:=Length(L);
+  While (Len>0) do
+    begin
+    P:=1;
+    LQ:=#0;
+    HB:=False;
+    IBC:=False;
+    While ((P<=Len) and ((P<=MaxCol) or not IBC)) and ((LQ<>#0) or Not HB) do
+      begin
+      C:=L[P];
+      If (C=LQ) then
+        LQ:=#0
+      else If (C in Quotes) then
+        LQ:=C;
+      If (LQ<>#0) then
+        Inc(P)
+      else  
+        begin
+        HB:=((C=BC) and (BreakStr=Copy(L,P,BLen)));
+        If HB then
+          Inc(P,Blen-1)
+        else 
+          begin
+          If (P>MaxCol) then
+            IBC:=C in BreakChars;
+          Inc(P);
+          end;
+        end;
+//      Writeln('"',C,'" : IBC : ',IBC,' HB  : ',HB,' LQ  : ',LQ,' P>MaxCol : ',P>MaxCol);
+      end;
+    Result:=Result+Copy(L,1,P-1);
+    If Not HB then
+      Result:=Result+BreakStr;
+    Delete(L,1,P-1);
+    Len:=Length(L);
+    end;
+end;
+
+function WrapText(const Line: string; MaxCol: Integer): string;
+begin
+  Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol);
+end;
+  
+
 {
    Case Translation Tables
    Can be used in internationalization support.
@@ -2236,7 +2299,10 @@ const
 
 {
   $Log$
-  Revision 1.22  2004-12-01 10:34:46  michael
+  Revision 1.23  2004-12-19 17:55:38  michael
+  + Implemented wraptext
+
+  Revision 1.22  2004/12/01 10:34:46  michael
   + Patch from Pete: Dont support widestrings when compiled with 1.0.x and  Add additional typecasts to Widestring for widechar/pwidechar
 
   Revision 1.21  2004/11/30 20:56:27  michael

+ 6 - 1
rtl/objpas/sysutils/sysstrh.inc

@@ -181,6 +181,8 @@ Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;Ignore
 Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
 Function FindCmdLineSwitch(const Switch: string): Boolean;
 
+function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet;  MaxCol: Integer): string;
+function WrapText(const Line: string; MaxCol: Integer): string;
 
 
 {==============================================================================}
@@ -193,7 +195,10 @@ function BCDToInt(Value: integer): integer;
 
 {
   $Log$
-  Revision 1.10  2004-11-16 18:30:36  marco
+  Revision 1.11  2004-12-19 17:55:38  michael
+  + Implemented wraptext
+
+  Revision 1.10  2004/11/16 18:30:36  marco
    * updated ansiexctractquotedstring (more delphi compat, both interface and code)
 
   Revision 1.9  2004/08/30 13:07:03  michael