БОЛЬШОЙ FAQ ПО DELPHI



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


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




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Видеокурс ВЗЛОМ