есть алгоритм... и текстовик
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.
ТЕКСТОВИК :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, ToolWin, StdCtrls, ImgList, shellapi;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
Edit1: TMenuItem;
New1: TMenuItem;
ImageList1: TImageList;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
Open1: TMenuItem;
Save1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Cut1: TMenuItem;
Copu1: TMenuItem;
Paste1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
FontDialog1: TFontDialog;
ComboBox1: TComboBox;
Edit2: TEdit;
UpDown1: TUpDown;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
procedure New1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Font1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Cut1Click(Sender: TObject);
procedure Copu1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure RichEdit1SelectionChange(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton13Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
private
function CurrText: TTextAttributes;
procedure GetFontNames;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
procedure TForm1.GetFontNames;
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(DC, nil, @EnumFontsProc, Pointer(ComboBox1.Items));
ReleaseDC(0, DC);
ComboBox1.Sorted := True;
end;
procedure TForm1.New1Click(Sender: TObject);
begin
RichEdit1.Lines.Clear;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
if richedit1.Lines.Count>0 then
if MessageBox(0,'Засейвиться?','Save или нет?',MB_YESNO)=IDYES then
Save1Click(Sender);
Close;
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Save1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Font1Click(Sender: TObject);
begin
FontDialog1.Font.Assign(RichEdit1.SelAttributes);
if FontDialog1.Execute then
CurrText.Assign(FontDialog1.Font);
Edit2.Text := IntToStr(RichEdit1.SelAttributes.Size);
ComboBox1.Text := RichEdit1.SelAttributes.Name;
RichEdit1.SetFocus;
end;
function TForm1.CurrText: TTextAttributes;
begin
if RichEdit1.SelLength > 0 then Result := RichEdit1.SelAttributes
else Result := RichEdit1.DefAttributes;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
CurrText.Name := ComboBox1.Items[ComboBox1.ItemIndex];
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetFontNames;
end;
procedure TForm1.Cut1Click(Sender: TObject);
begin
RichEdit1.CutToClipboard;
end;
procedure TForm1.Copu1Click(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;
procedure TForm1.Paste1Click(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;
procedure TForm1.ToolButton8Click(Sender: TObject);
begin
if ToolButton8.Down then
CurrText.Style := CurrText.Style + [fsBold]
else
CurrText.Style := CurrText.Style - [fsBold];
end;
procedure TForm1.ToolButton9Click(Sender: TObject);
begin
if ToolButton9.Down then
CurrText.Style := CurrText.Style + [fsItalic]
else
CurrText.Style := CurrText.Style - [fsItalic];
end;
procedure TForm1.ToolButton10Click(Sender: TObject);
begin
if ToolButton10.Down then
CurrText.Style := CurrText.Style + [fsUnderline]
else
CurrText.Style := CurrText.Style - [fsUnderline];
end;
procedure TForm1.RichEdit1SelectionChange(Sender: TObject);
begin
Edit2.Text := IntToStr(RichEdit1.SelAttributes.Size);
ComboBox1.Text := RichEdit1.SelAttributes.Name;
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
CurrText.Size := StrToInt(Edit2.Text);
end;
procedure TForm1.ToolButton11Click(Sender: TObject);
begin
RichEdit1.Paragraph.Alignment := taLeftJustify;
end;
procedure TForm1.ToolButton12Click(Sender: TObject);
begin
RichEdit1.Paragraph.Alignment := taCenter;
end;
procedure TForm1.ToolButton13Click(Sender: TObject);
begin
RichEdit1.Paragraph.Alignment := taRightJustify;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;
end.