| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Переносы [D7]

Yanis ©   (2004-11-17 18:02:00) 

Хочу(читай "нужно") написать функцию вывода текста в консоли с переносом слова, если оно не умещается в строке размером, например 50 символов. Я кое-что набросал, но функция работает криво, да и текст все равно обрезается. Оченб нуждаюсь в помощи и советах.

Вот на чём я сейчас остановился (т.е. застрял):
(слова разделяются одиночным пробелом)


const
 s =
   'Previously, LeftStr, RightStr, and MidStr each had an AnsiString parameter type and return type, and did not '+
   'support MBCS strings.  Each of these functions has been replaced by a pair of overloaded functions, one that '+
   'takes and returns AnsiString, and one that takes and returns WideString. The new functions correctly handle '+
   'MBCS strings. This change breaks code that uses these functions to store and retrieve byte values in AnsiStrings. '+
   'Such code should be updated to use the new byte-level functions described below.';

var
 i, LastPos:Integer;
 _S:String;

begin
 for i := 1 to Length(S) do
   begin
   end;

 _S := '';
 for i := 1 to Length(S) do
   begin
     if S[i] = ' ' then
       begin
         LastPos := i;
       end;

     if (S[i] <> ' ') and ((i mod 15) = 0) and (S[i+1] <> ' ') then
       begin
         insert(#13,_S,LastPos);
         _S[LastPos] := #10;
         _S := _S+S[i];
       end
     else
       _S := _S+S[i];
   end;

 write(_S);
 readln;
end.


---

Игорь Шевченко   (2004-11-19 11:19:00) [1]

VMcL ©   (19.11.04 07:20) [7]

Вот же - век живи, век учись. Спасибо :)

---

Yanis   (2004-11-19 08:31:00) [2]

Вобщем подойдёт. (См. Игорь Шевченко (18.11.04 23:59) [5])

А вообще задача должна быть решена на Паскале.

Может еще у коги-нибудь варианты решения есть? Было бы интересно посмотреть.

---

VMcL   (2004-11-19 07:20:00) [3]

Эта... а SysUtils.WrapText не подойдет?

---

Yanis   (2004-11-19 00:42:00) [4]

Я уже сделал, но все равно спасибо. Это я к себе в копилку.

---

Игорь Шевченко   (2004-11-18 23:59:00) [5]

А вот что у меня получилось:

procedure StrBreakApart(const S, Delimeter : string; Parts : TStrings);
var
 CurPos: integer;
 CurStr: string;
begin
 Parts.clear;
 Parts.BeginUpdate();
 try
   CurStr:= S;
   repeat
     CurPos:= Pos(Delimeter, CurStr);
     if (CurPos>0) then begin
       Parts.Add(Copy(CurStr, 1, Pred(CurPos)));
       CurStr:= Copy(CurStr, CurPos+Length(Delimeter),
                   Length(CurStr)-CurPos-Length(Delimeter)+1);
     end else
       Parts.Add(CurStr);
   until CurPos=0;
 finally
   Parts.EndUpdate();
 end;
end;

procedure TfMain.Button1Click(Sender: TObject);
begin
 DestMemo.Lines.Text := WrapText (SrcMemo.Lines.Text);
end;

function TfMain.WrapText(const S: string): string;
const
 PartLimit = 50;
var
 List: TStrings;
 I, PartLen: Integer;
begin
 List := TStringList.Create;
 try
   StrBreakApart (S, ' ', List);
   PartLen := 0;
   for I:=0 to Pred(List.Count) do begin
     if Length(List[I]) + PartLen + 1 > PartLimit then begin
       Result := Result + #13;
       PartLen := 0;
     end;
     if PartLen <> 0 then begin
       Result := Result + ' ';
       Inc(PartLen);
     end;
     Result := Result + List[I];
     Inc(PartLen, Length(List[I]));
   end;
 finally
   List.Free;
 end;
end;



На входе:
Applications often need to manage lists of character strings. Examples include items in a combo box, lines in a memo, names of fonts, and names of rows and columns in a string grid. The VCL and CLX provide a common interface to any list of strings through an object called TStrings and its descendant TStringList. TStringList implements the abstract properties and methods introduced by TStrings, and introduces properties, events, and methods to


