تحويل الصورة ل ابيض واسود - نسخة قابلة للطباعة

تحويل الصورة ل ابيض واسود - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : تحويل الصورة ل ابيض واسود (/showthread.php?tid=5461)

تحويل الصورة ل ابيض واسود - sa7er100 - 13-08-2013

السلام عليكم

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

وشكرا

تحويل الصورة ل ابيض واسود - SMP3 - 13-08-2013

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

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; 

تحويل الصورة ل ابيض واسود - sa7er100 - 14-08-2013

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

جربته 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 مع بقاء الجودة جيدة
**** ان كون وضحت الفكرة

تحويل الصورة ل ابيض واسود - SMP3 - 14-08-2013

حجم الصورة لا يتغير بتحويلها الى أبيض و أسود !!
السبب : عدد البيكسل يبقى ثابت .. ستتغير قيمة البيكسل فقط لكن عدد البيكسل قبل التحويل = عدد البيكسل بعد التحويل => حجم ثابت .
يمكن تحويل ال 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; 

تحويل الصورة ل ابيض واسود - sa7er100 - 14-08-2013

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

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