Сделать обводку текста

← →
Ray © (2006-05-15 16:06) [0]

Вывожу строку через TextOut.
Как сделать обводку этого текста линией указанного цвета и толщины?

← →
Gydvin © (2006-05-15 16:16) [1]

pen

← →
KilkennyCat © (2006-05-15 17:25) [2]

Вывести четыре раза дополнительно, со смещением координат.

← →
Джо © (2006-05-15 17:27) [3]

> Ray © (15.05.06 16:06)
> Вывожу строку через TextOut.
> Как сделать обводку этого текста линией указанного цвета
> и толщины?

Используй Path functions. Очень рекоммендую.

← →
Джо © (2006-05-15 17:39) [4]

Вот небольшой пример с TImage:

procedure TForm1.Button1Click(Sender: TObject); begin with Image1.Canvas do begin BeginPath(Handle); try Brush.Style := bsClear; Font.Name := "Arial"; Font.Size := 24; TextOut(10,10,"Test string"); Pen.Color := clBlack; Pen.Width := 1; finally EndPath(Handle) end; Brush.Style := bsSolid; Brush.Color := clYellow; StrokeAndFillPath(Handle); end; end;

← →
Desdechado © (2006-05-15 18:25) [5]

DrawText
подходит и для вывода текста, а также для вычисления прямоугольника, в который он будет вписан (как раз для обводки)
параметр DT_CALCRECT

← →
Джо © (2006-05-15 18:27) [6]

Хм. Я почему-то подумал, что "обводка" — это обведение контура букв. Потому и предложил [3], [4].
Если просто описаный прямоугольник сделать, то достаточно [5].

← →
Ray © (2006-05-15 21:42) [7]

Именно обводка букв нужна. Спасибо.

← →
Ray © (2006-05-15 22:07) [8]

>Вот небольшой пример с TImage:

То, что нужно :)
Но если толщина обводки указана=0, все равно рисуется
обводка толщиной в один пиксель. Можно, конечно проверку поставить
на толщину, но может, есть более простой способ?

← →
Джо © (2006-05-15 22:11) [9]

> [8] Ray © (15.05.06 22:07)

Наверное, самое простое — это именно "проверочка" :)

← →
Джо © (2006-05-15 22:13) [10]

Тем более, что
If Width is set to a value less than 1, the pen is given a Width of 1.
(с) Delphi Help по TPen.Width.

← →
Ray © (2006-05-15 23:00) [11]

еще 2 траблы :)
1.обводка рисуется в обе стороны, убивая при этом надпись.
Т.е., видимо, надо надпись без обводки вывести еще раз поверх этого
дела. Вопрос: как это делается?

2.вывожу текст я на canvas от PaintBox. Их у меня несколько. Можно ли сделать вывод одной процедурой, в которую бы передавалось имя? (или что?) этого PaintBox"а ?

← →
Ray © (2006-05-15 23:31) [12]

Первый вопрос снят :)

← →
Джо © (2006-05-15 23:34) [13]

> .вывожу текст я на canvas от PaintBox.

Не нужно выводить на канву PaintBox. Принцип такой. Заводишь промежуточный TBitmap, рисуешь, когда нужно, на его канве. В обработчике OnPaint TPaintBox"а копируешь изображение промежуточного TBitmap на канву PaintBox"а.

← →
Джо © (2006-05-15 23:36) [14]

> Можно ли сделать вывод одной процедурой, в которую бы передавалось
> имя? (или что?) этого PaintBox"а ?

Сделай универсальную процедуру, в которую передается Сanvas. Тогда одной процедурой можно рисовать на чьей угодно канве, хоть формы, хоть TImage"а, хоть принтера.

← →
Zeqfreed © (2006-05-15 23:36) [15]

2. Можно. Как раз таки передавать параметром необходимый пэйнт-бокс.
Примерно так:
function Sample(DrawTo : TPaintBox); begin with DrawTo do begin . . . end; end;

← →
Джо © (2006-05-15 23:38) [16]

> [15] Zeqfreed ©

Не есть хорошо. В процедуру передается больше сведений, чем ей положено иметь.

← →
Ray © (2006-05-15 23:49) [17]

>Сделай универсальную процедуру, в которую передается Сanvas. Тогда >одной процедурой можно рисовать на чьей угодно канве, хоть формы, хоть >TImage"а, хоть принтера.

