Board index » delphi » BITMAP.SAVETOFILE BUG?

BITMAP.SAVETOFILE BUG?

I'm having a problem saving a bitmap to a file using the TImage component.

The following code captures an area of the screen into an image:

 procedure TScrnFrm.GrabScreen;
[I put the code in the Oncreate procedure of form1}
 var

    DeskTopDC: HDc;
    DeskTopCanvas: TCanvas;
    DeskTopRect: TRect;

    DeskTopDC := GetWindowDC(GetDeskTopWindow);
    DeskTopCanvas := TCanvas.Create;
    DeskTopCanvas.Handle := DeskTopDC;

    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);

    image1.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);

    ReleaseDC(GetDeskTopWindow,DeskTopDC);
    image1.picture.savetofile('c:\1blah.bmp');

end;

THE PROBLEM:

BEFORE you capture the screen into an image, load a picture
into any picture viewer that has 200+ colors.  Then put
the picture viewer in the upper left-hand corner of the screen,
so that part of the picture in the image view will be captured.

Load the result 'c:\1blah.bmp' into an image viewer and tell me
what you see...(that is, what does the image look like?)

On my computer, the 200+ image has been black out.

How do I go about solving this problem?

 

Re:BITMAP.SAVETOFILE BUG?


Carac...@henge.com   <Michael> wrote:

Quote
>I'm having a problem saving a bitmap to a file using the TImage component.
>The following code captures an area of the screen into an image:
> procedure TScrnFrm.GrabScreen;
>[I put the code in the Oncreate procedure of form1}
> var
>    DeskTopDC: HDc;
>    DeskTopCanvas: TCanvas;
>    DeskTopRect: TRect;
>    DeskTopDC := GetWindowDC(GetDeskTopWindow);
>    DeskTopCanvas := TCanvas.Create;
>    DeskTopCanvas.Handle := DeskTopDC;
>    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
>    image1.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
>    ReleaseDC(GetDeskTopWindow,DeskTopDC);
>    image1.picture.savetofile('c:\1blah.bmp');
>end;

<...cut>

Quote
>On my computer, the 200+ image has been black out.

I think CopyRect only copies from canvas to canvas rather than  frame
buffer to canvas. Note that Tcanvas encapsulates a TBitmap rather than
a DC so you can't put the desktop inside a Tcanvas. You may need to
use standard WinAPI to BitBlt from screen to a TBitmap; and then use
BrushCopy to copy from the TBitmap to a Tcanvas.

When calling BitBlt, make sure your form does not overlap the image to
be copied (say, have TScnFrm.WindowState set to wmMinimized).

Re:BITMAP.SAVETOFILE BUG?


Carac...@henge.com   <Michael> wrote:

Quote
>I'm having a problem saving a bitmap to a file using the TImage component.
>The following code captures an area of the screen into an image:
> procedure TScrnFrm.GrabScreen;
>[I put the code in the Oncreate procedure of form1}
> var
>    DeskTopDC: HDc;
>    DeskTopCanvas: TCanvas;
>    DeskTopRect: TRect;
>    DeskTopDC := GetWindowDC(GetDeskTopWindow);
>    DeskTopCanvas := TCanvas.Create;
>    DeskTopCanvas.Handle := DeskTopDC;
>    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
>    image1.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
>    ReleaseDC(GetDeskTopWindow,DeskTopDC);
>    image1.picture.savetofile('c:\1blah.bmp');
>end;
>THE PROBLEM:
>BEFORE you capture the screen into an image, load a picture
>into any picture viewer that has 200+ colors.  Then put
>the picture viewer in the upper left-hand corner of the screen,
>so that part of the picture in the image view will be captured.
>Load the result 'c:\1blah.bmp' into an image viewer and tell me
>what you see...(that is, what does the image look like?)
>On my computer, the 200+ image has been black out.

Please discard my previous posting which is nonsense.

The major problem is that CopyRect fails to create a valid
Palette. I can't find any Delphi methods that helps so I use
the WinAPI as follows:

type  
  LogPal = record
    lpal : TLogPalette;
    dummy:Array[1..255] of TPalet{*word*249}try;   { make up array[0..255]  }
  end;

 procedure TScrnFrm.GrabScreen;
var
  SysPal : LogPal;
begin
 var
    DeskTopDC: HDc;
    DeskTopCanvas: TCanvas;
    DeskTopRect: TRect;
    image1: TImage; { I prefer to create it on the fly }
    hpal: HPalette;
 begin
    DeskTopDC := GetWindowDC(GetDeskTopWindow);
    syspal.lPal.palVersion:=$300;
    syspal.lPal.palNumEntries:=256;   { assumed 256 color. To be more
           general, call GetDeviceCaps(DeskTopDC,BITSPIXEL)}
    GetSystemPalet{*word*249}tries(DeskTopDC,0,256,SysPal.lpal.PalpalEntry);
    hpal:=CreatePalette(Syspal.lpal);   { emulate DeskTop's palette }
    DeskTopCanvas := TCanvas.Create;
    DeskTopCanvas.Handle := DeskTopDC;
    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
    image1:=TImage.create(self);
    with image1 do
    begin
{set image1's size}
        setbounds(0,0,DeskTopRect.Right,DeskTopRect.Bottom);  
        Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
        ReleaseDC(GetDeskTopWindow,DeskTopDC);
        picture.bitmap.palette:=hpal;   { Important! }
        picture.savetofile('c:\1blah.bmp');
        free;
       deleteObject(hpal);
    end;
end;

Regards
Wai Wong

Other Threads