من زياد با دلفي كار نكردم اما تو تنظيماتش قسمتي بنام bidirection است تمام تو اون قسمت بايد يه كاري كرد
اين كد هم شايد بدردتان بخوره براي Unicode توي دلفي است(كد را من ننوشتم شحص ديگري نوشته است)
كد برنامه بعلت ححم زياد توي كادر Code فعال نميشه تو 3 قسمت ميكنم
قسمت 1
کد:
{$INCLUDE ..\cDefines.inc}
unit cUnicodeCodecs;
interface
const
UnitName = 'cUnicodeCodecs';
UnitVersion = '3.06';
UnitDesc = 'Unicode codecs';
{ }
{ WideChar character conversion functions }
{ }
{$IFDEF DELPHI5}
type
UCS4Char = LongWord;
{$ENDIF}
function ASCIIToWideChar(const P: Char): WideChar;
function ISO8859_1ToWideChar(const P: Char): WideChar;
function ISO8859_2ToWideChar(const P: Char): WideChar;
function ISO8859_3ToWideChar(const P: Char): WideChar;
function ISO8859_4ToWideChar(const P: Char): WideChar;
function ISO8859_5ToWideChar(const P: Char): WideChar;
function ISO8859_6ToWideChar(const P: Char): WideChar;
function ISO8859_7ToWideChar(const P: Char): WideChar;
function ISO8859_8ToWideChar(const P: Char): WideChar;
function ISO8859_9ToWideChar(const P: Char): WideChar;
function ISO8859_10ToWideChar(const P: Char): WideChar;
function ISO8859_13ToWideChar(const P: Char): WideChar;
function ISO8859_14ToWideChar(const P: Char): WideChar;
function ISO8859_15ToWideChar(const P: Char): WideChar;
function KOI8_RToWideChar(const P: Char): WideChar;
function MacLatin2ToWideChar(const P: Char): WideChar;
function MacRomanToWideChar(const P: Char): WideChar;
function MacCyrillicToWideChar(const P: Char): WideChar;
function CP437ToWideChar(const P: Char): WideChar;
function Win1250ToWideChar(const P: Char): WideChar;
function Win1251ToWideChar(const P: Char): WideChar;
function Win1252ToWideChar(const P: Char): WideChar;
function EBCDIC_USToWideChar(const P: Char): WideChar;
type
TUTF8Error = (
UTF8ErrorNone,
UTF8ErrorInvalidEncoding,
UTF8ErrorIncompleteEncoding,
UTF8ErrorInvalidBuffer,
UTF8ErrorOutOfRange);
function UTF8ToUCS4Char(const P: PChar; const Size: Integer;
var SeqSize: Integer; var Ch: UCS4Char): TUTF8Error;
function UTF8ToWideChar(const P: PChar; const Size: Integer;
var SeqSize: Integer; var Ch: WideChar): TUTF8Error;
function WideCharToASCII(const Ch: WideChar): Char;
function WideCharToISO8859_1(const Ch: WideChar): Char;
function WideCharToISO8859_2(const Ch: WideChar): Char;
function WideCharToISO8859_3(const Ch: WideChar): Char;
function WideCharToISO8859_4(const Ch: WideChar): Char;
function WideCharToISO8859_5(const Ch: WideChar): Char;
function WideCharToISO8859_6(const Ch: WideChar): Char;
function WideCharToISO8859_7(const Ch: WideChar): Char;
function WideCharToISO8859_8(const Ch: WideChar): Char;
function WideCharToISO8859_9(const Ch: WideChar): Char;
function WideCharToISO8859_10(const Ch: WideChar): Char;
function WideCharToISO8859_13(const Ch: WideChar): Char;
function WideCharToISO8859_14(const Ch: WideChar): Char;
function WideCharToISO8859_15(const Ch: WideChar): Char;
function WideCharToKOI8_R(const Ch: WideChar): Char;
function WideCharToMacLatin2(const Ch: WideChar): Char;
function WideCharToMacRoman(const Ch: WideChar): Char;
function WideCharToMacCyrillic(const Ch: WideChar): Char;
function WideCharToCP437(const Ch: WideChar): Char;
function WideCharToWin1250(const Ch: WideChar): Char;
function WideCharToWin1251(const Ch: WideChar): Char;
function WideCharToWin1252(const Ch: WideChar): Char;
function WideCharToEBCDIC_US(const Ch: WideChar): Char;
procedure UCS4CharToUTF8(const Ch: UCS4Char; const Dest: Pointer;
const DestSize: Integer; var SeqSize: Integer);
procedure WideCharToUTF8(const Ch: WideChar; const Dest: Pointer;
const DestSize: Integer; var SeqSize: Integer);
{ }
{ ASCII String functions }
{ }
function IsASCIIString(const S: String): Boolean;
function IsASCIIWideBuf(const Buf: PWideChar; const Len: Integer): Boolean;
function IsASCIIWideString(const S: WideString): Boolean;
{ }
{ Long string functions }
{ }
procedure LongToWide(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer);
function LongStringToWideString(const S: String): WideString;
procedure WideToLong(const Buf: Pointer; const Len: Integer;
const DestBuf: Pointer);
function WideToLongString(const P: PWideChar; const Len: Integer): String;
function WideStringToLongString(const S: WideString): String;
{ }
{ UTF-8 string functions }
{ }
function UTF8CharSize(const P: PChar; const Size: Integer): Integer;
function UTF8BufLength(const P: PChar; const Size: Integer): Integer;
function UTF8StringLength(const S: String): Integer;
function UTF8StringToWideString(const S: String): WideString;
function UTF8StringToLongString(const S: String): String;
function UCS4CharToUTF8CharSize(const Ch: UCS4Char): Integer;
function WideBufToUTF8Size(const Buf: PWideChar; const Len: Integer): Integer;
function WideStringToUTF8Size(const S: WideString): Integer;
function WideBufToUTF8String(const Buf: PWideChar; const Len: Integer): String;
function WideStringToUTF8String(const S: WideString): String;
function LongBufToUTF8Size(const Buf: PChar; const Len: Integer): Integer;
function LongStringToUTF8Size(const S: String): Integer;
function LongStringToUTF8String(const S: String): String;
function UCS4CharToUTF8String(const Ch: UCS4Char): String;
function ISO8859_1StringToUTF8String(const S: String): String;
function DetectUTF8Encoding(const P: PChar; const Size: Integer;
var HeaderSize: Integer): Boolean;
{ }
{ UTF-16 functions }
{ }
function DetectUTF16Encoding(const P: PChar; const Size: Integer;
var SwapEndian: Boolean; var HeaderSize: Integer): Boolean;
function SwapUTF16Endian(const P: WideChar): WideChar;
{ }
{ WideString functions }
{ }
function CharToWideChar(const P: Char): WideChar;
function WideCharsToWideString(const Chars: Array of WideChar): WideString;
procedure ISO8859ToWide(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer);
function ISO8859_1StringToWideString(const S: String): WideString;
function IsWideSpace(const Ch: WideChar): Boolean;
function IsWideControl(const Ch: WideChar): Boolean;
function IsWideWhiteSpace(const Ch: WideChar): Boolean;
{ }
{ Unicode codec classes }
{ AUnicodeCodec is the base class for Unicode Codec implementations. }
{ }
type
TUnicodeCodecType = (
ucCustom,
ucASCII,
ucISO8859_1, ucISO8859_2, ucISO8859_3, ucISO8859_4, ucISO8859_5,
ucISO8859_6, ucISO8859_7, ucISO8859_8, ucISO8859_9, ucISO8859_10,
ucISO8859_13, ucISO8859_14, ucISO8859_15,
ucKOI8_R,
ucMacLatin2, ucMacRoman, ucMacCyrillic,
ucCP437,
ucWin1250, ucWin1251, ucWin1252,
ucEBCDIC_US,
ucUTF8, ucUTF16, ucUTF16RE);
TCodecErrorAction = (eaException, eaStop, eaIgnore, eaSkip, eaReplace);
AUnicodeCodec = class
protected
FErrorAction : TCodecErrorAction;
FDecodeReplaceChar : WideChar;
procedure Init; virtual;
public
class function GetUnicodeCodecType: TUnicodeCodecType; virtual; abstract;
class function GetAliasCount: Integer; virtual; abstract;
class function GetAliasByIndex(const Idx: Integer): String; virtual; abstract;
constructor Create; virtual;
property ErrorAction: TCodecErrorAction read FErrorAction write FErrorAction;
property DecodeReplaceChar: WideChar read FDecodeReplaceChar write FDecodeReplaceChar;
procedure Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer); virtual; abstract;
function Encode(const S: PWideChar; const Length: Integer;
var ProcessedChars: Integer): String; virtual; abstract;
procedure DecodeStr(const Buf: Pointer; const BufSize: Integer;
var Dest: WideString; var ProcessedBytes: Integer);
function EncodeStr(const S: WideString;
var ProcessedChars: Integer): String;
end;
TUnicodeCodecClass = class of AUnicodeCodec;
{ }
{ Unicode codec classes }
{ }
type
AByteCodec = class(AUnicodeCodec)
public
function DecodeChar(const P: Char): WideChar; virtual; abstract;
function EncodeChar(const Ch: WideChar): Char; virtual; abstract;
procedure Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer); override;
function Encode(const S: PWideChar; const Length: Integer;
var ProcessedChars: Integer): String; override;
end;
TASCIICodec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_1Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
procedure Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer); override;
end;
TISO8859_2Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_3Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_4Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_5Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_6Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_7Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_8Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_9Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_10Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_13Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_14Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TISO8859_15Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TKOI8_RCodec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TMacLatin2Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TMacRomanCodec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TMacCyrillicCodec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TCP437Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TWin1250Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TWin1251Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TWin1252Codec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TEBCDIC_USCodec = class(AByteCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
function DecodeChar(const P: Char): WideChar; override;
function EncodeChar(const Ch: WideChar): Char; override;
end;
TUTF8Codec = class(AUnicodeCodec)
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
procedure Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer); override;
function Encode(const S: PWideChar; const Length: Integer;
var ProcessedChars: Integer): String; override;
end;
TUTF16Codec = class(AUnicodeCodec) // UTF-16 System Endian
protected
FSwapEndian : Boolean;
procedure Init; override;
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
procedure Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer); override;
function Encode(const S: PWideChar; const Length: Integer;
var ProcessedChars: Integer): String; override;
end;
TUTF16RECodec = class(TUTF16Codec) // UTF-16 Reverse Endian
protected
procedure Init; override;
public
class function GetUnicodeCodecType: TUnicodeCodecType; override;
class function GetAliasCount: Integer; override;
class function GetAliasByIndex(const Idx: Integer): String; override;
end;
function GetUnicodeCodecClassByType(const CodecType: TUnicodeCodecType): TUnicodeCodecClass;
function GetUnicodeCodecTypeByName(const Name: String): TUnicodeCodecType;
function GetUnicodeCodecClassByName(const Name: String): TUnicodeCodecClass;
{ }
{ Unicode conversion functions }
{ }
function DetectUnicodeEncoding(const Buf: Pointer;
const BufSize: Integer; var HeaderSize: Integer;
var Codec: TUnicodeCodecType): Boolean;
function DecodeUnicodeEncoding(const CodecClass: TUnicodeCodecClass;
const Buf: Pointer; const BufSize: Integer;
var ProcessedBytes: Integer): WideString; overload;
function DecodeUnicodeEncoding(const Codec: TUnicodeCodecType;
const Buf: Pointer; const BufSize: Integer;
var ProcessedBytes: Integer): WideString; overload;
function EncodeUnicodeEncoding(const CodecClass: TUnicodeCodecClass;
const S: WideString; var ProcessedChars: Integer): String; overload;
function EncodeUnicodeEncoding(const Codec: TUnicodeCodecType;
const S: WideString; var ProcessedChars: Integer): String; overload;
{ }
{ Self-testing code }
{ }
procedure SelfTest;
implementation
uses
{ Delphi }
SysUtils,
{ Fundamentals }
cUtils;
{ }
{ WideString functions }
{ }
function CharToWideChar(const P: Char): WideChar;
begin
Result := WideChar(Ord(P));
end;
function WideCharsToWideString(const Chars: Array of WideChar): WideString;
var L: Integer;
begin
L := Length(Chars);
SetLength(Result, L);
if L = 0 then
exit;
Move(Chars, Pointer(Result)^, Sizeof(WideChar) * L);
end;
function IsWideSpace(const Ch: WideChar): Boolean;
begin
Case Ch of
#$0009..#$000D, // ASCII CONTROL
#$0020, // SPACE
#$0085, // <control>
#$00A0, // NO-BREAK SPACE
#$1680, // OGHAM SPACE MARK
#$2000..#$200A, // EN QUAD..HAIR SPACE
#$2028, // LINE SEPARATOR
#$2029, // PARAGRAPH SEPARATOR
#$202F, // NARROW NO-BREAK SPACE
#$3000 : // IDEOGRAPHIC SPACE
Result := True;
else
Result := False;
end;
end;
function IsWideControl(const Ch: WideChar): Boolean;
begin
Case Ch of
#$0000..#$001F,
#$007F..#$009F :
Result := True;
else
Result := False;
end;
end;
function IsWideWhiteSpace(const Ch: WideChar): Boolean;
begin
Result := IsWideControl(Ch) or IsWideSpace(Ch);
end;
{ }
{ AUnicodeCodec }
{ }
constructor AUnicodeCodec.Create;
begin
inherited Create;
Init;
end;
procedure AUnicodeCodec.Init;
begin
FErrorAction := eaException;
FDecodeReplaceChar := WideChar(#$FFFD);
end;
procedure AUnicodeCodec.DecodeStr(const Buf: Pointer; const BufSize: Integer;
var Dest: WideString; var ProcessedBytes: Integer);
var P: PChar;
Q: PWideChar;
L, M, I, J: Integer;
begin
P := Buf;
L := BufSize;
if not Assigned(P) or (L <= 0) then
begin
Dest := '';
ProcessedBytes := 0;
exit;
end;
SetLength(Dest, BufSize);
M := 0;
Repeat
Q := Pointer(Dest);
Inc(Q, M);
Decode(P, L, Q, BufSize * Sizeof(WideChar), I, J);
Dec(L, I);
Inc(P, I);
Inc(M, J);
if (J < BufSize) or (L <= 0) then
break;
SetLength(Dest, M + BufSize);
Until False;
if Length(Dest) <> M then
SetLength(Dest, M);
ProcessedBytes := BufSize - L;
end;
function AUnicodeCodec.EncodeStr(const S: WideString; var ProcessedChars: Integer): String;
begin
Result := Encode(Pointer(S), Length(S), ProcessedChars);
end;
{ }
{ AByteCodec }
{ }
procedure AByteCodec.Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer);
var P: PChar;
Q: PWideChar;
I, L, C: Integer;
begin
P := Buf;
Q := DestBuf;
C := DestSize div Sizeof(WideChar);
if not Assigned(P) or (BufSize <= 0) or not Assigned(Q) or (C <= 0) then
begin
ProcessedBytes := 0;
DestLength := 0;
exit;
end;
L := 0;
For I := 1 to BufSize do
try
if L >= C then
break;
Q^ := DecodeChar(P^);
Inc(P);
Inc(Q);
Inc(L);
except
Case FErrorAction of
eaException : raise;
eaStop : break;
eaSkip:
Inc(P);
eaIgnore:
begin
Q^ := WideChar(P^);
Inc(P);
Inc(Q);
Inc(L);
end;
eaReplace:
begin
Q^ := FDecodeReplaceChar;
Inc(P);
Inc(Q);
Inc(L);
end;
end;
end;
DestLength := L;
ProcessedBytes := P - Buf;
end;
function AByteCodec.Encode(const S: PWideChar; const Length: Integer;
var ProcessedChars: Integer): String;
var P: PChar;
Q: PWideChar;
I, L: Integer;
begin
Q := S;
if not Assigned(Q) or (Length <= 0) then
begin
ProcessedChars := 0;
Result := '';
exit;
end;
SetLength(Result, Length);
L := 0;
P := Pointer(Result);
For I := 1 to Length do
try
P^ := EncodeChar(Q^);
Inc(P);
Inc(Q);
Inc(L);
except
Case FErrorAction of
eaException : raise;
eaStop : break;
eaSkip:
begin
Inc(Q);
Inc(L);
end;
eaIgnore:
begin
P^ := Char(Q^);
Inc(P);
Inc(Q);
Inc(L);
end;
eaReplace:
begin
P^ := Char(FDecodeReplaceChar);
Inc(P);
Inc(Q);
Inc(L);
end;
end;
end;
ProcessedChars := L;
end;
{ }
{ ASCII }
{ }
const
ASCIIAliases = 15;
ASCIIAlias: Array[0..ASCIIAliases - 1] of String = (
'ASCII', 'US-ASCII', 'us',
'ANSI_X3.4-1968', 'ANSI_X3.4-1986', 'iso-ir-6',
'ISO_646.irv:1991', 'ISO_646.irv', 'ISO_646',
'ISO-646', 'ISO646', 'ISO646-US',
'IBM367', 'cp367', 'csASCII');
function ASCIIToWideChar(const P: Char): WideChar;
begin
if Ord(P) >= $80 then
raise EConvertError.Create('Invalid ASCII encoding');
Result := WideChar(Ord(P));
end;
function WideCharToASCII(const Ch: WideChar): Char;
begin
if Ord(Ch) >= $80 then
raise EConvertError.Create('Can not convert to ASCII');
Result := Char(Ord(Ch));
end;
function IsASCIIString(const S: String): Boolean;
var I: Integer;
P: PChar;
begin
P := Pointer(S);
For I := 1 to Length(S) do
if Ord(P^) >= $80 then
begin
Result := False;
exit;
end else
Inc(P);
Result := True;
end;
function IsASCIIWideBuf(const Buf: PWideChar; const Len: Integer): Boolean;
var I: Integer;
P: PWideChar;
begin
P := Buf;
For I := 1 to Len do
if Ord(P^) >= $80 then
begin
Result := False;
exit;
end else
Inc(P);
Result := True;
end;
function IsASCIIWideString(const S: WideString): Boolean;
begin
Result := IsASCIIWideBuf(Pointer(S), Length(S));
end;
procedure LongToWide(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer);
var I: Integer;
P: Pointer;
Q: Pointer;
V: LongWord;
begin
if BufSize <= 0 then
exit;
P := Buf;
Q := DestBuf;
For I := 1 to BufSize div 4 do
begin
// convert 4 characters per iteration
V := PLongWord(P)^;
Inc(PLongWord(P));
PLongWord(Q)^ := (V and $FF) or ((V and $FF00) shl 8);
Inc(PLongWord(Q));
V := V shr 16;
PLongWord(Q)^ := (V and $FF) or ((V and $FF00) shl 8);
Inc(PLongWord(Q));
end;
// convert remaining (<4)
For I := 1 to BufSize mod 4 do
begin
PWord(Q)^ := PByte(P)^;
Inc(PByte(P));
Inc(PWord(Q));
end;
end;
function LongStringToWideString(const S: String): WideString;
var L: Integer;
begin
L := Length(S);
SetLength(Result, L);
if L = 0 then
exit;
LongToWide(Pointer(S), L, Pointer(Result));
end;
procedure WideToLong(const Buf: Pointer; const Len: Integer;
const DestBuf: Pointer);
var I: Integer;
S: PWideChar;
Q: PChar;
V: LongWord;
W: Word;
begin
if Len <= 0 then
exit;
S := Buf;
Q := DestBuf;
For I := 1 to Len div 2 do
begin
// convert 2 characters per iteration
V := PLongWord(S)^;
if V and $FF00FF00 <> 0 then
raise EConvertError.Create('Can not convert to long string');
Q^ := Char(V);
Inc(Q);
Q^ := Char(V shr 16);
Inc(Q);
Inc(S, 2);
end;
// convert remaining character
if Len mod 2 = 1 then
begin
W := Ord(S^);
if W > $FF then
raise EConvertError.Create('Can not convert to long string');
Q^ := Char(W);
end;
end;
function WideToLongString(const P: PWideChar; const Len: Integer): String;
var I: Integer;
S: PWideChar;
Q: PChar;
V: WideChar;
begin
if Len <= 0 then
begin
Result := '';
exit;
end;
SetLength(Result, Len);
S := P;
Q := Pointer(Result);
For I := 1 to Len do
begin
V := S^;
if Ord(V) > $FF then
raise EConvertError.Create('Can not convert to long string');
Q^ := Char(Byte(V));
Inc(S);
Inc(Q);
end;
end;
function WideStringToLongString(const S: WideString): String;
begin
Result := WideToLongString(Pointer(S), Length(S));
end;
class function TASCIICodec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucASCII;
end;
class function TASCIICodec.GetAliasCount: Integer;
begin
Result := ASCIIAliases;
end;
class function TASCIICodec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ASCIIAlias[Idx];
end;
function TASCIICodec.DecodeChar(const P: Char): WideChar;
begin
Result := ASCIIToWideChar(P);
end;
function TASCIICodec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToASCII(Ch);
end;
{ }
{ ISO-8859-1 - Latin 1 }
{ Western Europe and Americas: Afrikaans, Basque, Catalan, Danish, Dutch, }
{ English, Faeroese, Finnish, French, Galician, German, Icelandic, Irish, }
{ Italian, Norwegian, Portuguese, Spanish and Swedish. }
{ Default for HTTP Protocol }
{ }
const
ISO8859_1Aliases = 8;
ISO8859_1Alias: Array[0..ISO8859_1Aliases - 1] of String = (
'ISO-8859-1', 'ISO_8859-1:1987', 'ISO_8859-1',
'iso-ir-100', 'latin1', 'l1', 'IBM819', 'cp819');
function ISO8859_1ToWideChar(const P: Char): WideChar;
begin
Result := WideChar(Ord(P));
end;
function WideCharToISO8859_1(const Ch: WideChar): Char;
begin
if Ord(Ch) >= $100 then
raise EConvertError.Create('Can not convert to ISO-8859-1');
Result := Char(Ord(Ch));
end;
procedure ISO8859ToWide(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer);
begin
LongToWide(Buf, BufSize, DestBuf);
end;
function ISO8859_1StringToWideString(const S: String): WideString;
var L: Integer;
begin
L := Length(S);
SetLength(Result, L);
if L = 0 then
exit;
ISO8859ToWide(Pointer(S), L, Pointer(Result));
end;
class function TISO8859_1Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_1;
end;
class function TISO8859_1Codec.GetAliasCount: Integer;
begin
Result := ISO8859_1Aliases;
end;
class function TISO8859_1Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_1Alias[Idx];
end;
function TISO8859_1Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_1ToWideChar(P);
end;
function TISO8859_1Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_1(Ch);
end;
procedure TISO8859_1Codec.Decode(const Buf: Pointer; const BufSize: Integer;
const DestBuf: Pointer; const DestSize: Integer;
var ProcessedBytes, DestLength: Integer);
var L, C: Integer;
begin
L := BufSize;
C := DestSize div Sizeof(WideChar);
if C < L then
L := C;
if L < 0 then
L := 0;
ProcessedBytes := L;
DestLength := L;
ISO8859ToWide(Buf, L, DestBuf);
end;
{ }
{ ISO-8859-2 Latin 2 }
{ Latin-written Slavic and Central European languages: Czech, German, }
{ Hungarian, Polish, Romanian, Croatian, Slovak, Slovene. }
{ }
const
ISO8859_2Aliases = 6;
ISO8859_2Alias: Array[0..ISO8859_2Aliases - 1] of String = (
'ISO-8859-2', 'ISO_8859-2:1987', 'ISO_8859-2',
'iso-ir-101', 'latin2', 'l2');
const
ISO8859_2Map: Array[$A0..$FF] of WideChar = (
#$00A0, #$0104, #$02D8, #$0141, #$00A4, #$013D, #$015A, #$00A7,
#$00A8, #$0160, #$015E, #$0164, #$0179, #$00AD, #$017D, #$017B,
#$00B0, #$0105, #$02DB, #$0142, #$00B4, #$013E, #$015B, #$02C7,
#$00B8, #$0161, #$015F, #$0165, #$017A, #$02DD, #$017E, #$017C,
#$0154, #$00C1, #$00C2, #$0102, #$00C4, #$0139, #$0106, #$00C7,
#$010C, #$00C9, #$0118, #$00CB, #$011A, #$00CD, #$00CE, #$010E,
#$0110, #$0143, #$0147, #$00D3, #$00D4, #$0150, #$00D6, #$00D7,
#$0158, #$016E, #$00DA, #$0170, #$00DC, #$00DD, #$0162, #$00DF,
#$0155, #$00E1, #$00E2, #$0103, #$00E4, #$013A, #$0107, #$00E7,
#$010D, #$00E9, #$0119, #$00EB, #$011B, #$00ED, #$00EE, #$010F,
#$0111, #$0144, #$0148, #$00F3, #$00F4, #$0151, #$00F6, #$00F7,
#$0159, #$016F, #$00FA, #$0171, #$00FC, #$00FD, #$0163, #$02D9);
function ISO8859_2ToWideChar(const P: Char): WideChar;
begin
if Ord(P) >= $A0 then
Result := ISO8859_2Map[Ord(P)] else
Result := WideChar(Ord(P));
end;
function WideCharToISO8859_2(const Ch: WideChar): Char;
var I: Byte;
begin
if Ord(Ch) < $A0 then
begin
Result := Char(Ord(Ch));
exit;
end;
For I := $A0 to $FF do
if ISO8859_2Map[I] = Ch then
begin
Result := Char(I);
exit;
end;
raise EConvertError.Create('Can not convert to ISO-8859-2');
end;
class function TISO8859_2Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_2;
end;
class function TISO8859_2Codec.GetAliasCount: Integer;
begin
Result := ISO8859_2Aliases;
end;
class function TISO8859_2Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_2Alias[Idx];
end;
function TISO8859_2Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_2ToWideChar(P);
end;
function TISO8859_2Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_2(Ch);
end;
{ }
{ ISO-8859-3 - Latin 3 }
{ Esperanto, Galician, Maltese, and Turkish. }
{ }
const
ISO8859_3Aliases = 6;
ISO8859_3Alias: Array[0..ISO8859_3Aliases - 1] of String = (
'ISO-8859-3', 'ISO_8859-3:1988', 'ISO_8859-3',
'iso-ir-109', 'latin3', 'l3');
const
ISO8859_3Map: Array[$A0..$FF] of WideChar = (
#$00A0, #$0126, #$02D8, #$00A3, #$00A4, #$0000, #$0124, #$00A7,
#$00A8, #$0130, #$015E, #$011E, #$0134, #$00AD, #$0000, #$017B,
#$00B0, #$0127, #$00B2, #$00B3, #$00B4, #$00B5, #$0125, #$00B7,
#$00B8, #$0131, #$015F, #$011F, #$0135, #$00BD, #$0000, #$017C,
#$00C0, #$00C1, #$00C2, #$0000, #$00C4, #$010A, #$0108, #$00C7,
#$00C8, #$00C9, #$00CA, #$00CB, #$00CC, #$00CD, #$00CE, #$00CF,
#$0000, #$00D1, #$00D2, #$00D3, #$00D4, #$0120, #$00D6, #$00D7,
#$011C, #$00D9, #$00DA, #$00DB, #$00DC, #$016C, #$015C, #$00DF,
#$00E0, #$00E1, #$00E2, #$0000, #$00E4, #$010B, #$0109, #$00E7,
#$00E8, #$00E9, #$00EA, #$00EB, #$00EC, #$00ED, #$00EE, #$00EF,
#$0000, #$00F1, #$00F2, #$00F3, #$00F4, #$0121, #$00F6, #$00F7,
#$011D, #$00F9, #$00FA, #$00FB, #$00FC, #$016D, #$015D, #$02D9);
function ISO8859_3ToWideChar(const P: Char): WideChar;
begin
if Ord(P) >= $A0 then
begin
Result := ISO8859_3Map[Ord(P)];
if Result = #$0000 then
raise EConvertError.Create('Invalid ISO-8859-3 encoding');
end else
Result := WideChar(Ord(P));
end;
function WideCharToISO8859_3(const Ch: WideChar): Char;
var I: Byte;
begin
if Ord(Ch) < $A0 then
begin
Result := Char(Ord(Ch));
exit;
end;
For I := $A0 to $FF do
if ISO8859_3Map[I] = Ch then
begin
Result := Char(I);
exit;
end;
raise EConvertError.Create('Can not convert to ISO-8859-3');
end;
class function TISO8859_3Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_3;
end;
class function TISO8859_3Codec.GetAliasCount: Integer;
begin
Result := ISO8859_3Aliases;
end;
class function TISO8859_3Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_3Alias[Idx];
end;
function TISO8859_3Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_3ToWideChar(P);
end;
function TISO8859_3Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_3(Ch);
end;
{ }
{ ISO-8859-4 - Latin 4 }
{ Scandinavia/Baltic (mostly covered by 8859-1 also): Estonian, Latvian, and }
{ Lithuanian. It is an incomplete predecessor of Latin 6. }
{ }
const
ISO8859_4Aliases = 6;
ISO8859_4Alias: Array[0..ISO8859_4Aliases - 1] of String = (
'ISO-8859-4', 'ISO_8859-4:1988', 'ISO_8859-4',
'iso-ir-110', 'latin4', 'l4');
const
ISO8859_4Map: Array[$A0..$FF] of WideChar = (
#$00A0, #$0104, #$0138, #$0156, #$00A4, #$0128, #$013B, #$00A7,
#$00A8, #$0160, #$0112, #$0122, #$0166, #$00AD, #$017D, #$00AF,
#$00B0, #$0105, #$02DB, #$0157, #$00B4, #$0129, #$013C, #$02C7,
#$00B8, #$0161, #$0113, #$0123, #$0167, #$014A, #$017E, #$014B,
#$0100, #$00C1, #$00C2, #$00C3, #$00C4, #$00C5, #$00C6, #$012E,
#$010C, #$00C9, #$0118, #$00CB, #$0116, #$00CD, #$00CE, #$012A,
#$0110, #$0145, #$014C, #$0136, #$00D4, #$00D5, #$00D6, #$00D7,
#$00D8, #$0172, #$00DA, #$00DB, #$00DC, #$0168, #$016A, #$00DF,
#$0101, #$00E1, #$00E2, #$00E3, #$00E4, #$00E5, #$00E6, #$012F,
#$010D, #$00E9, #$0119, #$00EB, #$0117, #$00ED, #$00EE, #$012B,
#$0111, #$0146, #$014D, #$0137, #$00F4, #$00F5, #$00F6, #$00F7,
#$00F8, #$0173, #$00FA, #$00FB, #$00FC, #$0169, #$016B, #$02D9);
function ISO8859_4ToWideChar(const P: Char): WideChar;
begin
if Ord(P) >= $A0 then
Result := ISO8859_4Map[Ord(P)] else
Result := WideChar(Ord(P));
end;
function WideCharToISO8859_4(const Ch: WideChar): Char;
var I: Byte;
begin
if Ord(Ch) < $A0 then
begin
Result := Char(Ord(Ch));
exit;
end;
For I := $A0 to $FF do
if ISO8859_4Map[I] = Ch then
begin
Result := Char(I);
exit;
end;
raise EConvertError.Create('Can not convert to ISO-8859-4');
end;
class function TISO8859_4Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_4;
end;
class function TISO8859_4Codec.GetAliasCount: Integer;
begin
Result := ISO8859_4Aliases;
end;
class function TISO8859_4Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_4Alias[Idx];
end;
function TISO8859_4Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_4ToWideChar(P);
end;
function TISO8859_4Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_4(Ch);
end;
{ }
{ ISO-8859-5 - Cyrillic }
{ Bulgarian, Byelorussian, Macedonian, Russian, Serbian and Ukrainian. }
{ }
const
ISO8859_5Aliases = 5;
ISO8859_5Alias: Array[0..ISO8859_5Aliases - 1] of String = (
'ISO-8859-5', 'ISO_8859-5:1988', 'ISO_8859-5',
'iso-ir-144', 'cyrillic');
function ISO8859_5ToWideChar(const P: Char): WideChar;
begin
Case Ord(P) of
$00..$A0, $AD : Result := WideChar(Ord(P));
$F0 : Result := #$2116;
$FD : Result := #$00A7;
else
Result := WideChar(Ord(P) + $0360);
end;
end;
function WideCharToISO8859_5(const Ch: WideChar): Char;
begin
if Ord(Ch) <= $A0 then
Result := Char(Ord(Ch)) else
Case Ch of
#$2116 : Result := #$F0;
#$00A7 : Result := #$FD;
#$00AD : Result := #$AD;
#$0401..#$045F :
Case Ch of
#$0450, #$045D, #$040D :
raise EConvertError.Create('Can not convert to ISO-8859-5');
else
Result := Char(Ord(Ch) - $0360);
end;
else
raise EConvertError.Create('Can not convert to ISO-8859-5');
end;
end;
class function TISO8859_5Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_5;
end;
class function TISO8859_5Codec.GetAliasCount: Integer;
begin
Result := ISO8859_5Aliases;
end;
class function TISO8859_5Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_5Alias[Idx];
end;
function TISO8859_5Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_5ToWideChar(P);
end;
function TISO8859_5Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_5(Ch);
end;
{ }
{ ISO-8859-6 - Arabic }
{ Non-accented Arabic. }
{ }
const
ISO8859_6Aliases = 7;
ISO8859_6Alias: Array[0..ISO8859_6Aliases - 1] of String = (
'ISO-8859-6', 'ISO_8859-6:1987', 'ISO_8859-6',
'iso-ir-127', 'ECMA-114', 'ASMO-708', 'arabic');
function ISO8859_6ToWideChar(const P: Char): WideChar;
begin
Case Ord(P) of
$00..$A0, $A4, $AD : Result := WideChar(Ord(P));
$AC, $BB, $BF, $C1..$DA, $E0..$F2 : Result := WideChar(Ord(P) + $0580);
else
raise EConvertError.Create('Invalid ISO-8859-6 encoding');
end;
end;
function WideCharToISO8859_6(const Ch: WideChar): Char;
begin
if Ord(Ch) <= $A0 then
Result := Char(Ord(Ch)) else
Case Ch of
#$00A4 : Result := #$A4;
#$00AD : Result := #$AD;
#$062C, #$063B, #$063F, #$0641..#$065A, #$0660..#$0672 :
Result := Char(Ord(Ch) - $0580);
else
raise EConvertError.Create('Can not convert to ISO-8859-6');
end;
end;
class function TISO8859_6Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_6;
end;
class function TISO8859_6Codec.GetAliasCount: Integer;
begin
Result := ISO8859_6Aliases;
end;
class function TISO8859_6Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_6Alias[Idx];
end;
function TISO8859_6Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_6ToWideChar(P);
end;
function TISO8859_6Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_6(Ch);
end;
{ }
{ ISO-8859-7 - Modern Greek }
{ Greek. }
{ }
const
ISO8859_7Aliases = 8;
ISO8859_7Alias: Array[0..ISO8859_7Aliases - 1] of String = (
'ISO-8859-7', 'ISO_8859-7:1987', 'ISO_8859-7',
'iso-ir-126', 'ELOT_928', 'ECMA-118', 'greek', 'greek8');
function ISO8859_7ToWideChar(const P: Char): WideChar;
begin
Case Ord(P) of
$00..$A0, $A6..$A9, $AB..$AD, $B0..$B3, $B7, $BB, $BD :
Result := WideChar(Ord(P));
$A1 : Result := #$2018;
$A2 : Result := #$2019;
$AF : Result := #$2015;
$D2, $FF : raise EConvertError.Create('Invalid ISO-8859-7 encoding');
else
Result := WideChar(Ord(P) + $02D0);
end;
end;
function WideCharToISO8859_7(const Ch: WideChar): Char;
begin
if Ord(Ch) <= $A0 then
Result := Char(Ord(Ch)) else
Case Ch of
#$00A6..#$00A9, #$00AB..#$00AD, #$00B0..#$00B3, #$00B7, #$00BB, #$00BD :
Result := Char(Ord(Ch));
#$2018 : Result := #$A1;
#$2019 : Result := #$A2;
#$2015 : Result := #$AF;
else
raise EConvertError.Create('Can not convert to ISO-8859-7');
end;
end;
class function TISO8859_7Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_7;
end;
class function TISO8859_7Codec.GetAliasCount: Integer;
begin
Result := ISO8859_7Aliases;
end;
class function TISO8859_7Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_7Alias[Idx];
end;
function TISO8859_7Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_7ToWideChar(P);
end;
function TISO8859_7Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_7(Ch);
end;
{ }
{ ISO-8859-8 - Hebrew }
{ Non-accented Hebrew. }
{ }
const
ISO8859_8Aliases = 5;
ISO8859_8Alias: Array[0..ISO8859_8Aliases - 1] of String = (
'ISO-8859-8', 'ISO_8859-8:1988', 'ISO_8859-8',
'iso-ir-138', 'hebrew');
function ISO8859_8ToWideChar(const P: Char): WideChar;
begin
Case Ord(P) of
$00..$A0, $A2..$A9, $AB..$AE, $B0..$B9, $BB..$BE :
Result := WideChar(Ord(P));
$AA : Result := #$00D7;
$AF : Result := #$203E;
$BA : Result := #$00F7;
$DF : Result := #$2017;
$E0..$FA :
Result := WideChar(Ord(P) + $04E0);
else
raise EConvertError.Create('Invalid ISO-8859-8 encoding')
end;
end;
function WideCharToISO8859_8(const Ch: WideChar): Char;
begin
if Ord(Ch) <= $A0 then
Result := Char(Ord(Ch)) else
Case Ch of
#$00A2..#$00A9, #$00AB..#$00AE, #$00B0..#$00B9, #$00BB..#$00BE :
Result := Char(Ord(Ch));
#$00D7 : Result := #$AA;
#$203E : Result := #$AF;
#$00F7 : Result := #$BA;
#$2017 : Result := #$DF;
#$05C0..#$05DA : Result := Char(Ord(Ch) - $04E0);
else
raise EConvertError.Create('Can not convert to ISO-8859-8');
end;
end;
class function TISO8859_8Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_8;
end;
class function TISO8859_8Codec.GetAliasCount: Integer;
begin
Result := ISO8859_8Aliases;
end;
class function TISO8859_8Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_8Alias[Idx];
end;
function TISO8859_8Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_8ToWideChar(P);
end;
function TISO8859_8Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_8(Ch);
end;
{ }
{ ISO-8859-9 - Latin 5 }
{ Same as 8859-1 except for Turkish instead of Icelandic }
{ }
const
ISO8859_9Aliases = 6;
ISO8859_9Alias: Array[0..ISO8859_9Aliases - 1] of String = (
'ISO-8859-9', 'ISO_8859-9:1989', 'ISO_8859-9',
'iso-ir-148', 'latin5', 'l5');
function ISO8859_9ToWideChar(const P: Char): WideChar;
begin
Case Ord(P) of
$D0 : Result := #$011E;
$DD : Result := #$0130;
$DE : Result := #$015E;
$F0 : Result := #$011F;
$FD : Result := #$0131;
$FE : Result := #$015F;
else
Result := WideChar(Ord(P));
end;
end;
function WideCharToISO8859_9(const Ch: WideChar): Char;
begin
Case Ch of
#$011E : Result := #$D0;
#$0130 : Result := #$DD;
#$015E : Result := #$DE;
#$011F : Result := #$F0;
#$0131 : Result := #$FD;
#$015F : Result := #$FE;
else
if Ord(Ch) <= $00FF then
Result := Char(Ord(Ch)) else
raise EConvertError.Create('Can not convert to ISO-8859-9');
end;
end;
class function TISO8859_9Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_9;
end;
class function TISO8859_9Codec.GetAliasCount: Integer;
begin
Result := ISO8859_9Aliases;
end;
class function TISO8859_9Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_9Alias[Idx];
end;
function TISO8859_9Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_9ToWideChar(P);
end;
function TISO8859_9Codec.EncodeChar(const Ch: WideChar): Char;
begin
Result := WideCharToISO8859_9(Ch);
end;
{ }
{ ISO-8859-10 - Latin 6 }
{ Latin6, for Lappish/Nordic/Eskimo languages: Adds the last Inuit }
{ (Greenlandic) and Sami (Lappish) letters that were missing in Latin 4 to }
{ cover the entire Nordic area. }
{ }
const
ISO8859_10Aliases = 6;
ISO8859_10Alias: Array[0..ISO8859_10Aliases - 1] of String = (
'ISO-8859-10', 'ISO_8859-10:1992', 'ISO_8859-10',
'iso-ir-157', 'latin6', 'l6');
const
ISO8859_10Map: Array[$A0..$FF] of WideChar = (
#$00A0, #$0104, #$0112, #$0122, #$012A, #$0128, #$0136, #$00A7,
#$013B, #$0110, #$0160, #$0166, #$017D, #$00AD, #$016A, #$014A,
#$00B0, #$0105, #$0113, #$0123, #$012B, #$0129, #$0137, #$00B7,
#$013C, #$0111, #$0161, #$0167, #$017E, #$2014, #$016B, #$014B,
#$0100, #$00C1, #$00C2, #$00C3, #$00C4, #$00C5, #$00C6, #$012E,
#$010C, #$00C9, #$0118, #$00CB, #$0116, #$00CD, #$00CE, #$00CF,
#$00D0, #$0145, #$014C, #$00D3, #$00D4, #$00D5, #$00D6, #$0168,
#$00D8, #$0172, #$00DA, #$00DB, #$00DC, #$00DD, #$00DE, #$00DF,
#$0101, #$00E1, #$00E2, #$00E3, #$00E4, #$00E5, #$00E6, #$012F,
#$010D, #$00E9, #$0119, #$00EB, #$0117, #$00ED, #$00EE, #$00EF,
#$00F0, #$0146, #$014D, #$00F3, #$00F4, #$00F5, #$00F6, #$0169,
#$00F8, #$0173, #$00FA, #$00FB, #$00FC, #$00FD, #$00FE, #$0138);
function ISO8859_10ToWideChar(const P: Char): WideChar;
begin
if Ord(P) >= $A0 then
Result := ISO8859_10Map[Ord(P)] else
Result := WideChar(Ord(P));
end;
function WideCharToISO8859_10(const Ch: WideChar): Char;
var I: Byte;
begin
if Ord(Ch) < $A0 then
begin
Result := Char(Ord(Ch));
exit;
end;
For I := $A0 to $FF do
if ISO8859_10Map[I] = Ch then
begin
Result := Char(I);
exit;
end;
raise EConvertError.Create('Can not convert to ISO-8859-10');
end;
class function TISO8859_10Codec.GetUnicodeCodecType: TUnicodeCodecType;
begin
Result := ucISO8859_10;
end;
class function TISO8859_10Codec.GetAliasCount: Integer;
begin
Result := ISO8859_10Aliases;
end;
class function TISO8859_10Codec.GetAliasByIndex(const Idx: Integer): String;
begin
Result := ISO8859_10Alias[Idx];
end;
function TISO8859_10Codec.DecodeChar(const P: Char): WideChar;
begin
Result := ISO8859_10ToWideChar(P);
end;
function TISO8859_10Codec.EncodeChar(const Ch: WideChar): C
اون بالا نوشتم من زياد با دلفي كارنكردم
اما شما يه text editor درست كنيد اون راحته و بعد كد داده شده را با source code اديتور ي كه ساختين تطبيق كنيد و اين كد ها تو اديتور حايگزين سازيد بازم عرض ميكنم من اطلاعات زياد تو دلفي ندارم
من هم مانند آقا سامان Component بسيار خوب آقاي Mike Lischke را پيشنهاد مي كنم.
ايشان از دوستان ( و يا بهتر است بگويم استادان ) بسيار خوب من هستند كه اولين
نفري بودند كه در دلفي به ياد يونيكد افتادند.
البته قضيه يونيكد به همين جا ختم نمي شود. ابزارهاي بسيار زيادي جهت نمايش و
كنترل يا همان پشتيباني كلي از يونيكد در دلفي نوشته شده است. http://www.delphi-unicode.net/Tools.php
شركت نرم افزاري AidAim اولين شركتي بود كه به درست كردن Table خود كه توسط
SQL حمايت مي شود توانست تا انقلابي در اين زمينه توليد كند.
اين آدرس شركت مذكور مي باشد : http://www.aidaim.com/info/main.php
خوب اينها معرفي برنامه ها و كامپيوننتهاي آماده ...
اما به زبان ساده چگونه ميشه يونيكد را در دلفي بكار برد ؟
جواب را مي توان در يك جمله نوشت ....
به جاي String از WideString استفاده نماييد ...
اين جواب كلي اين سوال است. در هر جايي كه خواستيد تابعي را بسازيد كه يك
رشته را در خود نگه دارد ، به جاي استفاده از String از WideString استفاده نماييد
تا آن Variable بتواند مقادير يونيكدي يك رشته را نيز در خود نگاه دارد.
اين تمامي چيزي است كه شما بايد در دلفي انجام دهيد تا يونيكد را پشتيباني نماييد.
در صورتي كه به اطلاعات بيشرتي در رابطه با Unicode احتياج پيدا كرديد مي توانيد
از آدرس زير ديدن فرمايد : http://www.unicode.org
البته سوال اصلي شما اين بود كه در فرم چي ؟
اگر از نسخه هاي جديد دلفي مانند 7 يا 6 استفاده نماييد ، كامپوننتهاي آن به طور
مثال Edit يا memo همگي به صورت WideString نوشته شده اند لذا به صورت خودكار
مي توانند مقادير يونيكد را پشتيباني كنند.
بعد همينجا مي خواهم يه سوال ديگه هم در مورد دلفي بپرسم .
من هميشه دلفي را در WINME نصب مي كنم و با اون كار مي كنم. بعد وقتي يه بار خواستم
اون رو در Xp نصب كنم دچار مشكل شدم . يعني جاي عنصر ها تغيير كرده بود و تغييراتي ديگر.
حالا مي خواستم ببينم چطور مي شود دلفي رو بدون دردسر در Xp نصب كرد.
دقيقاْ منظورت را از عنصر متوجه نشدم. به يك مقدار فارسيم در زمينه كامپيوتر خرابه !
اگر منظورت همان Component هاي Visual هستند كه بر روي فرم قرار دادي مي توانم
علت زير را برايت بگويم ...
در طراحي فرم خيلي وقتها برنامه نويسان عناصر ( داره فارسيم خوب ميشه ! ) مختلف
را بر روي فرم خودشون قرار ميدن. و انتظار دارند تا تمامي كاربران اين قسمتها را به همان
صورت ، اندازه و مكان ببينند. اما در طراحي اين نوع برنامه ها از متدي با نام
System Placement استفاده شده است يعني برخي از اين قسمتها جاي خود در فرم را
بسته به تنظيمات ويندوز مي شناسند.
برايت يك مثال ساده مي زنم كه موضوع روشن بشه ...
فرض كن ويندوز ME شما داراي يك سري تنظيمات پنجره اي خاص است.
مثلاٌ Caption پنجره ها ارتفاعي به اندازه 15 پيكسل دارند ، پنجره هاي شما Border
ندارند ، رنگ Background شما طوسي استاندارد نيست و ... .
حالا برنامه خودتان را در همين ويندوز مي نويسيد و آن را در ويندوز ديگري مانند XP باز
مي كنيد. آيا انتظار داريد ظاهر ( و حتي مكان قسمتهاي مختلف بر روي فرم شما ) با
ويندوز قبلي يكي باشد ؟ خوب به طور يقين خير !
حالا راه حل چيست ؟
فقط كافي هست تا اين موارد ( و موارد اين چنيني ) را رعايت كنيد :
- در طراحي قسمتهاي مختلف بر روي فرم خود حتما از Align ها استفاده نماييد تا
در صورتي كه برنامه شما در ويندوزهاي مختلف اجرا شد ، جاي قسمتها به صورت
خودكار بر روي فرم محاسبه شود.
- هيچ وقت از رنگ آميزي غيراستاندارد استفاده نكنيد. به طور مثال هميشه اجازه
دهيد فرم شما رنگ استاندارد clBtnFace را داشته باشد. ( به جز موارد خاص كه
شما به طور كلي رنگ آميزي فرم را تغيير مي دهيد )
- در متد FormResize محاسبات اندازه قسمتهاي موجود بر روي فرم خود را انجام دهيد.
- به خاطر داشته باشيد چيزي كه شما مي بينيد لزوماْ چيزي نيست كه يك كاربر ديگر
بر روي يك كامپيوتر ديگر ببيند.
اگر موارد اين چنيني را رعايت كنيد ، زماني كه فرم خود را در هر ويندوزي در نرم افزار
دلفي باز كنيد ، مكان قسمتهاي مختلف بر روي فرم خوتان به صورت مرتب خواهد بود.
به شكل دقت كنيد ...
Form1 بر اساس طراحي عادي ساخته شده كه قطعاْ در ويندوزهاي ديگر مشكل ساز خواهد بود.
اما Form2 با استفاده از Panel ها و با رعايت اصول Align ساخته شده است كه ديگر
مشكلي را ايجاد نخواهد كرد.
خواهش مي كنم نويد جان.
اين يكي از اصول مديريت طراحي Form است كه نه تنها در دلفي ، بلكه در تمامي
زبانهاي برنامه نويسي مي بايست رعايت شود. شعار اين برنامه ها هم به اين
صورت است :
فكر نكنيد چيزي كه شما بر روي فرم خود مي بينيد ، لزوماْ همان چيز است كه كاربر مي بيند.
اما با رعايت قوانين Align تمامي اين مشكلات حل خواهد شد.
موفق باشيد
اين سوال به جايي بود.
يك سري قسمتها هستند ، مانند Button كه متدي با نام Align ندارند !
راه حل پيدا كردن مكان درست اين قسمتها ، استفاده از يك Panel در زير آنها است.
اين Panel مي تواند مكان درست Align شده آنها را در فرم درست كند.
حالا اگر مايل به تغيير اندازه دكمه نيز هستيد مي توانيد از متد FormResize جهت
به دست آوردن اندازه درست دكمه كمك بگيريد.
8O
