Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.09.22;
Скачать: [xml.tar.bz2];

Вниз

Разбиение строкИ на стрОки   Найти похожие ветки 

 
Broot   (2003-09-10 10:42) [0]

Всем здрасьте.

Есть такая задача:
создать битмап в памяти, вывести на него текст(с переносами по словам), а затем отрисовать его (битмап).(Здесь все понятно)

НО:

Замучал такой вопрос:
Т.к. зараннее не известна длина текста(а он может включать в себя и #10#13, которые надо учитывать) как лучше решить проблему?

PS: битмап.height увеличивать можно, а width - нельзя


 
Skier   (2003-09-10 10:44) [1]

TStringList.Text := ???;


 
Erik   (2003-09-10 10:47) [2]

Пошеш алгоритьм который ищет пробелы, проверяет нетули после них #13#10 или #10. Поле обработаный кусок кидаеш в TStrings итд..


 
Broot   (2003-09-10 10:48) [3]

нет.

Я забыл указать, что мне надо также узнать высоту всего ОТРИСОВАННОГО на битмапе текста


 
ZEE   (2003-09-10 10:50) [4]

а еще можно зайти в раздел "UBPFD - бесплатная база готовых решений для Delphi" (вверху основного форума)
и там в "Строки и символы" найдешь кучу алгоритмов разбиения строк


 
Broot   (2003-09-10 10:54) [5]

2ZEE

ок, гляну


 
pasha_golub   (2003-09-10 11:12) [6]

Функция возвращет высоту выведенного. Параметры: DX, DY - отступы слева и сверху, остальные думаю и так понятно

function WriteCheckedText(ACanvas: TCanvas; const ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment;):integer;
const
BreakingChars: set of Char = [ #0..#255] - ["a".."z","A".."Z","1".."9","0"];
var
H,RectWidth: integer;
OutStr:string;
LastBreakingCharPos:integer;
Left,Right,DHeight,DH: integer;
Len: integer;
StartPos, DPos: integer;
S:string;

begin
ACanvas.FillRect(ARect);
SetBkMode(ACanvas.Handle,Transparent);
RectWidth := (ARect.Right) - (ARect.Left);
Result := -1;
if RectWidth < ACanvas.TextWidth("W") then
Exit;
ACanvas.Lock;
try
H := ARect.Top+DY;
StartPos := 1;
DPos := 0;
Len := length(Text);
LastBreakingCharPos := 0;

while StartPos<Len do
begin
while (StartPos+DPos <= Len) //пока не вышли за строку
and (ACanvas.TextWidth(trim(copy(Text,StartPos,DPos)))<RectWidth)
do
begin
if Text[StartPos+DPos] in BreakingChars then
LastBreakingCharPos := StartPos+DPos;
inc(DPos);
end;

if not (StartPos+DPos >= Len) then
if (LastBreakingCharPos > StartPos)
then //разрываем по нормальному
DPos := LastBreakingCharPos-StartPos+1
else //разрываем принудительно
dec(DPos);
OutStr := Trim(Copy(Text,StartPos,DPos));
case Alignment of
taLeftJustify:
Left := ARect.Left+DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(OutStr)-DY;
else { taCenter }
Left := ARect.Left + (RectWidth) shr 1
- (ACanvas.TextWidth(OutStr) shr 1);
end;
TextOut(ACanvas.Handle,Left,H,PChar(OutStr),
length(OutStr));
DHeight := ACanvas.TextHeight(OutStr);

inc(StartPos,DPos);
inc(H,DHeight);
DPos := 0;
end;
Result := H;
finally
ACanvas.Unlock;
end;
end;


 
pasha_golub   (2003-09-10 11:15) [7]

Кстати, есть такая вот функция DrawText, которая тоже возвращает высоту, но у нее, если слово выходит за пределы прямоугольника, оно не переносится. А код выше проверен и работает, сам использую


 
pasha_golub   (2003-09-10 12:53) [8]

Упс забыл русские буквы. так надо
BreakingChars: set of Char = [ #0..#255] - ["a".."z","A".."Z","а"..я"","А".."Я","1".."9","0"];,



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.09.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.011 c
1-71716
Kremen
2003-09-10 16:40
2003.09.22
Есть ли функция или оператор для сложения по модулю 2? Подскажите


3-71521
Relaxxx
2003-08-30 15:18
2003.09.22
Вопрос по SQL ,как слить несколько полей в одно


3-71542
grusty
2003-08-29 17:34
2003.09.22
Проблема с Locate в ADO...


1-71574
Wandererr
2003-09-10 10:23
2003.09.22
Встроеный язык в приложения


1-71711
drakulita
2003-09-10 16:49
2003.09.22
TXT файлы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский