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

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.57 MB
Время: 0.024 c
14-319
MBo
2002-02-12 14:20
2002.04.01
что за значки в ответах вместо копирайта?


1-197
tovSuhov
2002-03-19 18:03
2002.04.01
Неактивная форма...


1-192
Yakudza
2002-03-17 20:19
2002.04.01
ChekListBox и Record


1-188
madburro
2002-03-18 23:15
2002.04.01
Print


1-142
Zool
2002-03-21 22:53
2002.04.01
Ошибка





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский