Главная страницаОбратная связьКарта сайта

Алгоритм переноса русского текста по слогам


Автор: Gorbunov A. A.


unit Hyper;

interface

uses
  Windows, Classes, SysUtils;

function SetHyph(pc: PChar; MaxSize: Integer): PChar;
function SetHyphString(s : string): string;
function MayBeHyph(p: PChar; pos: Integer): Boolean;

implementation

type
  TSymbol=(st_Empty, st_NoDefined, st_Glas, st_Sogl, st_Spec);
  TSymbAR=array [0..1000] of TSymbol;
  PSymbAr=^TSymbAr;

const
  HypSymb=#$1F;
  Spaces=[" ", ",",";", ":",".","?","!","/", #10, #13 ];
  SpecSign= [ "-", "-","N", "-", "щ", "г"];

  GlasCHAR=["e", "L", "х", "+", "v", "-","р", "-", "ю", "+", " ", "-",
  "ш", "L", "|", "|", "2", "|",
  { english }
  "e", "E", "u", "U","i", "I", "o", "O", "a", "A", "j", "J"];

  SoglChar=["-", "г" , "ъ", "|" ,"э", "=" , "у", "+" , "0", "+" , "", "-" ,
  "ч", "|" , "i", "-" ,"I", "L" , "т", "T" , "я", "|" , "Ё", "|" ,
  "ы", "T" , "ф", "-" ,"ц", "|" , "-", "+" , "ё", "T" , "ь", "|" ,
  "E", "T" , "с", "+" ,
  { english }
  "q", "Q","w", "W", "r", "R","t", "T","y", "Y","p", "P","s",
  "S", "d", "D","f", "F", "g", "G","h", "H","k", "K","l", "L","z",
  "Z", "x", "X","c", "C", "v", "V", "b", "B", "n", "N","m", "M" ];

function isSogl(c: Char): Boolean;
begin
  Result := c in SoglChar;
end;

function isGlas(c: Char): Boolean;
begin
  Result := c in GlasChar;
end;

function isSpecSign(c: Char): Boolean;
begin
  Result := c in SpecSign;
end;

function GetSymbType(c: Char): TSymbol;
begin
  if isSogl(c) then
  begin
    Result := st_Sogl;
    exit;
  end;
  if isGlas(c) then
  begin
    Result := st_Glas;
    exit;
  end;
  if isSpecSign(c) then
  begin
    Result := st_Spec;
    exit;
  end;
  Result := st_NoDefined;
end;

function isSlogMore(c: pSymbAr; start, len: Integer): Boolean;
var
  i: Integer;
  glFlag: Boolean;
begin
  glFlag := false;
  for i:=Start to Len-1 do
  begin
    if c^[i]=st_NoDefined then
    begin
      Result := false;
      exit;
    end;
    if (c^[i]=st_Glas)and((c^[i+1]<>st_Nodefined)or(i<>Start)) then
    begin
      Result := True;
      exit;
    end;
  end;
  Result := false;
end;

function SetHyph(pc: PChar; MaxSize: Integer): PChar;
var
  HypBuff : Pointer;
  h : PSymbAr;
  i : Integer;
  len : Integer;
  Cur : Integer;
  cw : Integer;
  Lock: Integer;
begin
  Cur := 0;
  len := StrLen(pc);
  if (MaxSize = 0) or (Len = 0) then
  begin
    Result := nil;
    Exit;
  end;

  GetMem(HypBuff, MaxSize);
  GetMem(h, Len + 1);
  for i:=0 to len-1 do
    h^[i]:=GetSymbType(pc[i]);
  cw:=0;
  Lock:=0;
  for i:=0 to Len-1 do
  begin
    PChar(HypBuff)[cur]:=PChar(pc)[i];Inc(Cur);

    if i>=Len-2 then
      Continue;
    if h^[i]=st_NoDefined then
    begin
      cw:=0;
      Continue;
    end
    else
      Inc(cw);
    if Lock<>0 then
    begin
      Dec(Lock);
      Continue;
    end;
    if cw<=1 then
      Continue;
    if not(isSlogMore(h,i+1,len)) then
      Continue;

    if (h^[i]=st_Sogl)and(h^[i-1]=st_Glas)and
    (h^[i+1]=st_Sogl)and(h^[i+2]<>st_Spec) then
    begin
      PChar(HypBuff)[cur] := HypSymb;
      Inc(Cur);
      Lock := 1;
    end;

    if (h^[i]=st_Glas)and(h^[i-1]=st_Sogl)and
    (h^[i+1]=st_Sogl)and(h^[i+2]=st_Glas) then
    begin
      PChar(HypBuff)[cur] := HypSymb;
      Inc(Cur);
      Lock := 1;
    end;

    if (h^[i]=st_Glas)and(h^[i-1]=st_Sogl)and
    (h^[i+1]=st_Glas)and(h^[i+2]=st_Sogl) then
    begin
      PChar(HypBuff)[cur] := HypSymb;
      Inc(Cur);
      Lock := 1;
    end;

    if (h^[i] = st_Spec) then
    begin
      PChar(HypBuff)[cur] := HypSymb;
      Inc(Cur);
      Lock := 1;
    end;
  end;

  FreeMem(h, Len + 1);
  PChar(HypBuff)[cur] := #0;
  Result := HypBuff;
end;

function Red_GlasMore(p: PChar; pos: Integer): Boolean;
begin
  while p[pos]<>#0 do
  begin
    if p[pos] in Spaces then
    begin
      Result:=False;
      Exit;
    end;
    if isGlas(p[pos]) then
    begin
      Result:=True;
      Exit;
    end;
    Inc(pos);
  end;
  Result:=False;
end;

function Red_SlogMore(p: Pchar; pos: Integer): Boolean;
var
  BeSogl, BeGlas: Boolean;
begin
  BeSogl:=False;
  BeGlas:=False;
  while p[pos]<>#0 do
  begin
    if p[pos] in Spaces then
      Break;
    if not BeGlas then
      BeGlas:=isGlas(p[pos]);
    if not BeSogl then
      BeSogl:=isSogl(p[pos]);
    Inc(pos);
  end;
  Result:=BeGlas and BeSogl;
end;

function MayBeHyph(p:PChar;pos:Integer):Boolean;
var
  i: Integer;
  len: Integer;
begin
  i:=pos;
  Len:=StrLen(p);
  Result:= (Len>3) and (i>2) and (iand (not (p[i] in Spaces))
  and (not (p[i+1] in Spaces)) and (not (p[i-1] in Spaces)) and
  ((isSogl(p[i])and isGlas(p[i-1])and isSogl(p[i+1])and
  Red_SlogMore(p,i+1)) or
  ((isGlas(p[i]))and(isSogl(p[i-1]))and(isSogl(p[i+1]))and(isGlas(p[i+2])))
  or ((isGlas(p[i]))and(isSogl(p[i-1]))and(isGlas(p[i+1])) and
  Red_SlogMore(p,i+1) ) or ((isSpecSign(p[i]))));
end;

function SetHyphString(s : string):string;
var
  Res: PChar;
begin
  Res := SetHyph(PChar(S), Length(S) * 2)
  Result := Res;
  FreeMem(Res, Length(S) * 2);
end;

end.


Обсудить статью на форуме


Если Вас заинтересовала или понравилась информация по разработке на Delph - "Алгоритм переноса русского текста по слогам", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!
   


Copyright © 2008 - 2024 Дискета.info