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.