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

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

27.03.2012, 20:10. Просмотров 6137. Ответов 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
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.03.2012, 20:10
Ответы с готовыми решениями:

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

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

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

Как убрать перенос строки в конце RichEdit при вставке из буфера обмена
Здравствуйте, уважаемые форумчане! Подскажите пожалуйста: Копирую текст....

Отображение определённой строки с сайта
Всем бобра! :) Вобщем вопрос такой: Как можно найти определённую строку на...

20
Одиночка
3933 / 1858 / 337
Регистрация: 16.03.2012
Сообщений: 3,869
28.03.2012, 12:49 2
Ну в двух словах:
Бери строку обрабатывай по словам:
1. Запомни позицию начала строки как предыдущего слова,
2. Ищи пробел,
3. Текст от начала строки до пробела проверяй на длину (Canvas.TextWidth),
Если не выходит за пределы, запоминай позицию предыдущей строки и на п.2 иначе возвращаешься на предыдущее слово, оставляешь нужную часть в предыдущей строке Memo, остальную часть Insert.
Ну типа того. Код могу вечером, если не напишешь сам или кто-нить не поможет.
1
dez
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
Одиночка
3933 / 1858 / 337
Регистрация: 16.03.2012
Сообщений: 3,869
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 Кб, 48 просмотров)
dez
0 / 0 / 0
Регистрация: 27.03.2012
Сообщений: 8
28.03.2012, 21:02  [ТС] 5
спасибо. буду разбираться
0
dez
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
Одиночка
3933 / 1858 / 337
Регистрация: 16.03.2012
Сообщений: 3,869
29.03.2012, 22:10 7
А каким образом изменяется Memo?

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

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

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

Два поля Memo. Требуется удалить все строки из memo2, которых нет в поле memo1
Собственно, на форме два поля memo. В memo1 какие-то строки и в поле memo2...

Поиск в Memo1 перенос в Memo2
Здравствуйте! Нужна помощь. в Memo1 открывается текстовый файл со списком,...

Таблица DrawGrid. При нажатии на кнопку закрашиваются всё чётные строки и нечётные строки
Подскажите пожалуйста. Трудновато сделать задачу. Буду благодарен за ответы....


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

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

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