imgutil.pas

超级报表系统软件VclSkin.v2.60.4.29.完整源代码版.rar

{$R-}  // Turn off Range Checking because of ARRAY[0..0] construct below

unit ImgUtil;

// The new algorithms are 5 to 8 imes faster (dirty but fast) and they
// not need so many memory (if the bitmap very large you have a problem ->
// windows must use the swapfile).
{$WARNINGS OFF}
{$HINTS OFF}

interface

uses   Windows, Graphics;

  procedure SpiegelnHorizontal  (Bitmap:TBitmap);
  procedure SpiegelnVertikal    (Bitmap:TBitmap);
  procedure Drehen90Grad        (Bitmap:TBitmap);
  procedure Drehen270Grad       (Bitmap:TBitmap);
  procedure Drehen180Grad       (Bitmap:TBitmap);
  FUNCTION Rotate90(Bitmap:TBitmap):  TBitmap;

implementation

USES dialogs,
     Classes,    // Rect
     SysUtils;


TYPE
  EBitmapError = CLASS(Exception);
  TRGBArray    = ARRAY[0..0] OF TRGBTriple;
  pRGBArray    = ^TRGBArray;


procedure SpiegelnHorizontal(Bitmap:TBitmap);
var i,j,w :  INTEGER;
    RowIn :  pRGBArray;
    RowOut:  pRGBArray;

begin
    w := bitmap.width*sizeof(TRGBTriple);
    Getmem(rowin,w);
    for j := 0 to Bitmap.Height-1 do begin
      move(Bitmap.Scanline[j]^,rowin^,w);
      rowout := Bitmap.Scanline[j];
      for i := 0 to Bitmap.Width-1 do rowout[i] := rowin[Bitmap.Width-1-i];
    end;
    bitmap.Assign(bitmap);
    Freemem(rowin);
end;


procedure SpiegelnVertikal(Bitmap : TBitmap);
var j,w :  INTEGER;
    help  :  TBitmap;

begin
    help := TBitmap.Create;
    help.Width       := Bitmap.Width;
    help.Height      := Bitmap.Height;
    help.PixelFormat := Bitmap.PixelFormat;
    w := Bitmap.Width*sizeof(TRGBTriple);
    for j := 0 to Bitmap.Height-1 do move(Bitmap.Scanline[j]^,Help.Scanline[Bitmap.Height - 1 - j]^,w);
    Bitmap.Assign(help);
    help.free;
end;


type THelpRGB = packed record
                   rgb    : TRGBTriple;
                   dummy  : byte;
                end;

procedure Drehen270Grad(Bitmap:TBitmap);
var aStream : TMemorystream;
    header  : TBITMAPINFO;
    dc      : hDC;
    P       : ^THelpRGB;
    x,y,b,h : Integer;
    RowOut:  pRGBArray;

BEGIN
   aStream := TMemoryStream.Create;
   aStream.SetSize(Bitmap.Height*Bitmap.Width * 4);
   with header.bmiHeader do begin
     biSize := SizeOf(TBITMAPINFOHEADER);
     biWidth := Bitmap.Width;
     biHeight := Bitmap.Height;
     biPlanes := 1;
     biBitCount := 32;
     biCompression := 0;
     biSizeimage := aStream.Size;
     biXPelsPerMeter :=1;
     biYPelsPerMeter :=1;
     biClrUsed :=0;
     biClrImportant :=0;
   end;
   dc := GetDC(0);
   P  := aStream.Memory;
   GetDIBits(dc,Bitmap.Handle,0,Bitmap.Height,P,header,dib_RGB_Colors);
   ReleaseDC(0,dc);
   b := bitmap.Height;  // rotate
   h := bitmap.Width;   // rotate
   bitmap.Width := b;
   bitmap.height := h;
   for y := 0 to (h-1) do begin
     rowOut := Bitmap.ScanLine[(h-1)-y];
     P  := aStream.Memory;        // reset pointer
     inc(p,y);
     for x := (b-1) downto 0 do begin
        rowout[x] := p^.rgb;
        inc(p,h);
     end;
   end;
   aStream.Free;
end;


procedure Drehen90Grad(Bitmap:TBitmap);
var aStream : TMemorystream;
    header  : TBITMAPINFO;
    dc      : hDC;
    P       : ^THelpRGB;
    x,y,b,h : Integer;
    RowOut:  pRGBArray;

BEGIN
   aStream := TMemoryStream.Create;
   aStream.SetSize(Bitmap.Height*Bitmap.Width * 4);
   with header.bmiHeader do begin
     biSize := SizeOf(TBITMAPINFOHEADER);
     biWidth := Bitmap.Width;
     biHeight := Bitmap.Height;
     biPlanes := 1;
     biBitCount := 32;
     biCompression := 0;
     biSizeimage := aStream.Size;
     biXPelsPerMeter :=1;
     biYPelsPerMeter :=1;
     biClrUsed :=0;
     biClrImportant :=0;
   end;
   dc := GetDC(0);
   P  := aStream.Memory;
   GetDIBits(dc,Bitmap.Handle,0,Bitmap.Height,P,header,dib_RGB_Colors);
   ReleaseDC(0,dc);
   b := bitmap.Height;  // rotate
   h := bitmap.Width;   // rotate
   bitmap.Width := b;
   bitmap.height := h;
   for y := 0 to (h-1) do begin
     rowOut := Bitmap.ScanLine[y];
     P  := aStream.Memory;        // reset pointer
     inc(p,y);
     for x := 0 to (b-1) do begin
        rowout[x] := p^.rgb;
        inc(p,h);
     end;
   end;
   aStream.Free;
end;


procedure Drehen180Grad(Bitmap:TBitmap);
var i,j     :  INTEGER;
    rowIn :  pRGBArray;
    rowOut:  pRGBArray;
    help  : TBitmap;

begin
   help := TBitmap.Create;
   help.Width  := Bitmap.Width;
   help.Height := Bitmap.Height;
   help.PixelFormat := Bitmap.PixelFormat;    // only pf24bit for now
   FOR  j := 0 TO Bitmap.Height - 1 DO BEGIN
     rowIn  := Bitmap.ScanLine[j];
     rowOut := help.ScanLine[Bitmap.Height - j - 1];
     FOR i := 0 TO Bitmap.Width - 1 DO rowOut[Bitmap.Width - i - 1] := rowIn[i]
   END;
   bitmap.assign(help);
   help.free;
end;


FUNCTION Rotate90(Bitmap:TBitmap):  TBitmap;
VAR i,j     :  INTEGER;
        rowIn :  pRGBArray;
BEGIN
   IF   Bitmap.PixelFormat <> pf24bit then
     exit;

   RESULT := TBitmap.Create;
   RESULT.Width  := Bitmap.Height;
   RESULT.Height := Bitmap.Width;
   RESULT.PixelFormat := Bitmap.PixelFormat;    // only pf24bit for now

   // Out[j, Right - i - 1] = In[i, j]
   FOR  j := 0 TO Bitmap.Height - 1 DO  BEGIN
      rowIn  := Bitmap.ScanLine[j];
      FOR i := 0 TO Bitmap.Width - 1 DO
          pRGBArray(RESULT.ScanLine[Bitmap.Width - i - 1])[j] := rowIn[i]
   END;
END;

end.