www.pudn.com > FaxConvert.zip > RotateUnit.pas

 
unit RotateUnit; 
 
interface 
 
uses 
  Windows, SysUtils, Classes, Graphics, ExtCtrls; 
 
type 
  TRotationType = (ra90, ra180, ra90rev, raFlipVert, raFlipHorz); 
 
  TRotBitmap = class(TBitmap) 
  public 
    procedure Rotate(aRotAngle: TRotationType); 
  end; 
 
  TRotImage = class(TImage) 
  public 
    procedure RotateBitmap(aRotAngle: TRotationType); 
  end; 
 
 
implementation 
 
procedure TRotBitmap.Rotate(aRotAngle: TRotationType); 
type TBMInfo = record 
       bmType, 
       bmWidth, 
       bmHeight, 
       bmWidthBytes: longint; 
       bmPlanes, 
       bmBitsPixel: word; 
     end; 
var xmul, nWidth, 
    x, y, n: smallint; 
    bmInfo: TBMInfo; 
    bmData: array of byte; 
    bmNewData: array of byte; 
begin 
  GetObject(Handle, SizeOf(bmInfo), @bmInfo); 
  setLength(bmData, bmInfo.bmWidthBytes*bmInfo.bmHeight); 
  setLength(bmNewData, bmInfo.bmWidthBytes*bmInfo.bmHeight); 
  GetBitmapBits(Handle, bmInfo.bmWidthBytes*bmInfo.bmHeight, bmData); 
  if aRotAngle in [ra90, ra90rev] 
    then begin 
      Height := bmInfo.bmWidth; 
      Width := bmInfo.bmHeight; 
    end; 
  nWidth:=Width; 
  if frac(bmInfo.bmBitsPixel/8)>0 then raise Exception.Create('Unsupported pixel format!'); 
  xmul:=bmInfo.bmBitsPixel div 8; 
  with bmInfo do 
    case aRotAngle of 
      ra90   : for y:=0 to bmHeight-1 do 
                 for x:=0 to bmWidth-1 do 
                   for n:=0 to xmul-1 do 
                     bmNewData[x*(nWidth*xmul) + bmHeight*xmul-(y+1)*xmul+n]:= 
                     bmData[y*bmWidthBytes + x*xmul+n]; 
      ra90rev : for y:=0 to bmHeight-1 do 
                  for x:=0 to bmWidth-1 do 
                    for n:=0 to xmul-1 do 
                      bmNewData[(bmWidth-1-x)*(nWidth*xmul) + y*xmul+n]:= 
                      bmData[y*bmWidthBytes + x*xmul+n]; 
      ra180   : for y:=0 to bmHeight-1 do 
                  for x:=0 to bmWidth-1 do 
                    for n:=0 to xmul-1 do 
                      bmNewData[(bmHeight-1-y)*(nWidth*xmul) + bmWidthBytes-(x+1)*xmul+n]:= 
                      bmData[y*bmWidthBytes+x*xmul+n]; 
      raFlipVert : for y:=0 to bmHeight-1 do 
                     System.Move(bmData[y*bmWidthBytes], 
                                 bmNewData[(bmHeight-1-y)*(nWidth*xmul)], bmWidthBytes); 
      raFlipHorz : for y:=0 to bmHeight-1 do 
                     for x:=0 to bmWidth-1 do 
                       for n:=0 to xmul-1 do 
                         bmNewData[y*(nWidth*xmul)+bmWidthBytes-(x+1)*xmul+n]:= 
                         bmData[y*bmWidthBytes+x*xmul+n]; 
    end; 
  for y:=0 to Height-1 do 
    System.Move(bmNewData[y*(nWidth*xmul)], ScanLine[y]^, nWidth*xmul); 
  setLength(bmData, 0); 
  setLength(bmNewData, 0); 
end; 
 
procedure TRotImage.RotateBitmap(aRotAngle: TRotationType); 
var bm: TRotBitmap; 
begin 
  if Picture.Bitmap.Empty 
    then raise Exception.Create('Bitmap is empty!'); 
  bm:=TRotBitmap.Create; 
  bm.Assign(Picture.Bitmap); 
  bm.Rotate(aRotAngle); 
  Picture.Bitmap.Assign(bm); 
  bm.Free; 
end; 
 
end.