Drejning af Image

Det gør du med et api kald der hedder PlgBlt();

/Martin

Omkring algoritmer og diverse til billedbehandling, så har du kode + teori på denne side

http://www.efg2.com/Lab/ 

prøv den her :

uses
  Windows, Types, Graphics, SysUtils, math;

type
  RealType = Single;
  AngleType = RealType;

  //specify the format we want for Points
  PointType = TPoint;
  CoordType = Integer;
  //a structure to hold sine,cosine,distance (faster than angle)
  SiCoDiType = record
    si, co, di: RealType; {sine, cosine, distance 6/29/98}
  end;


function SiCoDiPoint(const p1, p2: PointType): SiCoDiType; {out}
{
  This is MUCH faster than using angle functions such as arctangent
  11.96    Original SiCoDi for rotations.
  11/22/96 modified for Zero length check, and replace SiCodi
  6/14/98  modified  for Delphi
  6/29/98  renamed from SiCo point
  8/3/98  set Zero angle for Zero length line
  10/24/99 use hypot from math.pas
}
var
  dx, dy: CoordType;
begin
  dx := (p2.x - p1.x);
  dy := (p2.y - p1.y);

  with Result do
  begin
    di := HyPot(dx, dy); //10/24/99 di := Sqrt( dx * dx + dy * dy );
    if abs(di) < 1 then
    begin
      si := 0.0;
      co := 1.0
    end //Zero length line
    else
    begin
      si := dy / di;
      co := dx / di
    end;
  end;
end;

procedure RotateBitmap(
  const BitmapOriginal: TBitMap; //input bitmap (possibly converted)
  out BitMapRotated: TBitMap; //output bitmap
  const theta: AngleType; // rotn angle in radians counterclockwise in windows
  const oldAxis: TPOINT; // center of rotation in pixels, rel to bmp origin
  var newAxis: TPOINT); // center of rotated bitmap, relative to bmp origin
{
Notes...
  Coordinates and rotation are adjusted for \'flipped\' Y axis (+Y is down)
  Bitmap origins are (0,0) in top-left.

  BitMapRotated is enlarged to contain the rotated bitmap
  BitMapOriginal may be changed from 1,2,4 bit to pf8Bit, if needed.

  rotate about center, Oldaxis:=POINT( bmp.width div 2, bmp.height div 2 );
  rotate about origin top-left, Oldaxis:=POINT( 0,0 );
  rotate about bottom-center, Oldaxis:=POINT( bmp.width div 2, bmp.height )

  NewAxis: is the new center of rotation for BitMapRotated;

  Features/ improvements over original EFG RotateBitMap:
  This is generalized procedure; application independent.
  Does NOT clip corners; Enlarges Output bmp if needed.
  Output keeps same transparency and pallette as set by BitMapOriginal.
  Handles all pixel formats, format converted to least one byte per pixel.
  Axis of rotation specified by caller, but new axis will differ from oldaxis.
  Minor Delphi performance optimizations (about 8 instructions per pixel)
  Skips \"null\" angles which have no discernable effect.

  ToDo.. use pointer arithmetic instead of type subscripting for faster pixels.
  Test pfDevice and pfCustom, test palettes. <no data>. }
type // from Delphi
  TRGBTripleArray = array[0..32767] of TRGBTriple; //allow Integer subscript
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBQuadArray = array[0..32767] of TRGBQuad; //allow Integer subscript
  pRGBQuadArray = ^TRGBQuadArray;

var
  cosTheta: Single; {in windows}
  sinTheta: Single;
  i: Integer;
  iOriginal: Integer;
  iRotationAxis: Integer; // Axis of rotation is normally center of image
  iPrime: Integer;
  j: Integer;
  jOriginal: Integer;
  jRotationAxis: Integer;
  jPrime: Integer;
  NewWidth: Integer;
  NewHeight: Integer;
  nBytes, nBits: Integer; //no. bytes per pixelformat
  Oht, Owi, Rht, Rwi: Integer; //Original and Rotated subscripts to bottom/right

  //each of the following points to the same scanlines
  RowRotatedB: pByteArray; //1 byte
  RowRotatedW: pWordArray; //2 bytes
  RowRotatedT: pRGBtripleArray; //3 bytes
  RowRotatedQ: pRGBquadArray; //4 bytes

  //a single pixel for each format
  TransparentB: Byte;
  TransparentW: Word;
  TransparentT: TRGBTriple;
  TransparentQ: TRGBQuad;

  DIB: TDIBSection;
  Center: TPOINT; //the middle of the bmp relative to bmp origin.
  SiCoPhi: SiCoDiType; //sine,cosine, distance
begin
  with BitMapOriginal do
  begin
    //Decipher the appropriate pixelformat to use Delphi byte subscripting 1/6/00
    //pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit,pfCustom;
    case pixelformat of
      pfDevice: //handle only pixelbits= 1..8,16,24,32 //10/31/00
        begin
          nbits := GetDeviceCaps(Canvas.Handle, BITSPIXEL) + 1;
          nbytes := nbits div 8; //no. bytes for bits per pixel

          if (nbytes > 0) and (nbits mod 8 <> 0) then
            exit; //ignore if invalid
        end;

      pf1bit:
        nBytes := 0; // 1bit, TByteArray      //2 color pallete , re-assign byte value to 8 pixels, for entire scan line
      pf4bit:
        nBytes := 0; // 4bit, PByteArray    // 16 color pallette; build nibble for pixel pallette index; convert to 8 pixels
      pf8bit:
        nBytes := 1; // 8bit, PByteArray    // byte pallette, 253 out of 256 colors; depends on display mode, needs truecolor ;
      pf15bit:
        nBytes := 2; // 15bit,PWordArrayType // 0rrrrr ggggg bbbbb  0+5+5+5
      pf16bit:
        nBytes := 2; // 16bit,PWordArrayType // rrrrr gggggg bbbbb  5+6+5
      pf24bit:
        nBytes := 3; // 24bit,pRGBtripleArray// bbbbbbbb gggggggg rrrrrrrr  8+8+8
      pf32bit:
        nBytes := 4; // 32bit,pRGBquadArray  // bbbbbbbb gggggggg rrrrrrrr aaaaaaaa 8+8+8+alpha
      // can assign \'Single\' reals to this for generating displays/plasma!
      pfCustom: //handle only pixelbits= 1..8,16,24,32
        begin
          GetObject(Handle, SizeOf(DIB), @DIB);
          nbits := DIB.dsBmih.biSizeImage;
          nbytes := nbits div 8;

          if (nbytes > 0) and (nbits mod 8 <> 0) then
            exit; //ignore if invalid
        end; // pfcustom
    else
      exit;
    end; // case

    // BitmapRotated.PixelFormat is the same as BitmapOriginal.PixelFormat;
    // IF PixelFormat is less than 8 bit, then BitMapOriginal.PixelFormat = pf8Bit,
    // because Delphi can\'t index to bits, just bytes;
    // The next time BitMapOriginal is used it will already be converted.
    //( bmp storage may increase by factor of n*n, where n=8/(no. bits per pixel)  )
    if nBytes = 0 then
      PixelFormat := pf8bit; //note that input bmp is changed

    //assign copies all properties, including pallette and transparency
    BitmapRotated.Assign(BitMapOriginal);

    //COUNTERCLOCKWISE rotation angle in radians. 12/10/99
    sinTheta := SIN(theta);
    cosTheta := COS(theta);

    //calculate the enclosing rectangle
    NewWidth := ABS(Round(Height * sinTheta)) + ABS(Round(Width * cosTheta));
    NewHeight := ABS(Round(Width * sinTheta)) + ABS(Round(Height * cosTheta));

    //diff size bitmaps have diff resolution of angle, ie r*sin(theta)<1 pixel
    //use the small angle approx: sin(theta) ~~ theta  //11/7/00
    if (ABS(theta) * MAX(width, height)) > 1 then //non-zero rotation
    begin
      //set output bitmap formats; we do not assume a fixed format or size 1/6/00
      BitmapRotated.Width := NewWidth; //resize it for rotation
      BitmapRotated.Height := NewHeight;
      //center of rotation is center of bitmap
      iRotationAxis := width div 2;
      jRotationAxis := height div 2;

      //local constants for loop, each was hit at least width*height times  1/8/00
      Rwi := NewWidth - 1; //right column index
      Rht := NewHeight - 1; //bottom row index
      Owi := Width - 1; //transp color column index
      Oht := Height - 1; //transp color row  index

      //Transparent pixel color used for out of range pixels 1/8/00
      //how to translate a Bitmap.TransparentColor=Canvas.Pixels[0, Height - 1];
      // from Tcolor into pixelformat..
      case nBytes of
        0, 1:
          TransparentB := PByteArray(Scanline[Oht])[0];
        2:
          TransparentW := PWordArray(Scanline[Oht])[0];
        3:
          TransparentT := pRGBtripleArray(Scanline[Oht])[0];
        4:
          TransparentQ := pRGBquadArray(Scanline[Oht])[0];
      end; //case

      // Step through each row of rotated image.
      for j := Rht downto 0 do //1/8/00
      begin //for j
        case nBytes of //1/6/00
          0, 1: RowRotatedB := BitmapRotated.Scanline[j];
          2: RowRotatedW := BitmapRotated.Scanline[j];
          3: RowRotatedT := BitmapRotated.Scanline[j];
          4: RowRotatedQ := BitmapRotated.Scanline[j];
        end; //case

        // offset origin by the growth factor    //12/25/99
        //    jPrime := 2*(j - (NewHeight - Height) div 2 - jRotationAxis) + 1 ;
        jPrime := 2 * j - NewHeight + 1;

        // Step through each column of rotated image
        for i := Rwi downto 0 do //1/8/00
        begin //for i

          // offset origin by the growth factor  //12/25/99
          //iPrime := 2*(i - (NewWidth - Width) div 2 - iRotationAxis ) + 1;
          iPrime := 2 * i - NewWidth + 1;

          // Rotate (iPrime, jPrime) to location of desired pixel    (iPrimeRotated,jPrimeRotated)
          // Transform back to pixel coordinates of image, including translation
          // of origin from axis of rotation to origin of image.
      //iOriginal := ( Round( iPrime*CosTheta - jPrime*sinTheta ) - 1) DIV 2 + iRotationAxis;
      //jOriginal := ( Round( iPrime*sinTheta + jPrime*cosTheta ) - 1) DIV 2 + jRotationAxis;
          iOriginal := (Round(iPrime * CosTheta - jPrime * sinTheta) - 1 + width) div 2;
          jOriginal := (Round(iPrime * sinTheta + jPrime * cosTheta) - 1 + height) div 2;

          // Make sure (iOriginal, jOriginal) is in BitmapOriginal.  If not,
          // assign backgRound color to corner points.
          if (iOriginal >= 0) and (iOriginal <= Owi) and
            (jOriginal >= 0) and (jOriginal <= Oht) {//1/8/00} then
          begin //inside
            // Assign pixel from rotated space to current pixel in BitmapRotated
            //( nearest neighbor interpolation)
            case nBytes of //get pixel bytes according to pixel format  1/6/00
              0, 1: RowRotatedB[i] := pByteArray(scanline[joriginal])[iOriginal];
              2: RowRotatedW[i] := pWordArray(Scanline[jOriginal])[iOriginal];
              3: RowRotatedT[i] := pRGBtripleArray(Scanline[jOriginal])[iOriginal];
              4: RowRotatedQ[i] := pRGBquadArray(Scanline[jOriginal])[iOriginal];
            end; //case
          end //inside
          else
          begin //outside

            //12/10/99 set backgRound corner color to transparent (lower left corner)
            //    RowRotated[i]:=tpixelformat(BitMapOriginal.TRANSPARENTCOLOR) ; wont work
            case nBytes of
              0, 1: RowRotatedB[i] := TransparentB;
              2: RowRotatedW[i] := TransparentW;
              3: RowRotatedT[i] := TransparentT;
              4: RowRotatedQ[i] := TransparentQ;
            end; //case
          end //if inside

        end //for i
      end; //for j
    end; //non-zero rotation

    //offset to the apparent center of rotation  11/12/00 12/25/99
    //rotate/translate the old bitmap origin to the new bitmap origin,FIXED 11/12/00
    sicoPhi := sicodiPoint(POINT(width div 2, height div 2), oldaxis);
    //sine/cosine/dist of axis point from center point
    with sicoPhi do
    begin
      //NewAxis := NewCenter + dist* <sin( theta+phi ),cos( theta+phi )>
      NewAxis.x := newWidth div 2 + Round(di * (CosTheta * co - SinTheta * si));
      NewAxis.y := newHeight div 2 - Round(di * (SinTheta * co + CosTheta * si)); //flip yaxis
    end;

  end; //with

end; {RotateImage}


Jens B

Hej Borrisholt
Kan du ikke lave et Eks. med to knapper der drejer billedet 90 grader, enten den ene eller den anden vej
Hilsen anold

Jeg fandlt lige på noget nemmerer :

Lav dig sådan en unit her :

unit GraphFlip;

interface

uses Windows, Classes, Sysutils, Graphics;

function RotateBitmap270 (const bitmap : TBitmap) : TBitmap;
function RotateBitmap90 (const bitmap : TBitmap) : TBitmap;
function ConvertToGrayscale (const bitmap : TBitmap) : TBitmap;
function ConvertToNegative (const bitmap : TBitmap) : TBitmap;

implementation

function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
begin
  Dec(Alignment);
  Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
  Result := Result div 8;
end;


function RotateBitmap270 (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bpss, bpsr : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create (\'Invalid pixel format\');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Width;
  result.Width := bitmap.Height;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [bitmap.Width - 1];

  bpss := BytesPerScanLine (bitmap.Width, 24, 32);
  bpsr := BytesPerScanLine (result.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bpss * y);

    for x := 0 to bitmap.Width - 1 do
    begin
      pr := PRGBTriple (PChar (pr1) + bpsr * x);
      Inc (pr, y);
      pr^ := ps^;
      Inc (ps)
    end
  end;
  GDIFlush
end;

function RotateBitmap90 (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bpss, bpsr : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create (\'Invalid pixel format\');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Width;
  result.Width := bitmap.Height;

  ps1 := bitmap.ScanLine [bitmap.Height - 1];
  pr1 := result.ScanLine [0];

  bpss := BytesPerScanLine (bitmap.Width, 24, 32);
  bpsr := BytesPerScanLine (result.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) + bpss * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      pr := PRGBTriple (PChar (pr1) - bpsr * x);
      Inc (pr, y);
      pr^ := ps^;
      Inc (ps)
    end
  end;
  GDIFlush
end;


function ConvertToGrayscale (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bps : Integer;
  n : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create (\'Invalid pixel format\');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Height;
  result.Width := bitmap.Width;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [0];

  bps := BytesPerScanLine (bitmap.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bps * y);
    pr := PRGBTriple (PChar (pr1) - bps * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      n := (ps^.rgbtBlue + ps^.rgbtGreen + ps^.rgbtRed) div 3;
      pr^.rgbtBlue := n;
      pr^.rgbtGreen := n;
      pr^.rgbtRed := n;

      Inc (pr);
      Inc (ps)
    end
  end;
  GDIFlush
end;

function ConvertToNegative (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bps : Integer;
begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create (\'Invalid pixel format\');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Height;
  result.Width := bitmap.Width;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [0];

  bps := BytesPerScanLine (bitmap.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bps * y);
    pr := PRGBTriple (PChar (pr1) - bps * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      pr^.rgbtBlue := 255 - ps^.rgbtBlue;
      pr^.rgbtGreen := 255 - ps^.rgbtGreen;
      pr^.rgbtRed := 255 - ps^.rgbtRed;

      Inc (pr);
      Inc (ps)
    end
  end;
  GDIFlush
end;

end.

og så kan du bare gøre sådan her :

uses
  GraphFlip;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign (RotateBitmap90 (Image1.Picture.Bitmap) );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign (RotateBitmap270 (Image1.Picture.Bitmap) );
end;


Jens B

borrisholt>>

Med alt ære og respekt, jeg ved godt du er en af kongerne i denne kategori, men virker dit eks. ikke kun på 24 bit farver.
Min kommer med en fejl

if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create (\'Invalid pixel format\');


anold >> ellers prøv nedenstående

http://www.efg2.com/Lab/ImageProcessing/FlipReverseRotate.ZIP

Stoney

Det er sku da nemere at downloade dette :
http://www.efg2.com/Lab/ImageProcessing/FlipReverseRotate.htm

/Martin

jo jo ... Men så kan man jo bare konvetere sit Bitmap ...

Jens B

glæder mig at se at vi er tilbage ved mit oprindelige forslag :)

Har brugt kode derfra med succes

http://www.efg2.com/Lab/ 

Hej Jens B
Nu har jeg prøvet dit forslag og det virker fint på BMP filer men hvordan kan jeg i programmet konvetere JPG til Bitmap da alle mine billeder er i JPG format

hej anold>>

Hvad du sikkert har regnet ud så kan man ikke dreje et JPEG billede, fordi det ikke er et billede :-), ikke mere end en ZIP fil er.

any way prøv der her :

function JPEG2BMP (const JPEGImage : TJpegIMAGE) : TBitmap;
begin
  Result := TBitmap.Create;
  Result.Assign(JPEGIMage); 
end;


Jens B

Hej Jens B
Mit firmaet kræver det urimlige af mig så jeg er lige nød til at lave noget for dem men jeg prøver dit forslag senere.
Men hvor skal denne funktion sættes ind ??

Hilsen Anold

Hmnnn. ..  har du et JPEG image liggende i et Timage komponent ?

Jens B

Ja det har jeg

prøv det her :

uses
  JPEG, GraphFlip;

procedure TForm1.FormCreate(Sender: TObject);
var
  JPEGImage : TJPEGImage;
begin
  JPEGImage := TJPEGImage.Create;
  JPEGImage.LoadFromFile(\'C:\\FOTO\\05 Maj\\20003005\\P0000008.JPG\');
  Image1.Picture.Bitmap.Assign(JPEGImage);
  JPEGImage.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Image1.Picture.Bitmap := RotateBitmap90 (Image1.Picture.Bitmap);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap := RotateBitmap270 (Image1.Picture.Bitmap);
end;


Jens B

Hej Jens B
nu virker det perfekt!!!
TAK for det

Hej Jens
Jeg har lige et tillægs spg. !! (Typisk mig, det har jeg altid :) )
Når jeg har hentet mit billede ind og drejet det rundt som jeg vil,
så henter jeg det over i en anden Form Og dermed også et andet Image via

' Image.Picture := FrmMain.Image1.Picture; ' så langt så godt

I den Foem har jeg mulighed for at skrive noget tekst på image'et

Når jeg så har skrevet teksten på Image'et så vil jeg gerne gemme det og det gør jeg sådan :

procedure TFrmTekstFront.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
Var
HuskDir,HuskFil : String;
Begin;
SavePictureDialog1.InitialDir := FrmOpsaetning.Edit2.Text;
CanClose := false;
If BilledeChange = 1 Then
  Begin
    if messagedlg('Billedet er ændret, Ønsker du at gemme billedet ?',
      mtConfirmation,[mbyes,mbno],0)= mryes then
      Begin
          BitMap  := TBitmap.Create;
          try
          BitMap.Width  := Image.Width;
          BitMap.Height := Image.Height;
            If (FrmMain.Label3.Caption = 'Front') Or (FrmMain.Label3.Caption = 'Inder') Then
          Begin
            BitMap.Canvas.CopyRect(Rect(0,0,409,409), FrmTekstFront.Canvas,
            Rect(Image.Left+1,Image.Top+1,Image.Left+409,Image.Top+409));
          end;
          If FrmMain.Label3.Caption = 'Bag' Then
          Begin
            BitMap.Canvas.CopyRect(Rect(0,0,520,520), FrmTekstFront.Canvas,
            Rect(Image.Left+1,Image.Top+1,Image.Left+520,Image.Top+520));
          end;
          BitMap.SaveToFile('c:\temp.bmp');
          BitMap.Free;
          Finally
          If SavePictureDialog1.Execute Then
          Begin
            HuskDir := Extractfilepath(SavePictureDialog1.Filename);
            HuskFil := Extractfilename(SavePictureDialog1.Filename);
            RenameFile('C:\temp.bmp','C:\' + HuskFil + '.bmp');
            MoveFiles('C:\' + HuskFil + '.bmp',HuskDir);
            DeleteFile('C:\temp.bmp');
          end;
          If FrmMain.Label3.Caption = 'Front' Then
            FrmMain.Image1.Picture.LoadFromFile(HuskDir + HuskFil + '.bmp');
          If FrmMain.Label3.Caption = 'Inder' Then
            FrmMain.Image2.Picture.LoadFromFile(HuskDir + HuskFil + '.bmp');
          If FrmMain.Label3.Caption = 'Bag' Then
            FrmMain.Image3.Picture.LoadFromFile(HuskDir + HuskFil + '.bmp');
    end;
      end;
  end;
  If Assigned(Image) Then // sletter image
    Begin
    Image.Free;
    Image := Nil;
    end;
  BilledeChange := 0;
  canclose:= true;
end;

Og det virker sådan set også godt nok !!
MEN når jeg så forsøger at rotere mit billede igen så får jeg denne fejl :

if bitmap.PixelFormat <> pf24Bit  then  // pf24Bit
    raise Exception.Create ('Invalid pixel format');

Men hvordan får jeg mit billede lavet om til PF24Bit når jeg gemmer det via min procedure TFrmTekstFront.FormCloseQuery ???