RotateUnit.pas
上传用户:dgeyuang
上传日期:2007-01-11
资源大小:65k
文件大小:3k
源码类别:

传真(Fax)编程

开发平台:

Delphi

  1. unit RotateUnit;
  2. interface
  3. uses
  4.   Windows, SysUtils, Classes, Graphics, ExtCtrls;
  5. type
  6.   TRotationType = (ra90, ra180, ra90rev, raFlipVert, raFlipHorz);
  7.   TRotBitmap = class(TBitmap)
  8.   public
  9.     procedure Rotate(aRotAngle: TRotationType);
  10.   end;
  11.   TRotImage = class(TImage)
  12.   public
  13.     procedure RotateBitmap(aRotAngle: TRotationType);
  14.   end;
  15. implementation
  16. procedure TRotBitmap.Rotate(aRotAngle: TRotationType);
  17. type TBMInfo = record
  18.        bmType,
  19.        bmWidth,
  20.        bmHeight,
  21.        bmWidthBytes: longint;
  22.        bmPlanes,
  23.        bmBitsPixel: word;
  24.      end;
  25. var xmul, nWidth,
  26.     x, y, n: smallint;
  27.     bmInfo: TBMInfo;
  28.     bmData: array of byte;
  29.     bmNewData: array of byte;
  30. begin
  31.   GetObject(Handle, SizeOf(bmInfo), @bmInfo);
  32.   setLength(bmData, bmInfo.bmWidthBytes*bmInfo.bmHeight);
  33.   setLength(bmNewData, bmInfo.bmWidthBytes*bmInfo.bmHeight);
  34.   GetBitmapBits(Handle, bmInfo.bmWidthBytes*bmInfo.bmHeight, bmData);
  35.   if aRotAngle in [ra90, ra90rev]
  36.     then begin
  37.       Height := bmInfo.bmWidth;
  38.       Width := bmInfo.bmHeight;
  39.     end;
  40.   nWidth:=Width;
  41.   if frac(bmInfo.bmBitsPixel/8)>0 then raise Exception.Create('Unsupported pixel format!');
  42.   xmul:=bmInfo.bmBitsPixel div 8;
  43.   with bmInfo do
  44.     case aRotAngle of
  45.       ra90   : for y:=0 to bmHeight-1 do
  46.                  for x:=0 to bmWidth-1 do
  47.                    for n:=0 to xmul-1 do
  48.                      bmNewData[x*(nWidth*xmul) + bmHeight*xmul-(y+1)*xmul+n]:=
  49.                      bmData[y*bmWidthBytes + x*xmul+n];
  50.       ra90rev : for y:=0 to bmHeight-1 do
  51.                   for x:=0 to bmWidth-1 do
  52.                     for n:=0 to xmul-1 do
  53.                       bmNewData[(bmWidth-1-x)*(nWidth*xmul) + y*xmul+n]:=
  54.                       bmData[y*bmWidthBytes + x*xmul+n];
  55.       ra180   : for y:=0 to bmHeight-1 do
  56.                   for x:=0 to bmWidth-1 do
  57.                     for n:=0 to xmul-1 do
  58.                       bmNewData[(bmHeight-1-y)*(nWidth*xmul) + bmWidthBytes-(x+1)*xmul+n]:=
  59.                       bmData[y*bmWidthBytes+x*xmul+n];
  60.       raFlipVert : for y:=0 to bmHeight-1 do
  61.                      System.Move(bmData[y*bmWidthBytes],
  62.                                  bmNewData[(bmHeight-1-y)*(nWidth*xmul)], bmWidthBytes);
  63.       raFlipHorz : for y:=0 to bmHeight-1 do
  64.                      for x:=0 to bmWidth-1 do
  65.                        for n:=0 to xmul-1 do
  66.                          bmNewData[y*(nWidth*xmul)+bmWidthBytes-(x+1)*xmul+n]:=
  67.                          bmData[y*bmWidthBytes+x*xmul+n];
  68.     end;
  69.   for y:=0 to Height-1 do
  70.     System.Move(bmNewData[y*(nWidth*xmul)], ScanLine[y]^, nWidth*xmul);
  71.   setLength(bmData, 0);
  72.   setLength(bmNewData, 0);
  73. end;
  74. procedure TRotImage.RotateBitmap(aRotAngle: TRotationType);
  75. var bm: TRotBitmap;
  76. begin
  77.   if Picture.Bitmap.Empty
  78.     then raise Exception.Create('Bitmap is empty!');
  79.   bm:=TRotBitmap.Create;
  80.   bm.Assign(Picture.Bitmap);
  81.   bm.Rotate(aRotAngle);
  82.   Picture.Bitmap.Assign(bm);
  83.   bm.Free;
  84. end;
  85. end.