Rotate TImage in Delphi

Question

I am doing just for fun a virtual desktop to play Magic The Gathering with friends. I am using Delphi 2010. The cards are represented in the application by TImage components (loading PNG files of the cards loaded from a database). The point here is that in MTG a very common thing to do is to tap a card (rotating it 90º degrees to right). There is a simple way to do this? I really don't need the "animation", just the card rotated once is clicked (animation would be nice though). The game should work simultaneously with many cards and they can be moved anywhere in the form. I am thinking in having the image of the card tapped and untapped in the database but this may be an overkill if there is a nice and efficient way to rotate the cards.

Any ideas?

Solution 1

Or you can leave the TImage and use e.g. TPaintBox and GDI+ library. GDI+ has the RotateFlip method directly for doing this. Using the GDI+ Library for Delphi it would look like:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActiveX, GDIPOBJ, GDIPAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    FImage: TGPImage;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Stream: IStream;
  BlobStream: TMemoryStream;
begin
  BlobStream := TMemoryStream.Create;
  try
    // assuming the BlobStream here has a valid image loaded from a database
    Stream := TStreamAdapter.Create(BlobStream);
    FImage := TGPImage.Create(Stream);
  finally
    BlobStream.Free;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FImage.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FImage.RotateFlip(Rotate90FlipNone);
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  with TGPGraphics.Create(PaintBox1.Canvas.Handle) do
  try
    DrawImage(FImage, 0, 0);
  finally
    Free;
  end;
end;

end.

Such an overkill, doesn't it :-?

Solution 2

The old-skool way of doing this is with PlgBlt.

procedure RotateBitmap90CW(b1,b2:TBitmap);
var
  x,y:integer;
  p:array[0..2] of TPoint;
begin
  x:=b1.Width;
  y:=b1.Height;
  b2.Width:=y;
  b2.Height:=x;
  p[0].X:=y;
  p[0].Y:=0;
  p[1].X:=y;
  p[1].Y:=x;
  p[2].X:=0;
  p[2].Y:=0;
  PlgBlt(b2.Canvas.Handle,p,b1.Canvas.Handle,0,0,x,y,0,0,0);
end;

Solution 3

You could use a TPaintBox instead of a TImage and use SetWorldTransform with a rotation matrix to draw the tapped card. I use StretchDrawRotated for this:

procedure XForm_SetRotation(out AXForm: TXForm; AAngle: Extended; ACenter: TPoint);
var
  SinA, CosA: Extended;
begin
  SinCos(AAngle, SinA, CosA);
  AXForm.eM11 := CosA;
  AXForm.eM12 := SinA;
  AXForm.eM21 := -SinA;
  AXForm.eM22 := CosA;
  AXForm.eDx := (ACenter.X - (CosA * ACenter.X)) + ((SinA * ACenter.Y));
  AXForm.eDy := (ACenter.Y - (SinA * ACenter.X)) - ((CosA * ACenter.Y));
end;

procedure StretchDrawRotated(ACanvas: TCanvas; const ARect: TRect; AAngle: Extended; ACenter: TPoint; AGraphic: TGraphic);
var
  XForm, XFormOld: TXForm;
  GMode: Integer;
begin
  GMode := SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  try
    if GetWorldTransform(ACanvas.Handle, XFormOld) then
      try
        XForm_SetRotation(XForm, AAngle, ACenter);
        SetWorldTransform(ACanvas.Handle, XForm);
        ACanvas.StretchDraw(ARect, AGraphic);
      finally
        SetWorldTransform(ACanvas.Handle, XFormOld);
      end;
  finally
    SetGraphicsMode(ACanvas.Handle, GMode);
  end;
end;

Solution 4

You can also use the Graphics32 library or just this function I grabbed some time ago from CodeCentral:

