Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Рисование в TEdit [D6, WinXP]

webpauk © (2009-07-31 12:06:00)
как часть текста Tedit нарисовать другим цветом?

palva (2009-08-01 11:17:00) [1]

> Есть три пути

Вспомнился армейский анекдот: "Эй вы, трое! Оба ко мне."

Игорь Шевченко (2009-08-01 00:53:00) [2]

> тока еще глючит...

И будет глючить.

Есть три пути - использовать TRichEdit и обрабатывать у Edit сообщение WM_PAINT.

Anatoly Podgoretsky (2009-07-31 13:50:00) [3]
> clickmaker (31.07.2009 13:30:13) [13]

Я против richedit ничего не имею, это автор против.
Вот поэтому я и оставил Paint на закуску, вдруг это очень важно и автор готов затратить определеные усилия на реализацию.

webpauk (2009-07-31 13:39:00) [4]

> clickmaker © (31.07.09 13:17) [9]
>

такой большой дядя, а не знаешь, что можно всё, что не запрещено

webpauk (2009-07-31 13:37:00) [5]
unit EditKVL;

interface

uses
SysUtils, Classes, Controls, StdCtrls, Messages, Forms, Graphics, Windows;

const
cSpecial = '[%s%]';
type
TEditKVL = class(TEdit)
private
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Objects', [TEditKVL]);
end;

procedure TEditKVL.WMKeyDown(var Message: TWMKeyDown);
begin
if Message.CharCode=VK_RIGHT then
begin
if copy(Text, SelStart+1, Length(cSpecial))=cSpecial then SelStart:=SelStart+Length(cSpecial)-1;
end;

if Message.CharCode=VK_LEFT then
begin
if copy(Text, SelStart-Length(cSpecial)+1, Length(cSpecial))=cSpecial then SelStart:=SelStart-Length(cSpecial)+1;
end;

inherited;
end;

procedure TEditKVL.WMLButtonDown(var Message: TWMLButtonDown);
var
fS: String;
fI: Integer;
begin
inherited;

for fI := 1 to Length(cSpecial)-1 do
begin
fS:=copy(Text, SelStart-(fI-1), Length(cSpecial));
if fS=cSpecial then SelStart:=SelStart+Length(fS)-fI;
end;
end;

procedure TEditKVL.WMPaint(var Message: TWMPaint);
type
TTextRec = record
Text: String;
IsSpecial: Boolean;
end;
const
cArr: array[Boolean] of TColor = (clBlack, clRed);
var
Edit1_DC: HDC;
fFont: tagLOGFONT;
NewFont, OldFont: HFONT;
fLen, fI: Integer;
fArr: array of TTextRec;
fS: String;
TM: TSize;
fRect: TRect;
pRect: Pointer;
begin
inherited;

fS:=Text;
while Pos(cSpecial, fS)<>0 do
begin
fLen:=Length(fArr);
SetLength(fArr, fLen+1);
fArr[fLen].Text:=Copy(fS, 1, Pos(cSpecial, fS)-1);

fLen:=Length(fArr);
SetLength(fArr, fLen+1);
fArr[fLen].Text:=cSpecial;
fArr[fLen].IsSpecial:=True;
Delete(fS, 1, Pos(cSpecial, fS)+3);
end;
if fS<>'' then
begin
fLen:=Length(fArr);
SetLength(fArr, fLen+1);
fArr[fLen].Text:=fS;
end;
fS:='';

Edit1_DC:=GetDC(Handle);

GETOBJECT(Font.Handle, sizeof(fFont), @fFont);
NewFont:=CreateFontIndiRect(fFont);
OldFont:=SelectObject(Edit1_DC, NewFont);

fRect:=Rect(0, 0, Width, Height);
pRect:=@fRect;
InvalidateRect(Edit1_DC, pRect, True);
SetBkMode(Edit1_DC, TRANSPARENT);

for fI := Low(fArr) to High(fArr) do
begin
SetTextColor(Edit1_DC, cArr[fArr[fI].IsSpecial]);
TextOut(Edit1_DC, TM.cx+1, 1, PAnsiChar(fArr[fI].Text), Length(fArr[fI].Text));
fS:=fS+fArr[fI].Text;
GetTextExtentPoint32(Edit1_DC, PChar(fS), Length(fS), TM);
end;

NewFont:=SelectObject(Edit1_DC, OldFont);
DeleteObject(NewFont);

ReleaseDC(Handle, Edit1_DC);
end;

end.

тока еще глючит...

Palladin (2009-07-31 13:33:00) [6]

> [11] clickmaker © (31.07.09 13:22)

зря...

clickmaker (2009-07-31 13:30:00) [7]
> [12] Anatoly Podgoretsky © (31.07.09 13:27)

ну так это в любом компоненте можно предложить... получится просто, что надо будет практически повторить большинство пути его авторов )
и зачем, когда есть richedit?

Anatoly Podgoretsky (2009-07-31 13:27:00) [8]
Я могу и предложить и другой путь - это перекрыть метод Paint, но я думаю он умрет после этого.

clickmaker (2009-07-31 13:22:00) [9]
> [10] Anatoly Podgoretsky © (31.07.09 13:20)

да ладно. Вряд ли автор задал вопрос про выделение.
webpauk тут давно тусит, я не думаю, что он настолько уж... ламер )

Anatoly Podgoretsky (2009-07-31 13:20:00) [10]
А ты проверь и удивись, я два цвета гарантирую. Правда не гарантирую без фона, но цвет будет разным.

clickmaker (2009-07-31 13:17:00) [11]
> Или то что я указал, позволяет и часть текста покрасить

у вас, в Эстонии, TEditподдерживает разноцветность?

Anatoly Podgoretsky (2009-07-31 13:13:00) [12]
> webpauk (31.07.2009 12:13:02) [2]

Это не событие, а свойства

Anatoly Podgoretsky (2009-07-31 13:13:00) [13]
> clickmaker (31.07.2009 12:50:05) [5]

Или то что я указал, позволяет и часть текста покрасить.

Palladin (2009-07-31 12:50:00) [14]

> [4] webpauk © (31.07.09 12:43)

Кто тебе вообще сказал что это возможно?

clickmaker (2009-07-31 12:50:00) [15]
> [4] webpauk © (31.07.09 12:43)

он не умеет
там можно только цвет всеготекста или фона изменить

webpauk (2009-07-31 12:43:00) [16]

> clickmaker © (31.07.09 12:27) [3]
>
Tedit!!!

clickmaker (2009-07-31 12:27:00) [17]
TRichEdit SelAttributes

webpauk (2009-07-31 12:13:00) [18]
где рисовать? событие какое?

Anatoly Podgoretsky (2009-07-31 12:10:00) [19]
> webpauk (31.07.2009 12:06:00) [0]

SetStart/SelLength

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »