unit ads_Bitmap; {ads_Bitmap
Copyright(c)2001 Advanced Delphi Systems (Richard Maley,12613 Maidens Bower Drive, Potomac, MD 20854 USA, phone 301-840-1554, maley@advdelphisys.com, http://www.advdelphisys.com/)

The code herein can be used or modified by anyone. Please retain references to Dick Maley at Advanced Delphi Systems. If you make improvements to the code please send your improvements to maley@advdelphisys.com so that the entire Delphi community can benefit. All comments are welcome.

Routines: BitmapToGrayscale, BitmapInvert, RotateBitmap_ads

}
interface
Uses Windows,Graphics,SysUtils;

Function BitmapToGrayscale(
  Bitmap : TBitmap
  ): Boolean; OverLoad;
Function BitmapToGrayscale(
  BitmapSource: TBitmap;
  BitmapOut   : TBitmap
  ): Boolean; OverLoad;
Function BitmapToGrayscale(
  BitmapSourceFile: String;
  BitmapOutFile   : String
  ): Boolean; OverLoad;
Function BitmapToGrayscale(
  BitmapFile: String
  ): Boolean; OverLoad;

Function BitmapInvert(
  BitmapSource: TBitmap;
  BitmapOut   : TBitmap
  ): Boolean; OverLoad;

Function BitmapInvert(
  Bitmap      : TBitmap
  ): Boolean; OverLoad;

Function BitmapInvert(
  BitmapSourceFile: String;
  BitmapOutFile   : String
  ): Boolean; OverLoad;

Function BitmapInvert(
  BitmapFile: String
  ): Boolean; OverLoad;

(* RotateBitmap_ads
Example:
procedure TForm1.Button1Click(Sender: TObject);
Var
  Center : TPoint;
  Bitmap : TBitmap;
begin
  Bitmap := TBitmap.Create;
  Try
    Center.y := (Image.Height  div 2)+20;
    Center.x := (Image.Width div 2)+0;
    RotateBitmap_ads(
      Image.Picture.Bitmap,  //SourceBitmap : TBitmap;
      Bitmap              ,  //DestBitmap   : TBitmap;
      Center              ,  //Center       : TPoint;
      Angle               );//Angle        : Extended): TBitmap;
    Angle := Angle + 15;
    Image2.Picture.Bitmap.Assign(Bitmap);
  Finally
    Bitmap.Free;
  End;
end;
*)
Procedure RotateBitmap_ads(
  SourceBitmap       : TBitmap;
  out DestBitmap     : TBitmap;
  Center             : TPoint;
  Angle              : Double);

implementation
Uses JPEG;

Const PixelMax = 32768;
Type
  pPixelArray  =  ^TPixelArray;
  TPixelArray  =  Array[0..PixelMax-1] Of TRGBTriple;

Procedure RotateBitmap_ads(
  SourceBitmap   : TBitmap;
  out DestBitmap : TBitmap;
  Center         : TPoint;
  Angle          : Double);
Var
  cosRadians          : Double;
  inX                 : Integer;
  inXOriginal         : Integer;
  inXPrime            : Integer;
  inXPrimeRotated     : Integer;
  inY                 : Integer;
  inYOriginal         : Integer;
  inYPrime            : Integer;
  inYPrimeRotated     : Integer;
  OriginalRow         : pPixelArray;
  Radians             : Double;
  RotatedRow          : pPixelArray;
  sinRadians          : Double;
begin
  DestBitmap.Width    := SourceBitmap.Width;
  DestBitmap.Height   := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians             := -(Angle) * PI / 180;
  sinRadians          := Sin(Radians);
  cosRadians          := Cos(Radians);
  For inX             := DestBitmap.Height-1 Downto 0 Do
  Begin
    RotatedRow        := DestBitmap.Scanline[inX];
    inXPrime          := 2*(inX - Center.y) + 1;
    For inY           := DestBitmap.Width-1 Downto 0 Do
    Begin
      inYPrime        := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal     := (inYPrimeRotated - 1) Div 2 + Center.x;
      inXOriginal     := (inXPrimeRotated - 1) Div 2 + Center.y;
      If
        (inYOriginal  >= 0)                    And
        (inYOriginal  <= SourceBitmap.Width-1) And
        (inXOriginal  >= 0)                    And
        (inXOriginal  <= SourceBitmap.Height-1)
      Then
      Begin
        OriginalRow   := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY]  := OriginalRow[inYOriginal]
      End
      Else
      Begin
        RotatedRow[inY].rgbtBlue  := 255;
        RotatedRow[inY].rgbtGreen := 0;
        RotatedRow[inY].rgbtRed   := 0
      End;
    End;
  End;
End;

Function BitmapInvert(
  BitmapSource: TBitmap;
  BitmapOut   : TBitmap
  ): Boolean;
