delphi4arab منتديات دلفي للعرب

السلام عليكم

طريقة لتحويل الصورة ل ابيض واسود مع البقاء جودة الصورة

وشكرا

و عليكم السلام
هذه دالة بسيطة تقوم بتحويل الصورة للأبيض و الاسود .

PHP كود :
TYPE
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. 100000 - 1] OF TRGBQuad;

procedure GrayBitmap(var Bmp: TBitmap);
var
  J, i: integer;
  pData: PRGBQuadArray;
  vGrayValue: Byte;
begin
  for J := 0 to Bmp.Height - 1 do
    begin
      pData := Bmp.ScanLine[J];
      for i := 0 to Bmp.Width - 1 do
        begin
          vGrayValue := Round(0.3 * pData[i].rgbRed + 0.59 * pData[i].rgbGreen +
            0.11 * pData[i].rgbBlue);
          pData[i].rgbRed := vGrayValue;
          pData[i].rgbGreen := vGrayValue;
          pData[i].rgbBlue := vGrayValue;

        end;
    end;
end; 

شكرا لك اخي بارك الله فيك

جربته xe2 لم يحدث اي شئ

استخدمت هذا

كود :
procedure ImageGrayScale(var AnImage: TImage);
var
  JPGImage: TJPEGImage;
  BMPImage: TBitmap;
  MemStream: TMemoryStream;
begin
  BMPImage := TBitmap.Create;
  try
    BMPImage.Width  := AnImage.Picture.Bitmap.Width;
    BMPImage.Height := AnImage.Picture.Bitmap.Height;

    JPGImage := TJPEGImage.Create;
    try
      JPGImage.Assign(AnImage.Picture.Bitmap);
      JPGImage.CompressionQuality := 100;
      JPGImage.Compress;
      JPGImage.Grayscale := True;

      BMPImage.Canvas.Draw(0, 0, JPGImage);

      MemStream := TMemoryStream.Create;
      try
        BMPImage.SaveToStream(MemStream);
        //you need to reset the position of the MemoryStream to 0
        MemStream.Position := 0;

        AnImage.Picture.Graphic.LoadFromStream(MemStream);
        AnImage.Refresh;
      finally
        MemStream.Free;
      end;
    finally
      JPGImage.Free;
    end;
  finally
    BMPImage.Free;
  end;
end;

وهو يعمل

لكن الحجم حجم الصورة بقي نفسه

ما ابحث عنه هو عند عمل برنت سكرين لسطح المكتب وجودة الصورة متوسطة يكون حجم الصورة 300 كيلو

وارسالها باستمرار يؤثر ويعمل ثقل على الاتصال

الفكرة هي تقليل حجم الصورة بتحويلها ل ابيض واسود بعد تحويلها ل jpg مع بقاء الجودة جيدة
**** ان كون وضحت الفكرة

حجم الصورة لا يتغير بتحويلها الى أبيض و أسود !!
السبب : عدد البيكسل يبقى ثابت .. ستتغير قيمة البيكسل فقط لكن عدد البيكسل قبل التحويل = عدد البيكسل بعد التحويل => حجم ثابت .
يمكن تحويل ال Bmp الى صورة jpg ثم الى bmp مرة أخرى :
ستحصل على حجم صغير مقارنة بالصورة الأولى بدون تحويلها للأسود و الأبيض .

PHP كود :
procedure ImageGrayScale(var AnImage: TImage);
var
  JPGImage: TJPEGImage;
  BMPImage: TBitmap;
  MemStream: TMemoryStream;
begin
  BMPImage := TBitmap.Create;

  BMPImage.Width := AnImage.Picture.Bitmap.Width;
  BMPImage.Height := AnImage.Picture.Bitmap.Height;

  JPGImage := TJPEGImage.Create;
  //Size (AnImage.Picture.Bitmap ) = 60 ko
  JPGImage.Assign(AnImage.Picture.Bitmap);
  JPGImage.CompressionQuality := 100;
  JPGImage.Compress;
//  JPGImage.Grayscale := True;
  BMPImage.Assign(JPGImage);

  // BMPImage.Canvas.Draw(0, 0, JPGImage);

  { dont use Canvas.Draw
    Use BMPImage.Assign
  }
  BMPImage.SaveToFile('foo.bmp'); //Size = 24 ko !!

  AnImage.Picture.Graphic := BMPImage;
  JPGImage.Free;
  BMPImage.Free;
end; 

شكرا جزيلا اخي على ردك

التحويل ل JPG يخفض الحجم الى الربع على عكس ال bmp النصف

sa7er100

SMP3

sa7er100

SMP3

sa7er100