Текущий архив: 2002.04.01;
Скачать: CL | DM;

Вниз

Как написать разноцветную надпись?   Найти похожие ветки 

← →
Andrey007   (2002-03-18 17:05) [0]

То есть чтобы сначала буквы были, например, чёрные, потом зелёные и потом красные? Причём эту надпись надо выводить в TTabSheet.Caption.

---

← →
MBo ©   (2002-03-18 17:23) [1]

все можно сделать в OnDrawTab. недавно, кажется в форуме было

---

← →
Andrey007   (2002-03-18 17:44) [2]

Да, я нашёл это сообщение - http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1016001677&n=0, но там немного не о том. Там о том, как изменить цвет всей надписи целиком. А вот как изменить цвет отдельных букв в надписи?

---

← →
Макс Черных ©   (2002-03-18 23:02) [3]

Разноцветную надпись нарисовать не так то и просто.
Вот пример, который я когда то писал на скорую руку
чтобы показать одному знакомому как это чудо делается
(точнее цель была подсветить некоторые части текста).
В проекте 1 форма на которой 1 компонент TImage, на
Canvas которого и рисуем. Так как этот пример делался
наскоро, то он естественно малость кривоват, но
принцип понять можно, осоьенно если почитать описание функции GetTextExtentExPoint

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Types;

type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
private
Ftext : string;
public
procedure Test;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Ftext :=
"Время больше не давит на игрока! На каждый вопрос вам дается 2 минуты " +
"Введен предварительный конкурс, как это происходит и в телевизионной игре. " +
"MarkRect.Left := Swidths[16] + 2; " +
"Right := Swidths[12]+ 2; ";
Test;
end;

procedure TForm1.Test;
var R, Mr : TRect; W : Integer; NumFit : Integer;
Swidths : array[0..300] of Integer; p7 : tagSize;
S, Sd, Sm : string; HighLights : array of string;
begin
SetLength(HighLights, 3);
HighLights[0] := "";
HighLights[1] := "";
HighLights[2] := "";
R := Rect(0, 0, 500, 250);
With Image1 do begin
Canvas.Brush.Color := clWindow;
Canvas.FillRect(R);
Canvas.Font.Name := "Arial";
Canvas.Font.Size := 10;
R := Rect(10, 10, 200, 240);
S := Ftext;
W := 190;
Repeat
GetTextExtentExPoint(Canvas.Handle, Pchar(S), Length(S), W,
@NumFit, PInteger(@Swidths), p7);
While S[NumFit] <> " " do dec(NumFit);
Sd := Copy(S, 1, NumFit);
Canvas.Brush.Color := clWindow;
Canvas.Font.Color := clBlack;
DrawText(Canvas.Handle, Pchar(Sd), -1, R, DT_LEFT{ or DT_WORDBREAK});
Mr := R;
Mr.Left := Swidths[7] -2;// -1;
Sm := Copy(Sd, 7, 6);
Canvas.Brush.Color := clYellow;
Canvas.Font.Color := clRed;
TextOut(Canvas.Handle, Swidths[8] -5, R.Top, Pchar(Sm), Length(Sm));
Delete(S, 1, NumFit);
inc(R.Top, p7.cy);
until S = "";
end;
end;

end.

---

← →
MBo ©   (2002-03-20 08:04) [4]

кстати, сразу не подумал - для рисования экзотики на закладках проще всего использовать свойство Images - рисуем какие угодно картинки, заносим в ImageList и все.

---

← →
deleon   (2002-03-20 09:04) [5]

Возьми TVVMColorLabel - то, что тебе нужно!
http://www.dbwork.kuban.ru

---

← →
Andrey007   (2002-03-20 10:12) [6]

Ну, в общем, я это сделал вот так:
Текст раскрашивается между косыми линиями. Там надпись типа "Количество (500:400/70/30):". 70 пишется зелёным, а 30 - красным.

procedure TForm1.FormPaint(Sender: TObject);
var Zelen,Krasn: String;
i,j,be,en: Integer;
r: TRect;
begin // Uvp - это TTabSheet
if pos("/",Uvp.Caption)=0 then Exit;
en:=length(Uvp.Caption); be:=1; j:=0; // j - счётчик косых линий
for i:=1 to length(Uvp.Caption) do if Uvp.Caption[i]="/" then
begin // зелёный цвет
if j=0 then be:=i else if j=1 then
begin
Krasn:=Copy(Uvp.Caption,1,be);
Zelen:=Copy(Uvp.Caption,be+1,i-be-1);
R:=PageControl.TabRect(1);
if PageControl.ActivePage=Uvp
then R:=Rect(R.Left+PageControl.Canvas.TextExtent(Krasn).cx+6,R.Top+2,
R.Left+PageControl.Canvas.TextExtent(Krasn).cx+
PageControl.Canvas.TextExtent(Zelen).cx+6,R.Bottom)
else R:=Rect(R.Left+PageControl.Canvas.TextExtent(Krasn).cx+6,R.Top+4,
R.Left+PageControl.Canvas.TextExtent(Krasn).cx+
PageControl.Canvas.TextExtent(Zelen).cx+6,R.Bottom);
PageControl.Canvas.Font.Color:=RGB(0,150,0);
PageControl.Canvas.Brush.Color:=clBtnFace;
DrawText(PageControl.Canvas.Handle,Pchar(Zelen),-1,R,DT_LEFT);
en:=i
end;
inc(j)
end
else if Uvp.Caption[i]=")" then
begin // красный цвет
Krasn:=Copy(Uvp.Caption,1,en);
TabCtrl_GetItemRect(PageControl.Handle,1,R); // это тоже самое, что и R:=PageControl.TabRect(1);
Zelen:=Copy(Uvp.Caption,en+1,i-en-1);
if PageControl.ActivePage=Uvp
then R:=Rect(R.Left+PageControl.Canvas.TextExtent(Krasn).cx+6,R.Top+2,
R.Left+PageControl.Canvas.TextExtent(Krasn).cx+
PageControl.Canvas.TextExtent(Zelen).cx+6,R.Bottom)
else R:=Rect(R.Left+PageControl.Canvas.TextExtent(Krasn).cx+6,R.Top+4,
R.Left+PageControl.Canvas.TextExtent(Krasn).cx+
PageControl.Canvas.TextExtent(Zelen).cx+6,R.Bottom);
PageControl.Canvas.Font.Color:=RGB(200,0,0);
PageControl.Canvas.Brush.Color:=clBtnFace;
DrawText(PageControl.Canvas.Handle,Pchar(Zelen),-1,R,DT_LEFT);
end
end;

---

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

Текущий архив: 2002.04.01;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.01 c