Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.54/46: Рейтинг темы: голосов - 46, средняя оценка - 4.54
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
1

Перенос строки в Memo1 при достижении определённой длины строки

27.03.2012, 20:10. Просмотров 9201. Ответов 20
Метки нет (Все метки)


Здравствуйте.
помогите. забуксовал.

как правильно перенести строку в Memo1 при достижении определённой длины строки, измеряя её в пикселях?
строка в Memo имеет ограниченную длину, но должна переносится целым словом

Delphi
1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.Memo1Change(Sender: TObject);
var
  dlina_str1: integer;    // длина строки в пикселях
begin
  dlina_str1:= Canvas.TextWidth(Form1.Memo1.Text);
  Form1.Label15.Caption:= IntToStr(dlina_str1);      // контроль длины
 
  if Canvas.TextWidth(Form1.Memo1.Lines.Strings[0]) >100 then   // измерение длины строки
    ...   // не знаю
    
end;
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
27.03.2012, 20:10
Ответы с готовыми решениями:

как нарастить переменную при выборе определённой строки в Combobox
как нарастить переменную при выборе определённой строки в Combobox !! очень нужно помигите !!...

Парсинг данных с определенной строки из Memo1-Delphi
Здравствуйте) Как сделать, чтобы после загрузки кода страницы в Memo1, парсились данные с...

Как удалить строки из memo1 которые есть в memo2
Как удалить строки из memo1 которые есть в memo2 Допустим у меня в memo1 строки: Test тест What...

Авто перенос курсора в Richedit при достижении длины строки определенного числа символов.
Вопрос - как в RichEdit эмулировать нажатие клавиши enter или просто осуществить перенос каретки...

20
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
28.03.2012, 12:49 2
Ну в двух словах:
Бери строку обрабатывай по словам:
1. Запомни позицию начала строки как предыдущего слова,
2. Ищи пробел,
3. Текст от начала строки до пробела проверяй на длину (Canvas.TextWidth),
Если не выходит за пределы, запоминай позицию предыдущей строки и на п.2 иначе возвращаешься на предыдущее слово, оставляешь нужную часть в предыдущей строке Memo, остальную часть Insert.
Ну типа того. Код могу вечером, если не напишешь сам или кто-нить не поможет.
1
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
28.03.2012, 16:16  [ТС] 3
вот такое наваял:


Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Memo1Change(Sender: TObject);
var
  s1, s2: string;
  i1, i2: integer;
begin
  If GetAsyncKeyState(VK_SPACE) <> 0 Then
    s1:= Form1.Memo1.Text;      // длина до пробела
    i1:= Length(s1);                 // номер последнего элемента
    Form1.Label15.Caption:= IntToStr(Canvas.TextWidth(Form1.Memo1.Text));  // контроль длины
  if Canvas.TextWidth(Form1.Memo1.Lines.Strings[0]) >100 then
    begin
      s2:= copy(Form1.Memo1.Text,i1,Length(Form1.Memo1.Text)); // невлезший кусок
      Form1.Memo1.Lines.Add(s2);
    end;
end;
это безобразие зацикливается в конце.
и я не знаю как быть с третьей строкой
0
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
28.03.2012, 20:46 4
Вот код:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
   Bmp : TBitmap;
 
implementation
 
{$R *.DFM}
 
PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
  Memo1.WordWrap:=FALSE;
  Memo1.Lines.LoadFromFile('Война крылатых людей.txt');
  ProgressBar1.Max:=Memo1.Lines.Count;
END;
 
FUNCTION FindMaxStr(VAR StrSourse:STRING;LenPointStr:INTEGER):STRING;
VAR
        II : INTEGER;
        JI : INTEGER;
    KI,KI1 : INTEGER;
         S : STRING;
  CharFind : SET OF CHAR;
LABEL NewFind, GReturn;
BEGIN
  KI:=1; KI1:=0; {Для возврата}
  {Заполнение строки Ищем пробел иди конец строки}
  S:=''; CharFind:=[' ']; //Пока будем искать пробел
NewFind:
  FOR II:=KI TO LENGTH(StrSourse)+1 DO
  BEGIN
    IF NOT (StrSourse[II] IN CharFind) THEN
    Insert(StrSourse[II],S,LENGTH(S)+1) ELSE
    {Нашли пробел}
    {Проверим...}
    BEGIN
      JI:=Bmp.Canvas.TextWidth(S);
      IF JI>LenPointStr THEN {Выходит за пределы разрешенного участка}
      BEGIN
