| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проблема с скриншотом экрана [Delphi, Windows]

Валера ©   (2008-11-23 07:59:00) 

Как сделать скриншот и сохранить его в PNG а потом сохранить в PStream ?

Особенно интересует сохранение в PNG и сохранение в STREAM.

---

dron9999   (2009-03-02 20:24:00) [1]

var
Ext, Filename : string;
      Png: PPngObject;
      DC: HDC;
      Format: TPixelFormat;
begin
Filename:= '1.png';
//  Form.Visible := FALSE;
 DC := GetDC(0);
 case GetDeviceCaps( DC, BITSPIXEL ) of
 1, 4, 8, 15, 16 : Format := pf16bit;
 else {24, 32:} Format := pf24bit;
 end;
 Bmp.Free;
bmp := NewDIBBitmap( R.Right - R.Left, R.Bottom - R.Top, Format );
 BitBlt( Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, R.Left, R.Top, SRCCOPY );
 ReleaseDC( 0, DC );
//*******************************************************************
Ext := LowerCase( ExtractFileExt( Filename ) );
  if Ext = '.png' then
    begin
      Png := NewPngObject;
       Png.AssignHandle( Bmp.Handle, FALSE, 0 );
       Png.SaveToFile(Filename);
Png.Free;

я так делал !! но тебе нужен uses KOlpng;

---

Валера   (2008-11-23 19:36:00) [2]

Делаю скриншот при помощи функции из KOLMRBAdditions

function FullScreenShot(PixelFormat: TPixelFormat): PBitmap;
var
 DC : HDC;
begin
DC := GetDC (GetDesktopWindow);
try
 Result:= NewDIBBitmap(
 GetDeviceCaps (DC, HORZRES),
 GetDeviceCaps (DC, VERTRES),
 PixelFormat);
 BitBlt(Result.Canvas.Handle,
        0,
        0,
        Result.Width,
        Result.Height,
        DC,
        0,
        0,
        SRCCOPY);
finally
 ReleaseDC (GetDesktopWindow, DC);
end;
end;

Сохраняю так

       PNG:=NewPngObject;
       try
         PNG.AssignHandle(FullScreenShot(pf32bit).Handle,false,0);
         ScreenStream:=NewMemoryStream;
         PNG.SaveToStream(ScreenStream);
         ScreenStream.Position:=0;
         SendCommand(COMMAND_SEND_SIZE_SCREEN,
           [Int2Str(ScreenStream.Size),Parameters[0]],ClientIndex);
       finally
         PNG.Destroy;
       end;

Мне интересно можно ли сделать тоже самое но не создавать NewDIBBitmap

---

Vladimir Kladov   (2008-11-23 09:07:00) [3]

Посмотрите приложение GrabScreen на kolmck.net. Там всё это есть.

---

Валера   (2008-11-23 08:01:00) [4]

Вот похожий код на VCL

function GetDesktopBitmap: HBitmap;
var
 DC, MemDC: HDC;
 Bitmap, OBitmap: HBitmap;
 BitmapWidth, BitmapHeight: integer;
begin
 DC := GetDC(GetDesktopWindow);
 MemDC := CreateCompatibleDC(DC);
 BitmapWidth := GetDeviceCaps(DC, 8);
 BitmapHeight := GetDeviceCaps(DC, 10);
 Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
 OBitmap := SelectObject(MemDC, Bitmap);
 BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
 SelectObject(MemDC, OBitmap);
 DeleteDC(MemDC);
 ReleaseDC(GetDesktopWindow, DC);
 Result := Bitmap;
end;

procedure Capture();
var
PNGObject : TPNGObject;
begin
 PngObject := TPngObject.Create;
 PngObject.AssignHandle(GetDesktopBitmap, False, 0);
 PngObject.CompressionLevel := 9;
 PngObject.SaveToFile('shot.png');
 PngObject.Free;
end;

---

Наверх