На выходе:
Applications often need to manage lists of
character strings. Examples include items in a
combo box, lines in a memo, names of fonts, and
names of rows and columns in a string grid. The
VCL and CLX provide a common interface to any list
of strings through an object called TStrings and
its descendant TStringList. TStringList implements
the abstract properties and methods introduced by
TStrings, and introduces properties, events, and
methods to


---

_Lucky_   (2004-11-18 23:38:00) [6]

а вот что получилось у меня, если конечно я правильно понял, что надо было сделать :)

Uses Crt;

Const
nMaxStrLen = 50;

S =
 'Previously, LeftStr, RightStr, and MidStr each had an'+
'AnsiString parameter type and return type, and did not '+
  'support MBCS strings.  Each of these functions has been' +
  'replaced by a pair of overloaded functions, one that '+
  'takes and returns AnsiString, and one that takes and returns' +
'WideString. The new functions correctly handle '+
  'MBCS strings. This change breaks code that uses these' +
'functions to store and retrieve byte values in AnsiStrings. '+
  'Such code should be updated to use the new byte-level' +
'functions described below.';

Var
sNewStr : String;

Procedure ReadFile (Var sFileName, sResult : String);
Var
fIn : Text;
  sRes : String;
Begin
  sResult := '';
    Assign (fIn, sFileName);
    ReSet (fIn);
    While Not EOF (fIn) Do
    Begin
         ReadLn (fIn, sRes);
         sResult := sResult + sRes;
  End;
    Close (fIn);
End;     {ReadFile}

Procedure ReBuildFile (sFileName : String; nStrSize : Word; Var sStrRes : String);
Var
  nCurrLen : Word;
  nStrLen : Word;
  nSpacePos : Word;
  sIn, sOut : String;
  bExit : Boolean;

Begin
{ReadFile (sFileName, sIn);}
  sIn := S;
  writeln (length (S), ' ', length (sIn));
  sOut := '';

  bExit := False;
  nCurrLen := 0;
  While Not bExit Do
  Begin
   nSpacePos := Pos (' ', sIn);
 If nSpacePos > 0 Then
  Begin
         If (nCurrLen + nSpacePos) > nStrSize Then
            Begin
               sOut := sOut + #13 + #10;
                 nCurrLen := 0;
              End;
         sOut := sOut + Copy (sIn, 1, nSpacePos);
           Delete (sIn, 1, nSpacePos);
           nCurrLen := nCurrLen + nSpacePos;
  End;
     nStrLen := Length (sIn);
     If (nStrLen > 0) And (nSpacePos = 0) Then
      Begin
         If (nCurrLen + nStrLen) > nStrSize Then
               sOut := sOut + #13 + #10;
         sOut := sOut + Copy (sIn, 1, nStrLen);
           bExit := True;
        End;
  End;
  sStrRes := sOut;
End;     {ReBuildFile}

Begin
clrscr;
ReBuildFile ('d:\text.txt', nMaxStrLen, sNewStr);
  write (sNewStr);
  readkey;
End.

хотя приведенный текст у меня тоже обрезается, но это потому что в string больше 255 (в пасе) не влазеет

---

Yanis   (2004-11-17 23:51:00) [7]

Всем спасибо. Я так и знал, что где-где, а уж на любимом форуме мне помогут. Но я не в обиде. Ведь здесь все ради патрепаться сидят (см.: http://www.delphimaster.ru/cgi-bin/forum.pl?id=1100708166&n=3)

Вот что у меня получилось:


procedure PrintFormatText(var S:String);
var
 s1:string;
 i,j:integer;
begin
 // удаляем конец символы конца
 // строки и перевода каретки
 DeleteEol(S);

 I:=0;
 J:=1;

 while ( j MaxInLine then
       begin
         writeln;
         i:=0;
         write(s1);
       end
     else
       begin
         write(s1+s[j]);
         inc(j);
       end;
       
     inc(i,length(s1)+1);
   end;
end;


---

Yanis   (2004-11-17 19:21:00) [8]

Я уже второй день хожу. Другие проги подобного типа сразу же "прогрибались", а здесь немогу никак. Может есть класический алгоритм? Поделитесь.

---

Poirot   (2004-11-17 18:06:00) [9]

Я бы для начала предложил похоить отладчиком:) Очень хорпошо видно, что так, а что не так:)

---

Наверх