richmemo: update the RichText loading script.

added language conversion

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3738 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/richmemo/richmemo.pas

@@ -381,6 +381,7 @@ end;
 
 function TCustomRichMemo.LoadRichText(Source: TStream): Boolean;
 begin
+  Result:=false;
   if not HandleAllocated then HandleNeeded;
   if Assigned(Source) and HandleAllocated then begin
     if Assigned(RTFLoadStream) then begin
@@ -394,8 +395,7 @@ begin
     end;
     if not Result then
       Result := TWSCustomRichMemoClass(WidgetSetClass).LoadRichText(Self, Source);
-  end else
+  end;
-    Result := false;
 end;
 
 function TCustomRichMemo.SaveRichText(Dest: TStream): Boolean;

components/richmemo/richmemopackage.lpk

@@ -1,21 +1,26 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="3">
+  <Package Version="4">
     <PathDelim Value="\"/>
     <Name Value="richmemopackage"/>
+    <AddToProjectUsesSection Value="True"/>
     <Author Value="Dmitry 'skalogryz' Boyarintsev"/>
     <CompilerOptions>
-      <Version Value="8"/>
+      <Version Value="11"/>
       <PathDelim Value="\"/>
       <SearchPaths>
-        <OtherUnitFiles Value="win32\;carbon\;gtk2\"/>
+        <OtherUnitFiles Value="win32;carbon;gtk2"/>
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <UseAnsiStrings Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
       <Other>
         <CompilerMessages>
-          <IgnoredMessages idx4055="True" idx5024="True" idx5057="True" idx5060="True"/>
+          <IgnoredMessages idx5060="True" idx5057="True" idx5024="True" idx4055="True"/>
         </CompilerMessages>
-        <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
     <Description Value="RichMemo control. Implements cross-platfrom RichEdit control.
@@ -73,7 +78,6 @@
       </Item10>
       <Item11>
         <Filename Value="richmemortf.pas"/>
-        <AddToUsesPkgSection Value="False"/>
         <UnitName Value="RichMemoRTF"/>
       </Item11>
       <Item12>
@@ -98,5 +102,8 @@
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
     </PublishOptions>
+    <CustomOptions Items="ExternHelp" Version="2">
+      <_ExternHelp Items="Count"/>
+    </CustomOptions>
   </Package>
 </CONFIG>

components/richmemo/richmemopackage.pas

