Delphi World - Алгоритм переноса русского текста по слогам
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Алгоритм переноса русского текста по слогам


Автор: 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования