• 0
Sign in to follow this  
acss

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

Question

é 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

Share this post


Link to post
Share on other sites

6 answers to this question

Recommended Posts

  • 0

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

Share this post


Link to post
Share on other sites
  • 0

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

Share this post


Link to post
Share on other sites
  • 0

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

 

 

 

 

 

 

 

 

Sem título 2.jpg

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this