-
Делаю наследника лейбла. Приходится временами отрисовывать на его канве что-нибудь. Как сделать это, чтобы изображение не терялось (как TImage)
-
Заместить метод Paint и рисовать в нем.
-
> Приходится временами отрисовывать на его канве что-нибудь
Покажите где и как отрисоываете.
-
2 DimaBar
QQQ=class(TLabel)
x:=QQQ.create(form1)
x.Left:=...
....
....
....
....
....
x.Canvas.MoveTo(...
x.Canvas.LineTo(...
form1.show;
Разумеется ничего так не видно :)
2 Юрий Зотов
На скока я понял приблизительно так
1. Создать свойство вроде TBitMap, в котором хранить картинку
2. Переписать метод Paint в котором отрисовывать BitMap на конву
или ошибаюсь?
-
> или ошибаюсь?
Ошибаешься.
TMyLabel = class (TCustomLabel)
...
procedure Paint; override;
end;
procedure TMyLabel.Paint;
begin
inherited; //или без него но все сам...
Canvas.MoveTo();
....
end;
Хотя... если тебе нужен сложный рисунок на канве твоей метки, то нужен будет и ТBitMap...
-
Так он будет отрисовывать постоянный некий Label (например в какой-то цветной рамке)
Создается куча TMyLabel-ов. В зависимости от того что за его свойства, иногда надо что-бы он отображал не Caption а эту картинку, и чтоб она не исчезала.
procedure TMyLabel.Paint;
begin
if условие(отображать как картинку)
then
inherited;
Canvas.MoveTo();
....
end;
-
begin...end; забыл
-
и не забыть при смене картинки вызывать invalidate
-
1. Как при не выполнении условия "отображать как картинку" вызвать метод Paint предка 2. При попатке BitMap.LoadFromFile вылетает AV. Подозреваю что накасячил в Get/SetBitmap Вот код:
unit flabel;
interface
uses
StdCtrls, Controls, Graphics, Classes;
type
TViewStyle = (vsText, vsImage);
TFLabel=class(TLabel)
private
FNumber: Integer;
FMaxLength: Integer;
FTextColor: TColor;
FViewStyle: TViewStyle;
FBitMap: Pointer;
protected
procedure Paint; override;
function GetNumber: Integer;
procedure SetNumber(Value: Integer);
function GetMaxLength: Integer;
procedure SetMaxLength(Value: Integer);
function GetTextColor: TColor;
procedure SetTextColor(Value: TColor);
function GetViewStyle: TViewStyle;
procedure SetViewStyle(Value: TViewStyle);
function GetBitMap: TBitMap;
procedure SetBitMap(Value: TBitMap);
published
property Number: Integer read GetNumber write SetNumber;
property MaxLength: Integer read GetMaxLength write SetMaxLength;
property TextColor: TColor read GetTextColor write SetTextColor;
property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsText;
property BitMap: TBitmap read GetBitMap write SetBitMap;
end;
implementation
uses main;
procedure TFLabel.Paint;
begin
if Viewstyle = vsImage then
with inherited Canvas do
Draw(0,0, BitMap);
end;
function TFLabel.GetNumber;
begin
Result:=FNumber;
end;
procedure TFLabel.SetNumber(Value: Integer);
begin
FNumber:=Value;
end;
function TFLabel.GetMaxLength;
begin
Result:=FMaxLength;
end;
procedure TFLabel.SetMaxLength(Value: Integer);
begin
FMaxLength:=Value;
end;
function TFLabel.GetTextColor: TColor;
begin
Result:=FTextColor;
end;
procedure TFLabel.SetTextColor(Value: TColor);
begin
FTextColor:=Value;
end;
function TFLabel.GetViewStyle: TViewStyle;
begin
Result:=FViewStyle;
end;
procedure TFLabel.SetViewStyle(Value: TViewStyle);
begin
FViewStyle:=Value;
end;
function TFLabel.GetBitMap: TBitMap;
begin
Result:=TBitMap(FBitMap);
end;
procedure TFLabel.SetBitMap(Value: TBitMap);
begin
FBitMap:=Value;
invalidate;
end;
end.
-
1. Снимается - туплю :)
-
[9] Мой, Sorry.
-
procedure TFLabel.Paint;
begin
if not(Viewstyle = vsImage)
then
inherited
else
Canvas.Draw(0,0, BitMap);
end;
-
> procedure TFLabel.SetBitMap(Value: TBitMap);
> begin
> FBitMap:=Value;
> invalidate;
> end;
FBitMap: TBitMap;
function TFLabel.GetBitMap: TBitMap;
begin
Result:=FBitMap;
end;
procedure TFLabel.SetBitMap(Value: TBitMap);
begin
FBitMap.Assign(Value);
invalidate;
end;
-
А TBitMap.Create в конструкторе нужен? Думаю что да. Да и деструктором чистить надо.
-
> [13] ByakaBuka (21.04.07 16:07)
Правильно думаешь...
И Paint ченить вот так:
procedure TFLabel.Paint;
begin
if (Viewstyle<>vsImage) or FBitMap.Empty then inherited
else with Canvas do StretchDraw(ClipRect, FBitMap);
end;
-
Вот последней релиз:
unit flabel;
interface
uses
StdCtrls, Controls, Graphics, Classes;
type
TViewStyle = (vsText, vsImage);
TFLabel=class(TLabel)
private
FNumber: Integer;
FMaxLength: Integer;
FTextColor: TColor;
FViewStyle: TViewStyle;
FBitMap: TBitMap;
protected
procedure Paint; override;
function GetNumber: Integer;
procedure SetNumber(Value: Integer);
function GetMaxLength: Integer;
procedure SetMaxLength(Value: Integer);
function GetTextColor: TColor;
procedure SetTextColor(Value: TColor);
function GetViewStyle: TViewStyle;
procedure SetViewStyle(Value: TViewStyle);
function GetBitMap: TBitMap;
procedure SetBitMap(Value: TBitMap);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Number: Integer read GetNumber write SetNumber;
property MaxLength: Integer read GetMaxLength write SetMaxLength;
property TextColor: TColor read GetTextColor write SetTextColor;
property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsText;
property BitMap: TBitmap read GetBitMap write SetBitMap;
end;
implementation
uses main;
procedure TFLabel.Paint;
begin
if Viewstyle = vsText then inherited;
if (Viewstyle <> vsImage) or FBitMap.Empty
then inherited
else
with Canvas do
StretchDraw(ClipRect, BitMap);
end;
function TFLabel.GetNumber;
begin
Result:=FNumber;
end;
procedure TFLabel.SetNumber(Value: Integer);
begin
FNumber:=Value;
end;
function TFLabel.GetMaxLength;
begin
Result:=FMaxLength;
end;
procedure TFLabel.SetMaxLength(Value: Integer);
begin
FMaxLength:=Value;
end;
function TFLabel.GetTextColor: TColor;
begin
Result:=FTextColor;
end;
procedure TFLabel.SetTextColor(Value: TColor);
begin
FTextColor:=Value;
end;
function TFLabel.GetViewStyle: TViewStyle;
begin
Result:=FViewStyle;
end;
procedure TFLabel.SetViewStyle(Value: TViewStyle);
begin
FViewStyle:=Value;
end;
function TFLabel.GetBitMap: TBitMap;
begin
Result:=FBitMap;
end;
procedure TFLabel.SetBitMap(Value: TBitMap);
begin
FBitMap.Assign(Value);
invalidate;
end;
constructor TFlabel.Create(AOwner: TComponent);
begin
BitMap:=TBitmap.Create;
inherited Create(AOwner);
end;
destructor TFlabel.Destroy;
begin
BitMap.Free;
invalidate;
inherited Destroy;
end;
end.
AV вылетает на FBitMap.Assign(Value);при создании
-
> constructor TFlabel.Create(AOwner: TComponent);
> begin
> BitMap:=TBitmap.Create;
> inherited Create(AOwner);
> end;
Inherited; сначала, а потом создание FBitMap'а constructor TFLabel.Create;
begin
inherited;
FBitMap:=TBitMap.Create;
end; и Paint переделай(См [14]) :) два раза рисует текст - не серьезно :( Так-же используются не все свойства, типа TextColor, MaxLength, Number - может и нафик не нужны? TextColor - заменятся Font.Color. В принципе можно так: function TFLabel.GetTextColor: TColor;
begin
Result:=Canvas.Font.Color;
end;
procedure TFLabel.SetTextColor(Value: TColor);
begin
Canvas.Font.Color:=Value;
Invalidate;
end; FTextColor - не нужна.
-
> Inherited; сначала, а потом создание FBitMap'а
Да, спасибо. FBitMap
> и Paint переделай
Косяк. :) Осталась строчка. Забыл убрать. Но не смертельно! Думаю вот так:
procedure TFLabel.Paint;
begin
if (Viewstyle <> vsImage)
then inherited
else
if not(FBitMap.Empty) then
with Canvas do
StretchDraw(ClipRect, BitMap);
end;
Кстати, почему Stretch?
> Так-же используются не все свойства, типа TextColor, MaxLength,
> Number - может и нафик не нужны?
> TextColor - заменятся Font.Color. В принципе можно так:
>
> function TFLabel.GetTextColor: TColor;
> begin
> Result:=Canvas.Font.Color;
> end;
>
> procedure TFLabel.SetTextColor(Value: TColor);
> begin
> Canvas.Font.Color:=Value;
> Invalidate;
> end;
> FTextColor - не нужна.
TextColor <> Font.Color Font.Color может менятся (например при наведении крыски) TextColor это изначальный цвет который должен быть (например мышь ушла). Можно конечно использывать tag, но не красиво это, если можно сво-во свое прикрутить в данный момент. Но это уже в другую тему. Еще раз спасибо!
-
> Кстати, почему Stretch?
Это на твое усмотрение, можно и Draw'ом выводить... но учитывай, что рисунок может быть не равным клиентской области твоей метки...
Так-же еще есть и CopyRect....тоже может пригодится при "наведении мышки" на метку
> Косяк. :) Осталась строчка. Забыл убрать. Но не смертельно!
> Думаю вот так:
>
> procedure TFLabel.Paint;
> begin
> if (Viewstyle <> vsImage)// or FBitMap.Empty
> then inherited
> else
> if not(FBitMap.Empty) then
> with Canvas do
> StretchDraw(ClipRect, BitMap);
> end;
Ну опять... вот смотри: если стоит стиль vsImage, а FBitMap=nil(Empty), то что - твоя метка ничего не покажет?(т.е будет пустой). Ну если ты так задумал, то ладно.
> TextColor <> Font.Color
>
> Font.Color может менятся (например при наведении крыски) TextColor это изначальный цвет который должен быть (например мышь ушла).
Ну здесь однозначно напрашиваются тройка свойств, типа: HotTrack: Boolean и TextColor1, TextColor2: TColor(названия только поэлегантней придумай).
И также добавить OnMouseEnter(Leave) события.:
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
ЗЫ ByakaBuka - А почему не iXT? :)
-
Добавлю свои пять копеек. Не плохо было бы перерисовать при изменении картинки. Я возьму и не буду добавлять через LadFromFile, а просто нарисую что-нибудь на ней. Или изменю размеры.
constructor TFlabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BitMap:=TBitmap.Create;
BitMap.OnChange := ChangeBitMap;
end;
procedure TFlabel.ChangeBitMap;
begin
Invaidate;
end;
|
Есть новые 
Нет новых [134427 +34][b:0][p:0.003]