Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Надо написать НА ДЕЛЬФИ текстовый редактор с переносом слов по слогам(Ма-ма)  (Прочитано 11341 раз)
0 Пользователей и 3 Гостей смотрят эту тему.
hedgher
Гость
« : 22-05-2005 11:12 » 

Нужно курсовик писать... пропадаю... текстовый редактор с переносами слов по слогам на следующую строчку через чёрточку
Кто может ссылку дать или кодом алгаритма помогите.... плиззззззззз  Быть такого не может
Записан
hedgher
Гость
« Ответ #1 : 23-05-2005 09:44 » 

Текстовый редактор сделал...
а вот с алгоритмом ваще не получается, пожалуйста помогите хоть чем-нибудь... в долгу не останусь.
Записан
Zalk
Гость
« Ответ #2 : 23-05-2005 11:48 » 

Первая мысля, что пришла в голову - ставить перенос сразу после гласной при условии, что в слове дальше встречаются еще хоть одна гласная...
А более правильно... это наверно надо словарь вести...   Вот такой я вот
Записан
hedgher
Гость
« Ответ #3 : 24-05-2005 19:47 » 

Дя.... мысли про словари  тоже проходили, подходил к преподу, доконал до того, что бы переносить только слова мона было, как в ворде в конце строки...
  Отлично студенты умеют уговаривать
так что задачка уже полегче...
Записан
Zalk
Гость
« Ответ #4 : 25-05-2005 05:07 » 

Отлично студенты умеют уговаривать
Таки ДА! Улыбаюсь
Записан
hedgher
Гость
« Ответ #5 : 09-06-2005 18:46 » 

всё таки надо написать Жаль
есть алгоритм... и текстовик
надо подправит и соеденить, кто знает хелпните плиззз
АЛГОРИТМ :
Код:
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.
« Последнее редактирование: 20-12-2007 19:07 от Алексей1153++ » Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines