We help IT Professionals succeed at work.

Image compression

Medium Priority
374 Views
Last Modified: 2013-11-19
Hi, I am writing a progam which can send and recieve screenshots of remote computers aroung a LAN using the fastnet streaming components.  On the client machine I generate the screenshot, half the scale of the original, using the following code.  However this creates a badly degraded image.  Would compressing it as a JPEG help things?  If so how would I implement this?  also, how could I reduce it to 256 colours to reduce the size when sending over a network?

Thankyou

Andrew

procedure TForm1.Button1Click(Sender: TObject);
var
ScreenCanvas:TCanvas;
ScreenRect, DestRect:TRect;
ScreenShot:TBitmap;
begin
ScreenShot:= TBitmap.Create;  //Create the bitmap that the screenshot will be stored in
Screenshot.Width := Screen.width;  //Set the size of the image to that of the screen
Screenshot.height:= Screen.height;
ScreenCanvas:=TCanvas.create;  //Create a canvas
ScreenCanvas.handle:=GetDC(0); //Assign the same handle as the screen
ScreenRect := Rect(0,0,Screen.Width,Screen.height);   //Draw two identical canvas to copy the screen-shot between
DestRect   := Rect(0,0,Screen.Width,Screen.height);
ScreenShot.Canvas.CopyRect(DestRect,ScreenCanvas,ScreenRect); //Copy the screen into the Bitmap

form1.width:=640;
form1.height:=480;
Image1.Picture.bitmap:=screenshot;

end;
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2004
Commented:
well just transform your bitmap to a jpeg

you can easily assign your bitmap to the just created tjpegimage-object
like

  jpg := tjpegimage.create;
  jpg.assign(bitmap)

meikl ;-)
CERTIFIED EXPERT
Top Expert 2004

Commented:
just to say that the assign method compresses the bitmap to the jpg-object default values, you could adjust it before assigning to compress more
Mohammed NasmanSoftware Developer
CERTIFIED EXPERT

Commented:
Hello
 
  If you want to reduce the bmp size by change the color depth, use the PixelFormat property of TBitmap
 pf8bit = for 256 colors
 pf24bit = for 24 bit colors (16 milion)

but it's better to convert the bmp jpg it will give you small file size with 24 colors, and you can change the Compression ratio using CompressionQuality property

here's a sample, button one will convert the bmp image to 256 color, button 2 will convert it to jpg image

I test it with 1.2 bmp image
button1 gave me 256 color bmp file with size 430 kb
button 2 gave me 16 milion colors but jpg file with 120 kb


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile('c:\bmp.bmp');
  Bmp.PixelFormat := pf8bit;
  bmp.SaveToFile('c:\256bmp.bmp');
  Bmp.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Jpg : TJpegImage;
  Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile('c:\bmp.bmp');
  Jpg := TjpegImage.Create;
  Jpg.Assign(Bmp);
  Jpg.CompressionQuality := 75; // from 1..100
  Jpg.Compress;
  Jpg.SaveToFile('c:\jpg.jpg');
  Bmp.free;
  Jpg.Free;
end;

end.
Igor UL7AAjrSenior developer

Commented:
Hi andrewsmith.
meikl hi.

Andrew, if you'd like to scale screen before do something with it then you can use this function:

function ScaledScreen(ScaleFactor: Real): TBitmap;
var
  DC: HDC;
begin
  Result := TBitMap.Create;
  Result.Width := Round(Screen.Width * ScaleFactor);
  Result.Height := Round(Screen.Height * ScaleFactor);
  Result.PixelFormat := pf24Bit;

  DC := GetDC(0);
  StretchBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height,
    DC, 0, 0, Screen.Width, Screen.Height, SRCCOPY);
  DeleteObject(DC);
end;

---------
Igor
CERTIFIED EXPERT
Top Expert 2004

Commented:
hi igor :-)
Mohammed NasmanSoftware Developer
CERTIFIED EXPERT

Commented:
Just want to add

 The jpg CompressionQuality start from 1 to 100

 the higer value bette image quality with big file size and the small value small size but will reduce the image quality, so you need  to adjuct it as your needed

Igor UL7AAjrSenior developer

Commented:
btw, I have no any mail notification from ee today. Something wrong there?

Commented:
Actually, I wouldn't choose jpeg compression for screen shots.  As one would prob. be getting shots that were mostly windows, menues, etc. you'd be getting lots of straight lines & solid colours.  Images with these characteristics don't generally compress well with jpeg  - too many artifacts.  Also, in such circumstances, other, lossless, compression algo's may perform very well. The following (simple, but messy :) example takes a screen shot, forces it to 24bit, compresses it with zlib (free, dist'ed with delphi) & displays the source & destination sizes in the form's caption.  My first run came up with a source size of 1,406.25kb compressed to 31.708kb:

procedure TForm1.FormCreate(Sender: TObject);
var
   dc : HDC;
   bmp : TBitmap;
   zip : TCompressionStream;
   tmp,dst : TMemoryStream;
begin
     bmp := TBitmap.create;
     bmp.width := screen.width;bmp.height := screen.height;
     bmp.PixelFormat := pf24bit;
     dc := getDC(getDeskTopWindow);
     bitblt(
            bmp.canvas.Handle,
            0,0,bmp.width,bmp.height,
            dc,
            0,0,
            SRCCOPY);
     releaseDC(getDesktopWindow,dc);
     tmp := TMemoryStream.create;
     dst := TMemoryStream.create;
     zip := TCompressionStream.create(clDefault,dst);
     bmp.SaveToStream(tmp);
     zip.copyFrom(tmp,0);
     zip.free;
     caption := floatToStr(3*bmp.width*bmp.height/1024)+' -> '+floatToStr(dst.size/1024);
     tmp.free;
     dst.free;
     bmp.free;
end;



GL
Mike

Commented:
edey,
"...with zlib (free, dist'ed with delphi)"

is there documentation available for zlib?
I can include it, but nothing to find in help files...
Also, have only .dcu and no .lib so can't look up myself.

regards,
Oli

Commented:
AFAIK there's no documentation for zlib, but you do prob. have zlib.pas - it's just not installed by default. You should be able to find it in the extras folder on your delphi cd.

GL
Mike

Commented:
thanx, I'll take a look

regards,
Oli

Commented:
Listening...
Administration will be contacting you shortly.

Question(s) below appears to have been abandoned. Your options are:
 
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you. You must tell the participants why you wish to do this, and allow for Expert response.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question. Again, please comment to advise the other participants why you wish to do this.

For special handling needs, please post a zero point question in the link below and include the question QID/link(s) that it regards.
http://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
Please click the Help Desk link on the left for Member Guidelines, Member Agreement and the Question/Answer process.  http://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Please click you Member Profile to view your question history and keep them all current with updates as the collaboration effort continues, to track all your open and locked questions at this site.  If you are an EE Pro user, use the Power Search option to find them.

To view your open questions, please click the following link(s) and keep them all current with updates.
http://www.experts-exchange.com/questions/Q.20163146.html
http://www.experts-exchange.com/questions/Q.20184793.html
http://www.experts-exchange.com/questions/Q.20272260.html


To view your locked questions, please click the following link(s) and evaluate the proposed answer.
http://www.experts-exchange.com/questions/Q.20265319.html

PLEASE DO NOT AWARD THE POINTS TO ME.  
 
------------>  EXPERTS:  Please leave any comments regarding your closing recommendations if this item remains inactive another seven (7) days.  Also, if you are interested in the cleanup effort, please click this link http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20274643
 
Thank you everyone.
 
Moondancer
Moderator @ Experts Exchange

P.S.  For any year 2000 questions, special attention is needed to ensure the first correct response is awarded, since they are not in the comment date order, but rather in Member ID order.
Admin notified of User neglect. Force-accepted by
Netminder
CS Moderator

Explore More ContentExplore courses, solutions, and other research materials related to this topic.