GReturn:
        {Попробуем возврат...}
        SetLength(S,KI1);
        IF LENGTH(S)=0 THEN
        {Ни одно слово строки не помещается в поле выдачи}
        IF ((CharFind*[' '])<>[]) THEN
        BEGIN
          {Будем искать разделители}
          CharFind:=[';','.',',','!','?','/','\'];
          GOTO NewFind;
        END;
        BREAK;
      END ELSE
      BEGIN
        KI:=II+1; KI1:=LENGTH(S)+1; {Для возврата}
        Insert(StrSourse[II],S,LENGTH(S)+1)
      END;
    END;
 
    IF II=LENGTH(StrSourse) THEN {Конец строки}
    BEGIN
      JI:=Bmp.Canvas.TextWidth(S);
      IF JI>LenPointStr THEN {Выходит за пределы разрешенного участка}
      GOTO GReturn;
      BREAK;
    END;
  END;
 
  II:=LENGTH(S);
  IF II<>0 THEN
  IF II<>LENGTH(StrSourse) THEN
  Delete(StrSourse,1,II) ELSE StrSourse:='' ELSE
  BEGIN
    //Тут нужно обрабатывать вариант, когда в строке не найдено
    //ни пробелов ни разделителей
    //Нужно без поиска разделителей - резать по живому
    //Пока просто передаётся вся строка, иначе может зависнуть
    S:=StrSourse; StrSourse:='';
  END;
  IF LENGTH(S)<>0 THEN
  IF S[LENGTH(S)]=' ' THEN Delete(S,LENGTH(S),1); {Убираем пробел в конце строки}
  Result:=S;
END;
 
PROCEDURE TForm1.Button1Click(Sender: TObject);
VAR
    II : INTEGER;
  S,S1 : STRING;
LABEL BegCikl;
BEGIN
  Bmp:=TBitmap.Create;
  Bmp.Canvas.Font.Assign(Memo1.Font);
 
  Memo1.Lines.BeginUpdate;
  II:=0;
 
  REPEAT
    S:=Memo1.Lines[II];
    ProgressBar1.Position:=II;
BegCikl:
    IF Bmp.Canvas.TextWidth(S)>100 THEN
    BEGIN
      S1:=FindMaxStr(S,100);    //Ищем максимальную подстроку в строке
      Memo1.Lines[II]:=S1;      //Найденную часть на старое место
      INC(II);
      Memo1.Lines.Insert(II,S); //Остаток вставить за текущей
      ProgressBar1.Max:=ProgressBar1.Max+1;
      GOTO BegCikl;
    END;
    INC(II);
  UNTIL (II>=Memo1.Lines.Count);
  Memo1.Lines.EndUpdate;
  Bmp.Free;
end;
 
end.
И выкладываю все файлы проекта. Программа работает с обычным текстом. Если нужно работать с Ansi надо будет переделывать (думаю немного). Справишься?
0
Вложения
Тип файла: rar Memo2.rar (23.7 Кб, 55 просмотров)
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
28.03.2012, 21:02  [ТС] 5
спасибо. буду разбираться
0
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
29.03.2012, 21:22  [ТС] 6
Delphi
1
2
3
4
5
6
[COLOR="Red"]IF Bmp.Canvas.TextWidth(S)>100 THEN вылетает ошибка[/COLOR]
    BEGIN
      S1:=FindMaxStr(S,100);    //Ищем максимальную подстроку в строке
      Memo1.Lines[II]:=S1;      //Найденную часть на старое место
      INC(II);
      Memo1.Lines.Insert(II,S); //Остаток вставить за текущей
не могу понять. Ваш проект работает без проблем. добавляю его себе - всё работает до момента переноса. затем вылетает ошибка. вроде вся разница в том, что у вас процедура обработки нажатия кнопки, а у меня контроль изменения в Memo
0
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
29.03.2012, 22:10 7
А каким образом изменяется Memo?

Добавлено через 32 минуты
Я понял. Когда начинаем это делать в OnChange Memo получается, что при изменении Memo нашим методом опять происходит событие OnChange. Думаю нужно делать какой-то флажок, устанавливать его в начале обработки и снимать в конце. А при входе в обработчик проверять: если установлен, сразу выходить. Пока ничего другого в голову не приходит. Подумаю.

Добавлено через 12 минут
Я уже попробовал. Ерунда получается. Процедура проходит весь Memo при нажатии на каждую клавишу. Теряется позиция курсора. Тут нужно запускать глобальную обработку один раз при загрузке файла. А потом контролировать только одну строку. И после обработки восстанавливать как-то позицию курсора. В общем нужно смотреть.
0
Заблокирован
31.03.2012, 00:16 8
dez,
Для чего именно весь этот бред?
0
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
31.03.2012, 00:26 9
Он по видимому хочет сделать чтобы в Memo строки переносились по словам, если нет скрола. Сейчас они режутся по живому. Но я понял, что нужно перекрывать метод в Memo, который выполняет этот перенос.
0
Заблокирован
31.03.2012, 01:11 10
Одиночка,
Так мемо же переносит по словам сам. Может у него это свойство отключено?
0
Заблокирован
31.03.2012, 01:20 11
Одиночка,
вот у меня скрола нет. а перенос по пробелу.
там есть такая штука как WordWrap
0
Заблокирован
31.03.2012, 01:29 12
dez,
Но уж если тебе этот бред понадобился...
Вообще в мемо перенести в нужном месте невозможно, если не вставить в текст знак конца строки.
Нужно всего лишь измерять ширину каждого символа на канвасе и складывать ширину, при этом запоминая позицию кажого следующего пробела. Как только строка превысит значение вернутся к позиции пробела и вставить туда признак конца строки. и начать всё заново. При этом те признаки конца строки, что есть, заменять на пробелы
0
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
31.03.2012, 01:37 13
Примерно так и делали. Только переносили в следующую строку часть, которая не помещалась.
Проблемы начались тогда, когда он начал изменять Memo. Читай тему.
0
Заблокирован
31.03.2012, 01:48 14
А вообще существует пакет компонентов TRichView. Он платный, но в инете есть взломанная бесплатная версия с исходниками. Скачай поставь и не мучайся. Будут тебе и переносы где надо и картинки в тексте и таблицы и формулы и гиперссылки и текст по ширине с отступами абзацев. В общем всё что надо
0
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
31.03.2012, 07:03  [ТС] 15
Цитата Сообщение от Lirrk Посмотреть сообщение
там есть такая штука как WordWrap
свойство переноса включено. каждая строка будет экспортироваться в Word (в ячейки таблицы), а так-как ширина символов различна, то я не могу ограничить длину строки количеством символов. нужно проверять длину текста. при Memo1Change измеряю длину строки и при нажатии пробела она запоминается в переменной
0
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
31.03.2012, 07:33  [ТС] 16
всё это для того, чтобы оптимально заполнить строку. если в строке будет мало заглавных букв, то останется много свободного места. если много заглавных, то оно просто не влезет в ячейку.
0
3941 / 1866 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
31.03.2012, 10:51 17
dez: Как ты, наверное, уже читал ранее в событии OnChange Memo эту обработку делать нельзя. Моё мнение, нужно, как минимум, перекрывать метод переноса строки самого Memo. Опиши конкретнее, когда происходит загрузка текста в Word. Может там другой момент можно выбрать для переноса. И вообще текст сразу в Word писать, без перезаписи в Memo.
0
Заблокирован
31.03.2012, 10:53 18
dez,
Из всего того что вы понаписали я ни фига не понял. Если вам нужно оптимальное расположение в ячейках вордовской таблицы, ворд это может сделать сам. Давайте ему на съедение всё что угодно и он всё сделает. В крайнем случае можно подключить макрос. Вам же нужна только целая строка а не урезанная. так и так вы её целиков вставляете в ячейку. И я вам написал. Возьмите компонент TRichView. Он вам состряпает какую угодно таблицу в формате RTF. Вы сможете потом открыть эту таблицу где угодно и экспортировать хоть в ексель и хоть куда. А огород городить не стоит.
0
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
31.03.2012, 13:14  [ТС] 19
В Memo у меня будет 3 строки. В шаблоне Word есть 3 ячейки. Текст в Memo не загружается из файла, а просто набивается вручную. Как состряпать макрос, чтобы он разбивал длинную строку на три ячейки я не знаю (в принципе это тоже самое, что и здесь).

Цитата Сообщение от Lirrk Посмотреть сообщение
Возьмите компонент TRichView
Не получается у меня поставить новый компонент. Всё время вылетает какая нибудь ошибка.
Может косячное качаю.
0
Заблокирован
31.03.2012, 20:35 20
Цитата Сообщение от dez Посмотреть сообщение
Как состряпать макрос, чтобы он разбивал длинную строку на три ячейки...
очевидно только вы и понимаeте, что вам надо. Но подход явно не тот.
Чтобы помочь, нужно понять суть. А вы кругами ходите вокруг какой-то точки...
У вас сверхсекретный проект?
И потом Word работает не с пикселями а с миллиметрами и сантиметрами.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
31.03.2012, 20:35

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Функции для копирования строки определённой длины
Вобщем,подумал,что нечего засорять форум вопросами,которых у меня должно появиться по теме...

Автоперенос строки,при достижении определенной ширины
Как сделать автоперенос строки,по определенному символу,или если размер div достиг заданной ширины?...

Выдает ошибку при достижении последней строки dataGridView
private void dataGridView2_KeyDown(object sender, KeyEventArgs e) { if...

Прекращает работать программа при достижении строки вызова функции
Привет всем. Есть код,я добавил в него функцию(так требует задание), до этого работало все ,но...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.