pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo: update the RichText loading script.

Browse Source 
added language conversion

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3738 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2014-11-17 19:10:40 +00:00
parent 6721996b7a
commit 73e1f3a793
6 changed files with 254 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/richmemo/richmemo.pas
View File

@ -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
Result := false;
end;
end;
function TCustomRichMemo.SaveRichText(Dest: TStream): Boolean;

21
components/richmemo/richmemopackage.lpk
View File

@ -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>

14
components/richmemo/richmemopackage.pas
View File

@ -1,21 +1,21 @@
{ 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.
}
unit richmemopackage;
unit richmemopackage;
interface
uses
RichMemoFactory, richmemoregister, LazarusPackageIntf;
RichMemoFactory, richmemoregister, RichMemoRTF, LazarusPackageIntf;
implementation
procedure Register;
procedure Register;
begin
RegisterUnit('richmemoregister', @richmemoregister.Register);
end;
RegisterUnit('richmemoregister', @richmemoregister.Register);
end;
initialization
RegisterPackage('richmemopackage', @Register);
RegisterPackage('richmemopackage', @Register);
end.

229
components/richmemo/richmemortf.pas
View File

@ -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);
case rtfMinor of
rtfOptDest: {skipping option generator};
else
txtbuf:=txtbuf+Self.GetRtfText;
txtlen:=length(txtbuf);
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;
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+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.

13
components/richmemo/rtfdata.inc
View File

@ -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),

3
components/richmemo/samples/testsimple/unit1.pas
View File

@ -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);