Можно пример? Что-то я трудно врубаюсь :(

Мне надо выводить текст на что-то, что потом можно будет (вместе с этой надписью) таскать по экрану. PaintBox на мой взгляд хорошо подходит для этой цели.

← →
KilkennyCat © (2006-05-15 23:55) [18]

> выводить текст на что-то, что потом можно будет (вместе
> с этой надписью) таскать по экрану. PaintBox

Просто выводить его. Координаты вывода менять от координат курсора.
Для более плавного, выводить на TBitMap, а его уже biblt на паинтбокс.

← →
Джо © (2006-05-15 23:56) [19]

> [17] Ray © (15.05.06 23:49)
> >Сделай универсальную процедуру, в которую передается Сanvas.
> Тогда >одной процедурой можно рисовать на чьей угодно канве,
> хоть формы, хоть >TImage"а, хоть принтера.
>
> Можно пример? Что-то я трудно врубаюсь :(

procedure DrawOutlinedText (ACanvas: TCanvas; ...); begin with ACanvas do begin ... end; end;

← →
Ray © (2006-05-16 10:25) [20]

>Заводишь промежуточный TBitmap

Где находится этот компонент? Что-то не могу найти :(

>В обработчике OnPaint TPaintBox"а копируешь изображение промежуточного >TBitmap на канву PaintBox"а.

Как это делается?

>procedure DrawOutlinedText (ACanvas: TCanvas; ...);

а как вызывает ее?
Так? DrawOutlinedText (Bitmap1.Canvas, ...);

← →
Ray © (2006-05-16 12:40) [21]

>В обработчике OnPaint TPaintBox"а копируешь изображение промежуточного >TBitmap на канву PaintBox"а.
>Как это делается?

При этом фон изображения TBitmap тоже скопируется?
Мне этого не надо, т.к. текст надо накладывать на картинку.

← →
Ray © (2006-05-17 14:48) [22]

Еще бага: нарисованный вышеприведенной процедурой текст стирается, если провести по нему посторонинм окном. Как это победить?

← →
KilkennyCat © (2006-05-17 14:55) [23]

> При этом фон изображения TBitmap тоже скопируется?

если непрозрачный.

> нарисованный вышеприведенной процедурой текст стирается,
> если провести по нему посторонинм окном. Как это победить?

нарисовать еще раз. И в этом случае [18] становится еще более удобней.

← →
Джо © (2006-05-17 15:08) [24]

> [22] Ray © (17.05.06 14:48)
> Еще бага: нарисованный вышеприведенной процедурой текст
> стирается, если провести по нему посторонинм окном. Как
> это победить?

См. [13].

>> При этом фон изображения TBitmap тоже скопируется?
>если непрозрачный.

Как задать прозрачный?

Джо, ответь, плз на [20]

> [26] Ray © (17.05.06 15:41)
> Джо, ответь, плз на [20]

type TForm22 = class(TForm) PaintBox1: TPaintBox; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); procedure PaintBox1Paint(Sender: TObject); private TempBitmap: TBitmap; public end; var Form22: TForm22; implementation {$R *.dfm} // Процедура рисования // рисует на временном битмапе procedure TForm22.Button1Click(Sender: TObject); begin TempBitmap.Canvas.Rectangle(3,4,30,40); PaintBox1.Refresh; end; // Создаем временный битмэп // с размерами пэйнтбокса procedure TForm22.FormCreate(Sender: TObject); begin TempBitmap := TBitmap.Create; TempBitmap.Width := PaintBox1.Width; TempBitmap.Height := PaintBox1.Height; end; // При уничтожении формы уничтожаем временный битмэп procedure TForm22.FormDestroy(Sender: TObject); begin TempBitmap.Free; end; // Когда системе понадобится обновить изображение // на PaintBox, будет вызван этот обработчик события procedure TForm22.PaintBox1Paint(Sender: TObject); begin // просто копируем содержимое временного битмапа // на наш пэйнтбокс PaintBox1.Canvas.Draw(0,0,TempBitmap); // ...а можно и так BitBlt (PaintBox1.Canvas.Handle,0,0,PaintBox1.Width,PaintBox1.Height, TempBitmap.Canvas.Handle,0,0,SRCCOPY); end; end.

Спасибище!

Еще грабля:

With Form1.Image1.Canvas do
begin
Pen.Style:=psDashDot;
Pen.Mode:=pmBlack;
Pen.Width:=1;
Pen.Color:=clBlack;
MoveTo(0,0);
LineTo(100,100);
end;

Какой бы стиль Pen"а не ставил, все равно всегда выводится СПЛОШНАЯ линия :(
Где глюк искать?

Причем это не работает только на одной конкретной форме.
Если этим кодом рисовать на другую -- все рисуется как надо.
Ниччче не понимаю :(

Странно, но если выкинуть Pen.Mode:=pmBlack;
то начинает работать.

Самая важная задача:
надо вывести одновременно:
1.фоновую картинку
2.текст с обводкой (несколько независимых строк, которые надо будет
по этому фону таскать)
3.рамку из пунктирной линии поверх всего этого

Я пытался сделать это через Image, но обломался, т.к. при попытке что-либо на нем нарисовать, он моментально становится непрозрачным :(

Как быть?

Джо, я верю, что ты знаешь, как это сделать! :)

Я, конечно, очень польщен, но не нужно так откровенно превращать ветку в личную переписку. Зарежут ветку.

Формировать картинку нужно тогда не на канве Bitmap"а, и уж тем более не на каком TImage"е. Рисуй картинку на TMetafileCanvas, создай TMetafile, а затем уже, когда будешь выводить итоговую картинку, копируй на него метафайл.

Сорри, сейчас нет времени написать пример. Посмотре примеры в Справке по TMetafile, TMetafileCanvas.

Или, может я не совсем разобрался с тем, что нужно получить.

В общем, вот быстрый пример, показывающий принцип работы с канвой метафайла, может, пригодится.
В Image1 уже должен быть в design-time загружен битмап. Показываю, как наложить на него изображение, нарисованное на канфе метафайла.

procedure DrawStamp (ACanvas: TCanvas); begin with ACanvas do begin BeginPath(Handle); try Brush.Style := bsClear; Font.Name := "Arial"; Font.Size := 24; TextOut(0,0,"Test string"); finally EndPath(Handle) end; Pen.Color := clBlack; Pen.Width := 1; Brush.Style := bsSolid; Brush.Color := clYellow; StrokeAndFillPath(Handle); end; // ну тут еще рисуем все, что нужно "накладывать" на основную картинку end; procedure TForm23.Button1Click(Sender: TObject); var Mf: TMetafile; Mfc: TMetafileCanvas; begin Mf := TMetafile.Create; try Mfc := TMetafileCanvas.Create(Mf,0); try DrawStamp(Mfc); finally Mfc.Free; end; Image1.Canvas.Draw(100,100,Mf); finally Mf.Free; end; end;

Сделать обводку текста Найти похожие ветки