[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 953
  • Last Modified:

Color to grayscale image

Dear Sirs:

How I can change an image (TBitMap or TJPEGImage) to grayscale. There is some functions API that do this.

Best regards.
0
mbrlaser
Asked:
mbrlaser
  • 3
1 Solution
 
DragonSlayerCommented:
something like this?

procedure GrayScale(b: TBitmap);
var
  i, j, Colr : Integer;
  sl : pRGBArray;  // Scanline
begin
  if b.PixelFormat <> pf24bit then begin
    ShowMessage('Not a 24Bit color bitmap!');
    Exit;
  end;
  for j:=0 to b.Height-1 do begin
    sl := b.ScanLine[j];
    for i:=0 to b.Width-1 do begin
      Colr:=HiByte(sl[i].rgbtRed * 77 + sl[i].rgbtGreen * 151 +
sl[i].rgbtBlue * 28);
      sl[i].rgbtRed := Colr;
      sl[i].rgbtGreen := Colr;
      sl[i].rgbtBlue := Colr;
    end;
  end;
end;

alternatively, look at
http://www.efg2.com/Lab/Library/UseNet/2002/0719.txt
http://www.efg2.com/Lab/Library/UseNet/1999/0311a.txt

for 256 colored bitmaps whereby you need to set the palette for it as well.
0
 
DragonSlayerCommented:
here's another one: (excerpt from http://www.advdelphisys.com/graphics/ads_Bitmap.html)

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;
0
 
pcsentinelCommented:
This gives a really good render

procedure MakeGrey(Bmp: TBitmap);
const
      GreyR = 11;
      GreyG = 59;
      GreyB = 30;
var
  lx: integer;
  ly: integer;
  lc: longint;
begin
  if Bmp.Empty then
    Exit;
  for lx := 0 to Bmp.Width do
  begin
    for ly := 0 to Bmp.Height do
    begin
      lc := Bmp.Canvas.Pixels[lx, ly];
      lc := (GetRValue(lc) * GreyR + GetGValue(lc) * GreyG +
            GetBValue(lc) * GreyB) div (GreyR + GreyG + GreyB);
      Bmp.Canvas.Pixels[lx, ly] := RGB(lc, lc, lc);
    end;
  end;
end;

call it with

  MakeGrey(lBmp);

passing in the bitmap you want greyed

regards

0
 
DragonSlayerCommented:
You might want to use scanline instead of pixel (see my code above) because scanline is *much* faster, very noticable if you are working on a large bitmap.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now