(Resolvido) Girar uma Timagem por grau sem ser apenas em 45° ou 90 °

[Visitante]

é possivel girar uma Timagem por grau sem ser apenas em 45° ou 90 ° , mas  conforme o valor de uma variável 

agradeçido quem poder dar ajuda

[Jhonas]

exemplos:

http://fanzinepas.blogspot.com/2009/12/esta-semana-estava-fazendo-uma-pesquisa.html

outro

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RxGIF, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Math;
 
function Rotacionar(Bitmap: TBitmap; const Angulo: Extended;
  bgColor: TColor): TBitmap;
type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..0] of TRGBQuad;
var
  bgRGB: TRGBQuad;
  BitmapInfo: TBitmapInfo;
  CosTheta: Extended;
  DC: HDC;
  dstBMP: HBITMAP;
  dstHeight: Integer;
  dstRGB: PRGBQuad;
  dstRGBs: PRGBQuadArray;
  dstWidth: Integer;
  iCosTheta: Integer;
  iSinTheta: Integer;
  NormalAngle: Extended;
  SinTheta: Extended;
  srcBMP: HBITMAP;
  srcHeight: Integer;
  srcRGBs: PRGBQuadArray;
  srcWidth: Integer;
  xDst: Integer;
  xODst: Integer;
  xOSrc: Integer;
  xPrime: Integer;
  xSrc: Integer;
  yDst: Integer;
  yODst: Integer;
  yOSrc: Integer;
  yPrime: Integer;
  yPrimeCosTheta: Integer;
  yPrimeSinTheta: Integer;
  ySrc: Integer;
begin
  // Convertendo o background da imagem em formato RGB:
  bgColor := ColorToRGB(bgColor);
  with bgRGB do
  begin
    rgbRed := Byte(bgColor);
    rgbGreen := Byte(bgColor shr 8);
    rgbBlue := Byte(bgColor shr 16);
    rgbReserved := Byte(bgColor shr 24);
  end;
 
  // Calculando o Sen e Cos do ângulo de rotação:
  NormalAngle := Frac(Angulo / 360.0) * 360.0;
  SinCos(Pi * -NormalAngle / 180, SinTheta, CosTheta);
  iSinTheta := Trunc(SinTheta * (1 shl 16));
  iCosTheta := Trunc(CosTheta * (1 shl 16));

  // Ajustando o bitmap de origem:
  srcBMP := Bitmap.Handle;
  srcWidth := Bitmap.Width;
  srcHeight := Bitmap.Height;
  xOSrc := srcWidth shr 1;
  yOSrc := srcHeight shr 1;
 
  // Preparando a imagem de destino:
  dstWidth := SmallInt((srcWidth * Abs(iCosTheta) +
    srcHeight * Abs(iSinTheta)) shr 16);
  dstHeight := SmallInt((srcWidth * Abs(iSinTheta) +
    srcHeight * Abs(iCosTheta)) shr 16);
  xODst := dstWidth shr 1;
  if not Odd(dstWidth) and
    ((NormalAngle = 0.0) or (NormalAngle = -90.0)) then
    Dec(xODst);
  yODst := dstHeight shr 1;
  if not Odd(dstHeight) and
    ((NormalAngle = 0.0) or (NormalAngle = +90.0)) then
    Dec(yODst);
 
  // Inicializa o header do bitmap:
  FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
  with BitmapInfo.bmiHeader do
  begin
    biSize := SizeOf(BitmapInfo.bmiHeader);
    biCompression := BI_RGB;
    biBitCount := 32;
    biPlanes := 1;
  end;
 
  // Lendo bits RGB do bitmap de origem e destino:
  DC := CreateCompatibleDC(0);
  try
    BitmapInfo.bmiHeader.biWidth := srcWidth;
    BitmapInfo.bmiHeader.biHeight := srcHeight;
    GetMem(srcRGBs, srcWidth * srcHeight * SizeOf(TRGBQuad));
    GdiFlush;
    GetDIBits(DC, srcBMP, 0, srcHeight, srcRGBS, BitmapInfo,
      DIB_RGB_COLORS);
    BitmapInfo.bmiHeader.biWidth := dstWidth;
    BitmapInfo.bmiHeader.biHeight := dstHeight;
    dstBMP := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS,
      Pointer(dstRGBs), 0, 0);
  finally
    DeleteDC(DC);
  end;

  // Rotacionando:
  dstRGB := @dstRGBs[(dstWidth * dstHeight) - 1];
  yPrime := yODst;
  for yDst := dstHeight - 1 downto 0 do
  begin
    yPrimeSinTheta := yPrime * iSinTheta;
    yPrimeCosTheta := yPrime * iCosTheta;
    xPrime := xODst;
    for xDst := dstWidth - 1 downto 0 do
    begin
      xSrc := SmallInt((xPrime * iCosTheta - yPrimeSinTheta)
        shr 16) + xOSrc;
      ySrc := SmallInt((xPrime * iSinTheta + yPrimeCosTheta)
        shr 16) + yOSrc;
      if (DWORD(ySrc) < DWORD(srcHeight)) and
        (DWORD(xSrc) < DWORD(srcWidth)) then
        dstRGB^ := srcRGBs[ySrc * srcWidth + xSrc]
      else
        dstRGB^ := bgRGB;
      Dec(dstRGB);
      Dec(xPrime);
    end;
    Dec(yPrime);
  end;
  FreeMem(srcRGBs);
 
  // Resultado:
  Result := TBitmap.Create;
  Result.Handle := dstBMP;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  lbAuxiliar: TBitmap; // Aqui criamos um TBitmap auxiliar;
  BackColor: TColor;
begin
  if Assigned(Image1.Picture.Bitmap) then
  begin
    // Obtendo a cor de fundo do bitmap:
    BackColor := Image1.Picture.Bitmap.TransparentColor and
      not $02000000;
 
    lbAuxiliar := Rotacionar(Image1.Picture.Bitmap,
      -40, BackColor);
    try
      lbAuxiliar.TransparentColor := BackColor;
      lbAuxiliar.Transparent :=
        Image1.Picture.Bitmap.Transparent;
      Image1.Picture.Bitmap.Assign(lbAuxiliar);
    finally
      lbAuxiliar.Free;
    end;
  end;

end;

end.

abraço

[Visitante]

Como vai Jhonas

muito obrigado o código vou testar ele mais para frente até arrumar o delphi por que tá dando erro no Lazarus no  Rxgif, vou ver se tem alguma livraria equivalente pra ser usado no Lázarus

 

Agradeçido

[Jhonas]

No primeiro link tem o endereço para o programa feito em Lazarus

http://tinyurl.com/LazRotacionaImagem-7z

OBS: Use o 7zip para descompactar o arquivo

abraço

[Visitante]

obrigado Jhonas

 

o que estou precisando é um que gire no próprio eixo sem esticar, em 90 graus ele gira certinho,

ai fui testando ele de grau em grau começando do 1   e vai  esticando o fundo e a imagem vai sumindo da tela, conforme vai clicando no botão,

 a imagem que  preciso colocar é um circulo tipo esse aqui que rode no propio eixo conforme o valor de uma variavel, se for possivel

 

outra vez agradeçido pela ajuda

 

 

 

 

 

 

 

 

[Jhonas]

ok ... outra sugestão mais simples

use o componente Rotate Image

http://www.delphiarea.com/products/delphi-components/rotateimage/

abraço

[Visitante]

esse é bem bacana vai dar certinho,

Jhonas, tudo de bom prá você, obrigado