joepezt
asked on
My own TGraphicControl with Autosize option
hi!
can any experts tell me how to solve the following dillema
I made a new component based on TGraphicControl :
procedure TDarkRotateLabel.paint;
var
LabelImage : TBitmap;
FRenderImage : TBitmap;
Center : TPoint;
begin
inherited;
if update then
begin
LabelImage := TBitmap.Create;
FRenderImage := TBitmap.Create;
with LabelImage do
try
if (Self.Transparent) then
Transparent := true;
Canvas.Font.Assign(FFont);
PixelFormat := pf24bit;
Width := Canvas.TextWidth(Caption);
Height := Canvas.TextHeight(Caption) ;
Canvas.TextOut(0,0,caption );
with FRenderImage do
begin
if self.Transparent then
Transparent := true;
Width := self.Width;
height := self.Height;
PixelFormat := pf24bit;
end;
with TJvPaintFX.Create do
try
Center.x := (self.Width div 2);
Center.y := (self.Height div 2);
SmoothRotate(LabelImage,FR enderImage , Center.X, Center.Y, FAngle);
finally
free;
end;
if autosize then
begin
{ THIS IS WHERE I NEED TO CALCULATE THE AUTOSIZE }
self.width := Abs(Trunc(width * cos(fAngle*Pi/180))) + Abs(Trunc(height * sin(fangle*Pi/180)));
self.height := Abs(Trunc(height * sin(fAngle*Pi/180))) + Abs(Trunc(height * cos(fAngle*Pi/180)));
self.canvas.Draw(0,0,FRend erImage);
end else
self.canvas.Draw(0,0,FRend erImage);
finally
FreeAndNil(FRenderImage);
FreeAndNil(LabelImage);
free
end;
end;
end;
// -------------------------- ---------- ---------- ----------
How to make it act like the TLabel's autosize property?.. ii tought of a "solution" where I can "auto crop" the excessive whites around the rect of the actual FRendered image.. but I have no idea how to do this....
i searched through various solutions on googlee, but most of them did not exactly what I wanted..
can any experts tell me how to solve the following dillema
I made a new component based on TGraphicControl :
procedure TDarkRotateLabel.paint;
var
LabelImage : TBitmap;
FRenderImage : TBitmap;
Center : TPoint;
begin
inherited;
if update then
begin
LabelImage := TBitmap.Create;
FRenderImage := TBitmap.Create;
with LabelImage do
try
if (Self.Transparent) then
Transparent := true;
Canvas.Font.Assign(FFont);
PixelFormat := pf24bit;
Width := Canvas.TextWidth(Caption);
Height := Canvas.TextHeight(Caption)
Canvas.TextOut(0,0,caption
with FRenderImage do
begin
if self.Transparent then
Transparent := true;
Width := self.Width;
height := self.Height;
PixelFormat := pf24bit;
end;
with TJvPaintFX.Create do
try
Center.x := (self.Width div 2);
Center.y := (self.Height div 2);
SmoothRotate(LabelImage,FR
finally
free;
end;
if autosize then
begin
{ THIS IS WHERE I NEED TO CALCULATE THE AUTOSIZE }
self.width := Abs(Trunc(width * cos(fAngle*Pi/180))) + Abs(Trunc(height * sin(fangle*Pi/180)));
self.height := Abs(Trunc(height * sin(fAngle*Pi/180))) + Abs(Trunc(height * cos(fAngle*Pi/180)));
self.canvas.Draw(0,0,FRend
end else
self.canvas.Draw(0,0,FRend
finally
FreeAndNil(FRenderImage);
FreeAndNil(LabelImage);
free
end;
end;
end;
// --------------------------
How to make it act like the TLabel's autosize property?.. ii tought of a "solution" where I can "auto crop" the excessive whites around the rect of the actual FRendered image.. but I have no idea how to do this....
i searched through various solutions on googlee, but most of them did not exactly what I wanted..
ASKER
hmm yes, I noticed this when setting my control to transparent, i got white "dust" on the edges...
logfont, hmmm
logfont, hmmm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Ow... I fogot a little detail!
You must use a true type font.
You must use a true type font.
ASKER
altho, I did get the original control to work, by creating a new class descendand of TCustomControl
and sending a postmessage WM_USER + 1 with the pointer integer of "self" with invalidate
but I will accept your sollution as well
and sending a postmessage WM_USER + 1 with the pointer integer of "self" with invalidate
but I will accept your sollution as well
Allright, thanks.
I noticed you recreate a bitmap with the caption every time you repaint your control. That's can be avoided by adding the LabelImage to the class as private field and repaint it when the caption changes:
TDarkRotateLabel = class (TCustomControl)
private
FCaption: String;
FLabelImage: TBitmap;
procedure SetCaption(const Value: String);
protected
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property Caption: String read FCaption write SetCaption;
end;
{ TDarkRotateLabel }
constructor TDarkRotateLabel.Create(AO wner: TComponent);
begin
inherited;
FLabelImage := TBitmap.Create;
end;
destructor TDarkRotateLabel.Destroy;
begin
FLabelImage.Free;
inherited;
end;
procedure TDarkRotateLabel.SetCaptio n(const Value: String);
var
sz: TSize;
rect; TRect;
begin
FCaption := Value;
FLabelImage.Canvas.Font := Font;
sz := FLabelImage.Canvas.TextExt ent(FCapti on);
FLabelImage.Width := sz.cx;
FLabelImage.Height := sz.cy;
SetRect (rect, 0,0,sz.cx,sz.cy);
FLabelImage.Canvas.Brush.C olor := clWhite;
FLabelImage.Canvas.Brush.S tyle := bsSolid;
FLabelImage.Canvas.FillRec t(rect);
SetBkMode (FLabelImage.Canvas.Handle , TRANSPARENT);
SetTextColor (FLabelImage.Canvas.Handle , clBlack);
FLabelImage.Canvas.TextOut (0,sz.cy, FCaption);
end;
You even can rotate the text and only blit the image to the target in the Paint-procedure.
I noticed you recreate a bitmap with the caption every time you repaint your control. That's can be avoided by adding the LabelImage to the class as private field and repaint it when the caption changes:
TDarkRotateLabel = class (TCustomControl)
private
FCaption: String;
FLabelImage: TBitmap;
procedure SetCaption(const Value: String);
protected
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property Caption: String read FCaption write SetCaption;
end;
{ TDarkRotateLabel }
constructor TDarkRotateLabel.Create(AO
begin
inherited;
FLabelImage := TBitmap.Create;
end;
destructor TDarkRotateLabel.Destroy;
begin
FLabelImage.Free;
inherited;
end;
procedure TDarkRotateLabel.SetCaptio
var
sz: TSize;
rect; TRect;
begin
FCaption := Value;
FLabelImage.Canvas.Font := Font;
sz := FLabelImage.Canvas.TextExt
FLabelImage.Width := sz.cx;
FLabelImage.Height := sz.cy;
SetRect (rect, 0,0,sz.cx,sz.cy);
FLabelImage.Canvas.Brush.C
FLabelImage.Canvas.Brush.S
FLabelImage.Canvas.FillRec
SetBkMode (FLabelImage.Canvas.Handle
SetTextColor (FLabelImage.Canvas.Handle
FLabelImage.Canvas.TextOut
end;
You even can rotate the text and only blit the image to the target in the Paint-procedure.
ASKER
ah, thanks!, I will see if i can use some of this. the setbkmode might be usefull...
I do save my lavelimage to a temporary image declared in privatesection, and if set update := true when I need to invalidate to be sure I can reupdate my image. if update = false then just repaint the old image..
I do save my lavelimage to a temporary image declared in privatesection, and if set update := true when I need to invalidate to be sure I can reupdate my image. if update = false then just repaint the old image..
different from calculating how big your control must be. Whenever the
Caption or Angle changes you can recalculate how your controls sizes.
And you don't need the TJvPaintFX. Windows has a LOGFONT (TLogFont
in Delphi) which can paint rotated text. It can even anti-alias the text
for you.
Bart Thomas