Ручная прорисовка TEdit

← →
Vaitek_ (2005-12-19 16:50) [0]

Нужен компонент, реализующий однострочный редактр, но в своей графической оболчке. Хочу написать сам.
Как идея - унаследовать свой компонет от TCustomEdit (чтобы не изобретать велосипед). Но TCustomEdit создан от TWinControl и не имеет Canvas и не ловит WM_PAINT.

В принципе, я могу добавить Canvas, как это сделано в TGraphicControl, но не совсем понимаю, с чего винда будет считать, что я сам должен отрисовывать компонент вручную. Или как раз TControlCanvas за это отвечает?

constructor TGraphicControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;

В общем скажите, в нужную сторону иду или нет?

← →
Юрий Зотов © (2005-12-19 17:06) [1]

> Vaitek_ (19.12.05 16:50)

> CustomEdit ... не имеет Canvas

Зато имеет DC. Значит, ввести Canvas - не вопрос.

> и не ловит WM_PAINT.

Это новость. Еще как ловит. Даже не ловит, а, как и любое другое видимое окно, просто получает, без всякой ловли.

> с чего винда будет считать, что я сам должен отрисовывать компонент

Винда ничего не считает. Она просто определяет, что окно или его часть требует отрисовки и шлет окну соответствующее сообщение. А уж как окно на это сообщение отреагирует - это его личное дело и винде оно по барабану.

============

Я бы наследовался от TCustomEdit и ввел в него свою обработку сообщений отрисовки (можно с добавлением TControlCanvas, а можно и без него, используя DC напрямую). Думаю, этот путь наиболее прост, а пример см. в TDBEdit.

← →
Vaitek_ (2005-12-19 22:09) [2]

Я наверное торможу :-( но...

делаю так:
...
FCanvas: TControlCanvas;
...
constructor TvEdit.Create(AOwner: TComponent);
begin
inherited;
Ctl3D := False;
BevelInner := bvNone;
BevelOuter := bvNone;
BorderStyle := bsNone;
FCanvas := TControlCanvas.Create;
FCanvas.Control := Self;
End;
...
procedure TvEdit.WMPaint(var Message: TWMPaint);
Var
DC: HDC;
PS: TPaintStruct;
begin
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
FCanvas.LineTo(10,10);
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;

Использую компонент и наблюдаю черную диганальнкую линию, на белом фоне. Как и было задумано. Но как только фокус ввода передается в компонент, он начинает отрисовать надпись так же как и обычно, затирая мою линию :-(

Как быть?

← →
Юрий Зотов © (2005-12-20 04:44) [3]

> Vaitek_ (19.12.05 22:09) [2]

Дык... а что же Вы хотели? Хотели Edit - его и получили. А Edit обязан отрисовывать текст - вот он его и отрисовывает. Как умеет - так и отрисовывает, он же не знает о Ваших наворотах. А чтобы совместить его собственное рисование с Вашим, нужно проводить дополнительную обработку (получения фокуса и изменения текста).

Кроме того, при грамотном подходе к ООП есть смысл:

- вынести рисование в отдельный динамический метод, чтобы, перекрывая его, вполне возможные потомки могли рисовать так, как нужно им;

- ввести свойство, определяющее, выполнять стандартную прорисовку текста, или нет;

- вынести дополнительную отрисовку в пользовательское событие, чтобы юзер мог рисовать так, как нужно ему, но при этом не мог вмешаться во внутренние механизмы компонента с риском нарушить их;

- сделать Custom-компонент, а регистрировать его потомок, в котором опубликованы нужные свойства.

Еще неплохо было бы сделать рисование потокобезопасным (см. методы Lock и Unlock у TCanvas). И в результате всего этого получим вот что:
unit PaintedEdit; interface uses Windows, Messages, Classes, Graphics, Controls, StdCtrls, Forms; type TPaintEvent = procedure (Sender: TObject; Canvas: TCanvas) of object; TYzCustomPaintedEdit = class(TCustomEdit) private FCanvas: TCanvas; FDefaultDrawing: boolean; FOnPaint: TPaintEvent; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure CMEnter(var Message: TCMEnter); message CM_ENTER; procedure SetDefaultDrawing(const Value: boolean); protected procedure Change; override; procedure Paint; dynamic; property BevelInner default bvNone; property BevelOuter default bvNone; property BorderStyle default bsNone; property Ctl3D default False; property Canvas: TCanvas read FCanvas; property DefaultDrawing: boolean read FDefaultDrawing write SetDefaultDrawing default True; property OnPaint: TPaintEvent read FOnPaint write FOnPaint; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; TYzPaintedEdit = class(TYzCustomPaintedEdit) published property Color; property DefaultDrawing; property Font; property Text; property OnPaint; end; implementation { TYzCustomPaintedEdit } procedure TYzCustomPaintedEdit.Change; begin inherited; Invalidate end; procedure TYzCustomPaintedEdit.CMEnter(var Message: TCMEnter); begin inherited; Invalidate end; constructor TYzCustomPaintedEdit.Create(AOwner: TComponent); begin inherited; BevelInner := bvNone; BevelOuter := bvNone; BorderStyle := bsNone; Ctl3D := False; FDefaultDrawing := True; FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self end; destructor TYzCustomPaintedEdit.Destroy; begin FCanvas.Free; inherited end; procedure TYzCustomPaintedEdit.Paint; begin if FDefaultDrawing then with FCanvas do begin Brush.Color := Color; Font.Assign(Self.Font); TextRect(ClipRect, 0, 0, Text) end; if Assigned(FOnPaint) then FOnPaint(Self, FCanvas) end; procedure TYzCustomPaintedEdit.SetDefaultDrawing(const Value: boolean); begin if FDefaultDrawing <> Value then begin FDefaultDrawing := Value; Invalidate end end; procedure TYzCustomPaintedEdit.WMPaint(var Message: TWMPaint); var DC: HDC; PS: TPaintStruct; begin DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS); if DC <> 0 then begin FCanvas.Lock; try FCanvas.Handle := DC; try Paint finally FCanvas.Handle := 0; if Message.DC = 0 then EndPaint(Handle, PS) end finally FCanvas.Unlock end end end; end.

И не забывайте перед вызовом LineTo вызывать MoveTo, иначе при второй и следующих отрисовках перо не сдвинется и ничего не нарисуется. Вот обработчик события OnPaint, рисующий Вашу любимую диагональную линию:
procedure TForm1.YzPaintedEdit1Paint(Sender: TObject; Canvas: TCanvas); begin with Canvas, ClipRect do begin MoveTo(Left, Top); LineTo(Right, Bottom) end end;

← →
FrykT © (2005-12-22 20:07) [4]

Поясните что такое Invalidate ? Перерисовка просто?

← →
Юрий Зотов © (2005-12-23 01:29) [5]

> FrykT © (22.12.05 20:07) [4]

Не сама перерисовка, а запрос на нее. В справке описано.

Я аналогичным путем пытался сделать канву Мемо. Канва-то получилась, только то, что на ней отрисовывалось при скроллинге частично старалось, а как с этим бороться я так и не понял.
OnPaint приделывается очень просто

procedure Paint; override;

begin
inhereted;
If Assigned(OnPaint)
then Onpaint(self)
end;
Так что ловить и правда не надо ничего.

TStas, я тоже пробывал в TMemo делать ручную прорисовку, чтобы картинки можно было и текст, но понял что глупо делаю, т.к. перкрывать надо много методов. Проще сделать от TCustomXXX.

>OnPaint приделывается очень просто
Это я не про Мемо писал. Я писал вообще, у Мемо нет paint.

Ручная прорисовка TEdit Найти похожие ветки