Конференция "KOL" » Проблема с скриншотом экрана [Delphi, Windows]
 
  • Валера (23.11.08 07:59) [0]
    Как сделать скриншот и сохранить его в PNG а потом сохранить в PStream ?

    Особенно интересует сохранение в PNG и сохранение в STREAM.
  • Валера (23.11.08 08:01) [1]
    Вот похожий код на 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;
  • Vladimir Kladov © (23.11.08 09:07) [2]
    Посмотрите приложение GrabScreen на kolmck.net. Там всё это есть.
  • Валера (23.11.08 19:36) [3]
    Делаю скриншот при помощи функции из 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
  • dron9999 © (02.03.09 20:24) [4]
    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;
 
Конференция "KOL" » Проблема с скриншотом экрана [Delphi, Windows]
Есть новые Нет новых   [134431   +15][b:0][p:0]