var
  BytesPorScan: integer;
  inWidth     : integer;
  inHeight    : integer;
  p           : pByteArray;
  Bitmap      : TBitmap;
Begin
  Result := False;
  If not (BitmapSource.PixelFormat in [pf15Bit,  pf24Bit,  pf32Bit]) Then Exit;
  Bitmap := TBitmap.Create();
  Try
    Bitmap.Assign(BitmapSource);
    Try
      BytesPorScan :=
        Abs(Integer(Bitmap.ScanLine[1])-Integer(Bitmap.ScanLine[0]));
    Except
      Result := False;
      Exit;
    End;
    For inHeight := 0 To Bitmap.Height - 1 Do
    Begin
      P := Bitmap.ScanLine[InHeight];
      For inWidth := 0 To BytesPorScan - 1 Do
      Begin
        P^[inWidth] := 255-P^[inWidth];
      End;
    End;
    BitmapOut.Assign(Bitmap);
    Result := True;
  Finally
    Bitmap.Free;
  End;
end;

Function BitmapInvert(
  BitmapSourceFile: String;
  BitmapOutFile   : String
  ): Boolean; OverLoad;
Var
  BitmapSource: TBitmap;
  BitmapOut   : TBitmap;
Begin
  Result := False;
  Try
    If Not FileExists(BitmapSourceFile) Then Exit;
    BitmapSource:= TBitmap.Create();
    BitmapOut   := TBitmap.Create();
    Try
      BitmapSource.LoadFromFile(BitmapSourceFile);
      Result :=
        BitmapInvert(
          BitmapSource,  //BitmapSource: TBitmap;
          BitmapOut     //BitmapOut   : TBitmap
                      );//): Boolean;
      If Result Then
      Begin
        If FileExists(BitmapOutFile) Then DeleteFile(BitmapOutFile);
        BitmapOut.SaveToFile(BitmapOutFile);
      End;
    Finally
      BitmapSource.Free;
      BitmapOut   .Free;
    End;
  Except
    Result := False;
  End;
End;

Function BitmapInvert(
  BitmapFile: String
  ): Boolean; OverLoad;
Begin
  Result :=
    BitmapInvert(
      BitmapFile,  //BitmapSourceFile: String;
      BitmapFile  //BitmapOutFile   : String;
                );//): Boolean; OverLoad;
End;

Function BitmapInvert(
  Bitmap      : TBitmap
  ): Boolean; OverLoad;
Begin
  Result :=
    BitmapInvert(
      Bitmap,  //BitmapSource: TBitmap;
      Bitmap  //BitmapOut   : TBitmap
            );//): Boolean;
End;

Function BitmapToGrayscale(
  Bitmap : TBitmap
  ): Boolean;
Var
  Jpeg    : TJPEGImage;
Begin
  Result := False;
  If Bitmap = nil Then Exit;
  Try
    Jpeg    := TJPEGImage.Create();
    Try
      Jpeg.Assign(Bitmap);
      Jpeg.CompressionQuality := 100;
      Jpeg.Compress;
      Jpeg.Grayscale := True;
      Bitmap.Canvas.Draw(0,  0,  Jpeg);
      Result := True;
    Finally
      Jpeg.Free;
    End;
  Except
    Result := False;
  End;
End;

Function BitmapToGrayscale(
  BitmapSource: TBitmap;
  BitmapOut   : TBitmap
  ): Boolean; OverLoad;
Var
  Bitmap : TBitmap;
Begin
  Bitmap := TBitmap.Create();
  Try
    Result := BitmapToGrayscale(Bitmap);
    If Result Then BitmapOut.Assign(Bitmap);
  Finally
    Bitmap.Free;
  End;
End;

Function BitmapToGrayscale(
  BitmapSourceFile: String;
  BitmapOutFile   : String
  ): Boolean; OverLoad;
Var
  Bitmap      : TBitmap;
Begin
  Result      := False;
  Try
    If Not FileExists(BitmapSourceFile) Then Exit;
    Bitmap    := TBitmap.Create();
    Try
      Bitmap.LoadFromFile(BitmapSourceFile);
      Result := BitmapToGrayscale(Bitmap);
      If Result Then
      Begin
        If FileExists(BitmapOutFile) Then DeleteFile(BitmapOutFile);
        Bitmap.SaveToFile(BitmapOutFile);
      End;
    Finally
      Bitmap.Free;
    End;
  Except
    Result := False;
  End;
End;

Function BitmapToGrayscale(
  BitmapFile: String
  ): Boolean; OverLoad;
Begin
  Result :=
    BitmapToGrayscale(
      BitmapFile,  //BitmapSourceFile: String;
      BitmapFile  //BitmapOutFile   : String
                );//): Boolean; OverLoad;
End;

end.
                                                                                                          //