Solved

My own TGraphicControl with Autosize option

Posted on 2004-10-03
7
441 Views
Last Modified: 2008-01-09
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,FRenderImage, 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,FRenderImage);
      end else
      self.canvas.Draw(0,0,FRenderImage);
    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..



0
Comment
Question by:joepezt
  • 4
  • 3
7 Comments
 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12216981
It is better when you seperate the two. Painting the rotated bitmap is
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
0
 
LVL 2

Author Comment

by:joepezt
ID: 12217881
hmm yes, I noticed this when setting my control to transparent, i got white "dust" on the edges...

logfont, hmmm
0
 
LVL 1

Accepted Solution

by:
Bart_Thomas earned 50 total points
ID: 12219498
A good place to autosize your control can be the (public) SetBounds function:

procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

What you can do is create a DoResize procedure who calculates the correct Width and Height.

  DoResize (AWidth,AHeight);
  inherited SetBounds (ALeft,ATop, AWidth,AHeight);

Maybe you know how to calculate the correct Width and Height. If don't, here's some code:

procedure TRotated.DoResize(var AWidth,AHeight: Integer);
var
  sz: TSize;
  x,y: array[0..3] of Double;
  px,py,minx,miny,maxx,maxy: Double;
  p,q,i: Integer;
  logFont: TLogfont;
begin
  GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @logfont);
  logfont.lfQuality := ANTIALIASED_QUALITY;
  logfont.lfEscapement := Trunc (FAngle * 10);
  logfont.lfOrientation := Trunc (FAngle * 10);
  Canvas.Font.Handle := CreateFontIndirect(logfont);

  sz := Canvas.TextExtent(FCaption);
  if (sz.cx = 0) or (sz.cy = 0) then
    Exit;

  x[0] := -sz.cx/2;
  y[0] := -sz.cy/2;

  x[1] := sz.cx/2;
  y[1] := -sz.cy/2;

  x[2] := sz.cx/2;
  y[2] := sz.cy/2;

  x[3] := -sz.cx;
  y[3] := sz.cy/2;

  // x' = x cos (a)  - y sin (a)
  // y' = x sin (a)  + y cos (a)
  for i := 0 to 3 do
    Rotate (x[i],y[i], -FAngle);

  minx := x[0];
  miny := y[0];
  maxx := x[0];
  maxy := y[0];

  for i := 0 to 3 do
  begin
    minx := Min (minx,x[i]);
    miny := Min (miny,y[i]);
    maxx := Max (maxx,x[i]);
    maxy := Max (maxy,y[i]);
  end;

  AWidth := Trunc (maxx - minx);
  AHeight := Trunc (maxy - miny);
  px := AWidth / 2;
  py := AHeight / 2;
  FTextPosition.X := Trunc(x[0]+ px);
  FTextPosition.Y := Trunc(y[0] + py);
end;
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12219567
Ow... I fogot a little detail!
You must use a true type font.
0
 
LVL 2

Author Comment

by:joepezt
ID: 12219927
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
0
 
LVL 1

Expert Comment

by:Bart_Thomas
ID: 12220438
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(AOwner: TComponent);
begin
  inherited;
  FLabelImage := TBitmap.Create;
end;

destructor TDarkRotateLabel.Destroy;
begin
  FLabelImage.Free;
  inherited;
end;

procedure TDarkRotateLabel.SetCaption(const Value: String);
var
  sz: TSize;
  rect; TRect;
begin
  FCaption := Value;

  FLabelImage.Canvas.Font := Font;
  sz := FLabelImage.Canvas.TextExtent(FCaption);
  FLabelImage.Width := sz.cx;
  FLabelImage.Height := sz.cy;

  SetRect (rect, 0,0,sz.cx,sz.cy);

  FLabelImage.Canvas.Brush.Color := clWhite;
  FLabelImage.Canvas.Brush.Style := bsSolid;
  FLabelImage.Canvas.FillRect(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.
0
 
LVL 2

Author Comment

by:joepezt
ID: 12220676
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..
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now