{by Gustavo Daud (Submited on 21 May 2006 )
Use this method to rotate RGB and RGB Alpha 'Portable Network Graphics' Images using a smooth antialiased algorithm in order to get much better results.
Note: Part of this code was based on JansFreeware code [http://jansfreeware.com/]
This is only possible when using the 1.56 library version.}

{Smooth rotate a png object}
procedure SmoothRotate(var aPng: TPNGImage; Angle: Extended);

  {Supporting functions}
  function TrimInt(i, Min, Max: Integer): Integer;
  begin
    if      i>Max then Result:=Max
    else if i<Min then Result:=Min
    else               Result:=i;
  end;
  function IntToByte(i:Integer):Byte;
  begin
    if      i>255 then Result:=255
    else if i<0   then Result:=0
    else               Result:=i;
  end;
  function Min(A, B: Double): Double;
  begin
    if A < B then Result := A else Result := B;
  end;
  function Max(A, B: Double): Double;
  begin
    if A > B then Result := A else Result := B;
  end;
  function Ceil(A: Double): Integer;
  begin
    Result := Integer(Trunc(A));
    if Frac(A) > 0 then
      Inc(Result);
  end;

  {Calculates the png new size}
  function newsize: tsize;
  var
    fRadians: Extended;
    fCosine, fSine: Double;
    fPoint1x, fPoint1y, fPoint2x, fPoint2y, fPoint3x, fPoint3y: Double;
    fMinx, fMiny, fMaxx, fMaxy: Double;
  begin
    {Convert degrees to radians}
    fRadians := (2 * PI * Angle) / 360;

    fCosine := abs(cos(fRadians));
    fSine := abs(sin(fRadians));

    fPoint1x := (-apng.Height * fSine);
    fPoint1y := (apng.Height * fCosine);
    fPoint2x := (apng.Width * fCosine - apng.Height * fSine);
    fPoint2y := (apng.Height * fCosine + apng.Width * fSine);
    fPoint3x := (apng.Width * fCosine);
    fPoint3y := (apng.Width * fSine);

    fMinx := min(0,min(fPoint1x,min(fPoint2x,fPoint3x)));
    fMiny := min(0,min(fPoint1y,min(fPoint2y,fPoint3y)));
    fMaxx := max(fPoint1x,max(fPoint2x,fPoint3x));
    fMaxy := max(fPoint1y,max(fPoint2y,fPoint3y));

    Result.cx := ceil(fMaxx-fMinx);
    Result.cy := ceil(fMaxy-fMiny);
  end;
type
 TFColor  = record b,g,r:Byte end;
var
Top, Bottom, Left, Right, eww,nsw, fx,fy, wx,wy: Extended;
cAngle, sAngle:   Double;
xDiff, yDiff, ifx,ify, px,py, ix,iy, x,y, cx, cy: Integer;
nw,ne, sw,se: TFColor;
anw,ane, asw,ase: Byte;
P1,P2,P3:Pbytearray;
A1,A2,A3: pbytearray;
dst: TPNGImage;
IsAlpha: Boolean;
new_colortype: Integer;
begin
  {Only allows RGB and RGBALPHA images}
  if not (apng.Header.ColorType in [COLOR_RGBALPHA, COLOR_RGB]) then
    raise Exception.Create('Only COLOR_RGBALPHA and COLOR_RGB formats' +
    ' are supported');
  IsAlpha := apng.Header.ColorType in [COLOR_RGBALPHA];
  if IsAlpha then new_colortype := COLOR_RGBALPHA else
    new_colortype := COLOR_RGB;

  {Creates a copy}
  dst := tpngobject.Create;
  with newsize do
    dst.createblank(new_colortype, 8, cx, cy);
  cx := dst.width div 2; cy := dst.height div 2;

  {Gather some variables}
  Angle:=angle;
  Angle:=-Angle*Pi/180;
  sAngle:=Sin(Angle);
  cAngle:=Cos(Angle);
  xDiff:=(Dst.Width-apng.Width)div 2;
  yDiff:=(Dst.Height-apng.Height)div 2;

  {Iterates over each line}
  for y:=0 to Dst.Height-1 do
  begin
    P3:=Dst.scanline[y];
    if IsAlpha then A3 := Dst.AlphaScanline[y];
    py:=2*(y-cy)+1;
    {Iterates over each column}
    for x:=0 to Dst.Width-1 do
    begin
      px:=2*(x-cx)+1;
      fx:=(((px*cAngle-py*sAngle)-1)/ 2+cx)-xDiff;
      fy:=(((px*sAngle+py*cAngle)-1)/ 2+cy)-yDiff;
      ifx:=Round(fx);
      ify:=Round(fy);

      {Only continues if it does not exceed image boundaries}
      if(ifx>-1)and(ifx<apng.Width)and(ify>-1)and(ify<apng.Height)then
      begin
        {Obtains data to paint the new pixel}
        eww:=fx-ifx;
        nsw:=fy-ify;
        iy:=TrimInt(ify+1,0,apng.Height-1);
        ix:=TrimInt(ifx+1,0,apng.Width-1);
        P1:=apng.scanline[ify];
        P2:=apng.scanline[iy];
        if IsAlpha then A1 := apng.alphascanline[ify];
        if IsAlpha then A2 := apng.alphascanline[iy];
        nw.r:=P1[ifx*3];
        nw.g:=P1[ifx*3+1];
        nw.b:=P1[ifx*3+2];
        if IsAlpha then anw:=A1[ifx];
        ne.r:=P1[ix*3];
        ne.g:=P1[ix*3+1];
        ne.b:=P1[ix*3+2];
        if IsAlpha then ane:=A1[ix];
        sw.r:=P2[ifx*3];
        sw.g:=P2[ifx*3+1];
        sw.b:=P2[ifx*3+2];
        if IsAlpha then asw:=A2[ifx];
        se.r:=P2[ix*3];
        se.g:=P2[ix*3+1];
        se.b:=P2[ix*3+2];
        if IsAlpha then ase:=A2[ix];


        {Defines the new pixel}
        Top:=nw.b+eww*(ne.b-nw.b);
        Bottom:=sw.b+eww*(se.b-sw.b);
        P3[x*3+2]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
        Top:=nw.g+eww*(ne.g-nw.g);
        Bottom:=sw.g+eww*(se.g-sw.g);
        P3[x*3+1]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
        Top:=nw.r+eww*(ne.r-nw.r);
        Bottom:=sw.r+eww*(se.r-sw.r);
        P3[x*3]:=IntToByte(Round(Top+nsw*(Bottom-Top)));

        {Only for alpha}
        if IsAlpha then
        begin
          Top:=anw+eww*(ane-anw);
          Bottom:=asw+eww*(ase-asw);
          A3[x]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
        end;

      end;
    end;
  end;

  apng.assign(dst);
  dst.free;
end;

View more solutions

Comments

[Averroes]

You pass two bitmaps to this method. I have the bitmap of the card I want to tap. What is the another one?

[Stijn Sanders]

I would recommend you pass the card bitmap as b1, and a temporary TBitmap instance you create just for calling this procedure, and then use it to draw on a destination Canvas. You could also change the procedure a bit to accept a canvas handle and destination coordinates to pass into PlgBlt directly.

[Arioch 'The]

Wow! but why not use Rotate ? graphics32.org/documentation/Docs/Units/GR32_Transforms/Clas‌​ses/…

[Server Overflow]

output of SetWorldTransform is quite poor for any 'non-right' angle (90, 180, 270) because it does not offer antialising