@@ -1,4 +1,4 @@
-{ This file was automatically created by Lazarus. do not edit!
+{ This file was automatically created by Lazarus. Do not edit!
   This source is only used to compile and install the package.
  }
 
@@ -7,7 +7,7 @@ unit richmemopackage;
 interface
 
 uses
-  RichMemoFactory, richmemoregister, LazarusPackageIntf;
+  RichMemoFactory, richmemoregister, RichMemoRTF, LazarusPackageIntf;
 
 implementation
 

components/richmemo/richmemortf.pas

@@ -2,14 +2,45 @@ unit RichMemoRTF;
 
 interface
 
+{$mode objfpc}{$h+}
+
 uses
-  Classes, SysUtils, LCLProc, LCLIntf,
+  Classes, SysUtils, LCLProc, LCLIntf, LConvEncoding,
   RichMemo, RTFParsPre211, Graphics;
 
 function MVCParserLoadStream(ARich: TCustomRichMemo; Source: TStream): Boolean;
+procedure RegisterRTFLoader;
+
+type
+  TEncConvProc = function (const s: string): string;
+
+procedure LangConvAdd(lang: Integer; convproc: TEncConvProc);
+function LangConvGet(lang: Integer; var convproc: TEncConvProc): Boolean;
 
 implementation
 
+var
+  LangConvTable : array of record lang: integer; proc: TEncConvProc end;
+  LangCount     : Integer = 0;
+
+procedure LangConvAdd(lang: Integer; convproc: TEncConvProc);
+var
+  i  : integer;
+begin
+  for i:=0 to LangCount-1 do
+    if LangConvTable[i].lang=lang then begin
+      LangConvTable[i].proc:=convproc;
+      Exit;
+    end;
+  if LangCount=length(LangConvTable) then begin
+    if LangCount=0 then SetLength(LangConvTable, 64)
+    else SetLength(LangConvTable, LangCount*2);
+  end;
+  LangConvTable[LangCount].lang:=lang;
+  LangConvTable[LangCount].proc:=convproc;
+  inc(LangCount);
+end;
+
 type
   { TRTFMemoParser }
 
@@ -24,6 +55,9 @@ type
     fnum: Integer;
     fsz : double;
     fst : TFontStyles;
+
+    lang   : Integer;
+    langproc : TEncConvProc;
   protected
     procedure classUnk;
     procedure classText;
@@ -43,6 +77,144 @@ type
     procedure StartReading;
   end;
 
+function LangConvGet(lang: Integer; var convproc: TEncConvProc): Boolean;
+var
+  i  : integer;
+begin
+  for i:=0 to LangCount-1 do
+    if LangConvTable[i].lang=lang then begin
+      convproc:=LangConvTable[i].proc;
+      Result:=true;
+      Exit;
+    end;
+  Result:=false;
+end;
+
+procedure LangConvInit;
+begin
+  LangConvAdd(1052, @CP1250ToUTF8); // Albanian
+  LangConvAdd(1050, @CP1250ToUTF8); // Croatian
+  LangConvAdd(1029, @CP1250ToUTF8); // Czech
+  LangConvAdd(1038, @CP1250ToUTF8); // Hungarian
+  LangConvAdd(1045, @CP1250ToUTF8); // Polish
+  LangConvAdd(1048, @CP1250ToUTF8); // Romanian
+  LangConvAdd(2074, @CP1250ToUTF8); // Serbian - Latin
+  LangConvAdd(1051, @CP1250ToUTF8); // Slovak
+  LangConvAdd(1060, @CP1250ToUTF8); // Slovenian
+
+  LangConvAdd(2092, @CP1251ToUTF8); // Azeri - Cyrillic
+  LangConvAdd(1059, @CP1251ToUTF8); // Belarusian
+  LangConvAdd(1026, @CP1251ToUTF8); // Bulgarian
+  LangConvAdd(1071, @CP1251ToUTF8); // FYRO Macedonia
+  LangConvAdd(1087, @CP1251ToUTF8); // Kazakh
+  LangConvAdd(1088, @CP1251ToUTF8); // Kyrgyz - Cyrillic
+  LangConvAdd(1104, @CP1251ToUTF8); // Mongolian
+  LangConvAdd(1049, @CP1251ToUTF8); // Russian
+  LangConvAdd(3098, @CP1251ToUTF8); // Serbian - Cyrillic
+  LangConvAdd(1092, @CP1251ToUTF8); // Tatar
+  LangConvAdd(1058, @CP1251ToUTF8); // Ukrainian
+  LangConvAdd(2115, @CP1251ToUTF8); // Uzbek - Cyrillic
+
+  LangConvAdd(1078, @CP1252ToUTF8); // Afrikaans
+  LangConvAdd(1069, @CP1252ToUTF8); // Basque
+  LangConvAdd(1027, @CP1252ToUTF8); // Catalan
+  LangConvAdd(1030, @CP1252ToUTF8); // Danish
+  LangConvAdd(2067, @CP1252ToUTF8); // Dutch - Belgium
+  LangConvAdd(1043, @CP1252ToUTF8); // Dutch - Netherlands
+  LangConvAdd(3081, @CP1252ToUTF8); // English - Australia
+  LangConvAdd(10249,@CP1252ToUTF8); // English - Belize
+  LangConvAdd(4105, @CP1252ToUTF8); // English - Canada
+  LangConvAdd(9225, @CP1252ToUTF8); // English - Caribbean
+  LangConvAdd(2057, @CP1252ToUTF8); // English - Great Britain
+  LangConvAdd(6153, @CP1252ToUTF8); // English - Ireland
+  LangConvAdd(8201, @CP1252ToUTF8); // English - Jamaica
+  LangConvAdd(5129, @CP1252ToUTF8); // English - New Zealand
+  LangConvAdd(13321,@CP1252ToUTF8); // English - Phillippines
+  LangConvAdd(7177, @CP1252ToUTF8); // English - Southern Africa
+  LangConvAdd(11273,@CP1252ToUTF8); // English - Trinidad
+  LangConvAdd(1033, @CP1252ToUTF8); // English - United States
+  LangConvAdd(12297,@CP1252ToUTF8); // English - Zimbabwe
+  LangConvAdd(1080, @CP1252ToUTF8); // Faroese
+  LangConvAdd(1035, @CP1252ToUTF8); // Finnish
+  LangConvAdd(2060, @CP1252ToUTF8); // French - Belgium
+  LangConvAdd(3084, @CP1252ToUTF8); // French - Canada
+  LangConvAdd(1036, @CP1252ToUTF8); // French - France
+  LangConvAdd(5132, @CP1252ToUTF8); // French - Luxembourg
+  LangConvAdd(6156, @CP1252ToUTF8); // French - Monaco
+  LangConvAdd(4108, @CP1252ToUTF8); // French - Switzerland
+  LangConvAdd(1110, @CP1252ToUTF8); // Galician
+  LangConvAdd(3079, @CP1252ToUTF8); // German - Austria
+  LangConvAdd(1031, @CP1252ToUTF8); // German - Germany
+  LangConvAdd(5127, @CP1252ToUTF8); // German - Liechtenstein
+  LangConvAdd(4103, @CP1252ToUTF8); // German - Luxembourg
+  LangConvAdd(2055, @CP1252ToUTF8); // German - Switzerland
+  LangConvAdd(1039, @CP1252ToUTF8); // Icelandic
+  LangConvAdd(1057, @CP1252ToUTF8); // Indonesian
+  LangConvAdd(1040, @CP1252ToUTF8); // Italian - Italy
+  LangConvAdd(2064, @CP1252ToUTF8); // Italian - Switzerland
+  LangConvAdd(2110, @CP1252ToUTF8); // Malay - Brunei
+  LangConvAdd(1086, @CP1252ToUTF8); // Malay - Malaysia
+  LangConvAdd(1044, @CP1252ToUTF8); // Norwegian - Bokml
+  LangConvAdd(2068, @CP1252ToUTF8); // Norwegian - Nynorsk
+  LangConvAdd(1046, @CP1252ToUTF8); // Portuguese - Brazil
+  LangConvAdd(2070, @CP1252ToUTF8); // Portuguese - Portugal
+  LangConvAdd(1274, @CP1252ToUTF8); // Spanish - Argentina
+  LangConvAdd(16394,@CP1252ToUTF8); // Spanish - Bolivia
+  LangConvAdd(13322,@CP1252ToUTF8); // Spanish - Chile
+  LangConvAdd(9226, @CP1252ToUTF8); // Spanish - Colombia
+  LangConvAdd(5130, @CP1252ToUTF8); // Spanish - Costa Rica
+  LangConvAdd(7178, @CP1252ToUTF8); // Spanish - Dominican Republic
+  LangConvAdd(12298,@CP1252ToUTF8); // Spanish - Ecuador
+  LangConvAdd(17418,@CP1252ToUTF8); // Spanish - El Salvador
+  LangConvAdd(4106, @CP1252ToUTF8); // Spanish - Guatemala
+  LangConvAdd(18442,@CP1252ToUTF8); // Spanish - Honduras
+  LangConvAdd(2058, @CP1252ToUTF8); // Spanish - Mexico
+  LangConvAdd(19466,@CP1252ToUTF8); // Spanish - Nicaragua
+  LangConvAdd(6154, @CP1252ToUTF8); // Spanish - Panama
+  LangConvAdd(15370,@CP1252ToUTF8); // Spanish - Paraguay
+  LangConvAdd(10250,@CP1252ToUTF8); // Spanish - Peru
+  LangConvAdd(20490,@CP1252ToUTF8); // Spanish - Puerto Rico
+  LangConvAdd(1034, @CP1252ToUTF8); // Spanish - Spain (Traditional)
+  LangConvAdd(14346,@CP1252ToUTF8); // Spanish - Uruguay
+  LangConvAdd(8202, @CP1252ToUTF8); // Spanish - Venezuela
+  LangConvAdd(1089, @CP1252ToUTF8); // Swahili
+  LangConvAdd(2077, @CP1252ToUTF8); // Swedish - Finland
+  LangConvAdd(1053, @CP1252ToUTF8); // Swedish - Sweden
+
+  LangConvAdd(1032, @CP1253ToUTF8); // greek
+
+  LangConvAdd(1068, @CP1254ToUTF8); // Azeri - Latin
+  LangConvAdd(1055, @CP1254ToUTF8); // turkish
+  LangConvAdd(1091, @CP1254ToUTF8); // Uzbek - Latin
+
+  LangConvAdd(1037, @CP1255ToUTF8); // hebrew
+
+  LangConvAdd(5121, @CP1256ToUTF8); // Arabic - Algeria
+  LangConvAdd(15361,@CP1256ToUTF8); // Arabic - Bahrain
+  LangConvAdd(3073, @CP1256ToUTF8); // Arabic - Egypt
+  LangConvAdd(2049, @CP1256ToUTF8); // Arabic - Iraq
+  LangConvAdd(11265,@CP1256ToUTF8); // Arabic - Jordan
+  LangConvAdd(13313,@CP1256ToUTF8); // Arabic - Kuwait
+  LangConvAdd(12289,@CP1256ToUTF8); // Arabic - Lebanon
+  LangConvAdd(4097, @CP1256ToUTF8); // Arabic - Libya
+  LangConvAdd(6145, @CP1256ToUTF8); // Arabic - Morocco
+  LangConvAdd(8193, @CP1256ToUTF8); // Arabic - Oman
+  LangConvAdd(16385,@CP1256ToUTF8); // Arabic - Qatar
+  LangConvAdd(1025, @CP1256ToUTF8); // Arabic - Saudi Arabia
+  LangConvAdd(10241,@CP1256ToUTF8); // Arabic - Syria
+  LangConvAdd(7169, @CP1256ToUTF8); // Arabic - Tunisia
+  LangConvAdd(14337,@CP1256ToUTF8); // Arabic - United Arab Emirates
+  LangConvAdd(9217, @CP1256ToUTF8); // Arabic - Yemen
+  LangConvAdd(1065, @CP1256ToUTF8); // Farsi - Persian
+  LangConvAdd(1056, @CP1256ToUTF8); // Urdu
+
+  LangConvAdd(1061, @CP1257ToUTF8); // Estonian
+  LangConvAdd(1062, @CP1257ToUTF8); // Latvian
+  LangConvAdd(1063, @CP1257ToUTF8); // Lithuanian
+
+  LangConvAdd(1066, @CP1258ToUTF8); // vietnam
+end;
+
 { TRTFMemoParserr }
 
 procedure TRTFMemoParser.classUnk;
@@ -50,21 +222,46 @@ begin
   //writelN('unk: ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ', GetRtfText);
 end;
 
-procedure TRTFMemoParser.classText;
+function CharToByte(const ch: AnsiChar): Byte;
 begin
-  //writeln('txt:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ',Self.GetRtfText);
+  Result:=0;
+  if ch in ['0'..'9'] then Result:=byte(ch)-byte('0')
+  else if ch in ['a'..'f'] then Result:=byte(ch)-byte('a')+10
+  else if ch in ['A'..'F'] then Result:=byte(ch)-byte('A')+10
+end;
+
+function RTFCharToByte(const s: string): byte; inline;
+begin
+  // \'hh 	A hexadecimal value, based on the specified character set (may be used to identify 8-bit values).
+  Result:=(CharToByte(s[3]) shl 4) or (CharToByte(s[4]));
+end;
+
+procedure TRTFMemoParser.classText;
+var
+  txt : string;
+  bt  : Char;
+begin
+  txt:=Self.GetRtfText;
+  //writeln('txt:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ',);
+  if (length(txt)=4) and (txt[1]='\') and (txt[2]=#39) then begin
+    if Assigned(langproc) then begin
+      bt:=char(RTFCharToByte(txt));
+      txtbuf:=txtbuf+langproc(bt);
+      txtlen:=length(txtbuf);
+    end;
+  end else
     case rtfMinor of
       rtfOptDest: {skipping option generator};
     else
-    txtbuf:=txtbuf+Self.GetRtfText;
+      txtbuf:=txtbuf+txt;
       txtlen:=length(txtbuf);
-
     end;
 end;
 
 procedure TRTFMemoParser.classControl;
 begin
-  if txtbuf<>'' then PushText;
+  if txtbuf<>'' then
+    PushText;
   //writeln('ctrl: ', rtfClass,' ', rtfMajor, ' ', Self.GetRtfText, ' ',rtfMinor,' ', rtfParam);
   case rtfMajor of
     rtfSpecialChar: doSpecialChar;
@@ -106,6 +303,11 @@ begin
     rtfSpaceBefore:  pm.SpaceBefore := aparam / 20;
     rtfSpaceAfter:   pm.SpaceAfter  := aparam / 20;
     rtfSpaceBetween: pm.LineSpacing := aparam / 240;
+    rtfLanguage: begin
+      lang:=rtfParam;
+      langproc:=nil;
+      LangConvGet(lang, langproc);
+    end;
   end;
 end;
 
@@ -236,7 +438,12 @@ begin
   Result:=True;
 end;
 
-initialization
+procedure RegisterRTFLoader;
+begin
   RTFLoadStream:=@MVCParserLoadStream;
+  LangConvInit;
+end;
+
+initialization
 
 end.

components/richmemo/rtfdata.inc

@@ -119,7 +119,10 @@ const
     rtfIComment             = 34;
     rtfIVersion             = 35;
     rtfIDoccomm             = 36;
-    rtfMaxDestination       = 37    { highest dest + 1 };
+
+    rtfDefaultLanguage      = 37;
+
+    rtfMaxDestination       = 38    { highest dest + 1 };
 
   rtfFontFamily   = 4;
     rtfFFNil                = 0;
@@ -304,6 +307,8 @@ const
     rtfLeaderHyphen         = 38;
     rtfLeaderUnder          = 39;
     rtfLeaderThick          = 40;
+    //
+    rtfLanguage             = 41;
 
   rtfCharAttr     = 12;
     rtfPlain                = 0;
@@ -463,7 +468,7 @@ type
   ---------------------------------------------------------------------}
 
 const
-  rtfKey : Array [0..281] of TRTFKey =
+  rtfKey : Array [0..283] of TRTFKey =
   (
     ( rtfKMajor: RTFSPECIALCHAR; rtfKMinor : rtfCURHEADPICT; rtfKStr  : 'chpict'; rtfKhash :        0),
     ( rtfKMajor: rtfSpecialChar; rtfKMinor:         rtfCurHeadDate; rtfKstr : 'chdate'; rtfkHash : 0),
@@ -570,6 +575,8 @@ const
     ( rtfKMajor: rtfParAttr; rtfKMinor:     rtfLeaderThick; rtfKstr : 'tlth'; rtfkHash : 0),
     ( rtfKMajor: rtfParAttr; rtfKMinor:     rtfBorderSpace; rtfKstr : 'brsp'; rtfkHash : 0),
 
+    ( rtfKMajor: rtfParAttr; rtfKMinor:     rtfLanguage; rtfKstr : 'lang'; rtfkHash : 0),
+
     ( rtfKMajor: rtfSectAttr; rtfKMinor:    rtfSectDef; rtfKstr : 'sectd'; rtfkHash : 0),
     ( rtfKMajor: rtfSectAttr; rtfKMinor:    rtfNoBreak; rtfKstr : 'sbknone'; rtfkHash : 0),
     ( rtfKMajor: rtfSectAttr; rtfKMinor:    rtfColBreak; rtfKstr : 'sbkcol'; rtfkHash : 0),
@@ -701,6 +708,8 @@ const
     ( rtfKMajor: rtfDestination; rtfKMinor:         rtfIVersion; rtfKstr : 'version'; rtfkHash : 0),
     ( rtfKMajor: rtfDestination; rtfKMinor:         rtfIDoccomm; rtfKstr : 'doccomm'; rtfkHash : 0),
 
+    ( rtfKMajor: rtfDestination; rtfKMinor:         rtfDefaultLanguage; rtfKstr : 'deflang'; rtfkHash : 0),
+
     ( rtfKMajor: rtfTOCAttr; rtfKMinor:     rtfTOCType; rtfKstr : 'tcf'; rtfkHash : 0),
     ( rtfKMajor: rtfTOCAttr; rtfKMinor:     rtfTOCLevel; rtfKstr : 'tcl'; rtfkHash : 0),
 

components/richmemo/samples/testsimple/unit1.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, LCLIntf, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   StdCtrls, ExtCtrls, ComCtrls, Spin,
-  RichMemo, RichMemoRTF, Win32RichMemo;
+  RichMemo, RichMemoRTF;
 
 type
 
@@ -201,6 +201,7 @@ end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
+  RegisterRTFLoader;
 end;
 
 procedure TForm1.RichMemo1Change(Sender: TObject);