Arsip: Mengambil Huruf Arab Dan mengermbalikannya Ke Edit Text..??

 
user image
more 13 years ago

juan81

Ada yang tau gak... mau bantu teman buat program Tutorial... buat pesantren... >,<... nah konsep programnya gak ada masalah udah ngerti... tapi binggungnya cuma 1... Ya apa Ngambil dari EditText... pertama hasilnya '?????'.. dan saya searching di web... format Unicodenya Widechar... dan itu tipenya WideString... ya apa milah2nya di Komponen delphi standar itu... apa harus download lagi?? terus misal kalo udah saya jadikan unikode asci / text.. mengembalikan lagi ke text awal ya apa ya... ^^ mestinya kalo udah dapat algoritma yang tepat mestinya isa balikan.
user image
more 13 years ago

juan81

Lupa bilang... ^^ yang mau di ambil itu Huruf Arabnya >,<
user image
more 13 years ago

pebbie

TntControls
user image
more 13 years ago

juan81

udah coba... gak kamu?? TnTControl... saya udah coba juga... itu untuk tampilkan di layar doank.... terus ngambil taro di variabel dah di proses... bisa gak??
user image
more 13 years ago

juan81

akhirnya dapat... saya... ini untuk sekedar membantu aja ini saya kasih sourcenya untuk ngambil dari edit text dan kembalikan lagi.... sapa tau di kemudian hari dapat masalah yang sama dengan saya >,<.... saya dapt dari JCLUnicode tapi untuk Komponen pake yang di kasih Piebbie

type
  UCS4 = Cardinal;
const
  ReplacementCharacter: UCS4 = $0000FFFD;
  MaximumUCS2: UCS4 = $0000FFFF;
  MaximumUCS4: UCS4 = $7FFFFFFF;
  HalfBase: UCS4 = $0010000;
  HalfMask: UCS4 = $3FF;
  HalfShift: Integer = 10;
  SurrogateHighStart: UCS4 = $D800;
  SurrogateHighEnd: UCS4 = $DBFF;
  SurrogateLowStart: UCS4 = $DC00;
  SurrogateLowEnd: UCS4 = $DFFF;
  FirstByteMark: array  of Byte =
    ($00, $00, $C0, $E0, $F0, $F8, $FC);
  BytesFromUTF8: array  of Byte =
   (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5);
  OffsetsFromUTF8: array  of UCS4 =
    ($00000000, $00003080, $000E2080,
     $03C82080, $FA082080, $82082080);
function WideStringToUTF8(S: WideString): AnsiString;
var
  Ch: UCS4;
  L, J, T,
  BytesToWrite: Cardinal;
  ByteMask: UCS4;
  ByteMark: UCS4;
begin
  if S = '' then
    Result := ''
  else
  begin
    SetLength(Result, Length(S) * 6); // assume worst case
    T := 1;
    ByteMask := $BF;
    ByteMark := $80;
    for J := 1 to Length(S) do
    begin
      Ch := UCS4(S[J]);
      if Ch < $80 then
        BytesToWrite := 1
      else
        if Ch < $800 then
          BytesToWrite := 2
        else
          if Ch < $10000 then
            BytesToWrite := 3
          else
            if Ch < $200000 then
              BytesToWrite := 4
            else
              if Ch < $4000000 then
                BytesToWrite := 5
              else
                if Ch <= MaximumUCS4 then
                  BytesToWrite := 6
                else
                begin
                  BytesToWrite := 2;
                  Ch := ReplacementCharacter;
                end;
      for L := BytesToWrite downto 2 do
      begin
        Result[T + L - 1] := Char((Ch or ByteMark) and ByteMask);
        Ch := Ch shr 6;
      end;
      Result[T] := Char(Ch or FirstByteMark[BytesToWrite]);
      Inc(T, BytesToWrite);
    end;
    SetLength(Result, T - 1); // set to actual length
  end;
end;
function UTF8ToWideString(S: AnsiString): WideString;
var
  L, J, T: Cardinal;
  Ch: UCS4;
  ExtraBytesToWrite: Word;
begin
  if S = '' then
    Result := ''
  else
  begin
    SetLength(Result, Length(S)); // create enough room
    L := 1;
    T := 1;
    while L <= Cardinal(Length(S)) do
    begin
      Ch := 0;
      ExtraBytesToWrite := BytesFromUTF8[Ord(S[L])];
      for J := ExtraBytesToWrite downto 1 do
      begin
        Ch := Ch + Ord(S[L]);
        Inc(L);
        Ch := Ch shl 6;
      end;
      Ch := Ch + Ord(S[L]);
      Inc(L);
      Ch := Ch - OffsetsFromUTF8[ExtraBytesToWrite];
      if Ch <= MaximumUCS2 then
      begin
        Result[T] := WideChar(Ch);
        Inc(T);
      end
      else
        if Ch > MaximumUCS4 then
        begin
          Result[T] := WideChar(ReplacementCharacter);
          Inc(T);
        end
        else
        begin
          Ch := Ch - HalfBase;
          Result[T] := WideChar((Ch shr HalfShift) + SurrogateHighStart);
          Inc(T);
          Result[T] := WideChar((Ch and HalfMask) + SurrogateLowStart);
          Inc(T);
        end;
    end;
    SetLength(Result, T - 1); // now fix up length
  end;
end;
fungsi WideStringToUTF8 itu berguna untuk konvert bahasa arab dari Edit TExtnya untuk di masukkan ke database / di olah... dan fungsi UTF8ToWideString buat kembalikan ke TNTTextnya untuk di tampilkan.. >,<
more ...
  • Pages:
  • 1
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com