Быстое копирование (снимок) рабочего стола

← →
Alekss (2004-05-13 11:46) [0]

Доброго времени суток!!! Мне необходимо получить снимок рабочего стола. Получаю Handle рабочего стола (GetDC). Поясните пожалуйста, почему копирование при помощи BitBlt на объект класса TBitmap происходит гораздо медленее (до 40 раз) чем на объект класса TPaintBox? Можно ли это как-то побороть? Заранее благодарен всем ответившим. Спасибо.

← →
panov © (2004-05-13 12:10) [1]

Разве можно решить на словах всё, без кода?

← →
Alekss (2004-05-13 15:40) [2]

Вот небольшой пример: на форме две кнопки и PaintBox c размерами равными Screen.Width и ScrBitmap.Height соответственно. Разница в копировании около 50 раз. Догадываюсь что дело вероятно в палитре, точнее в преобразовании. Не уверен.
-------------------------------------------------------------
Var HD : HDC;
ScrBitmap : TBitmap;

procedure TForm1.Button1Click(Sender: TObject);
Var int : Integer;
begin
int := GetTickCount;
BitBlt(ScrBitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, HD, 0, 0,SRCCOPY);
Button1.Caption := IntToStr(GetTickCount - Int);
end;

procedure TForm1.Button2Click(Sender: TObject);
Var int : Integer;
begin
int := GetTickCount;
BitBlt(PaintBox1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, HD, 0, 0,SRCCOPY);
Button2.Caption := IntToStr(GetTickCount - Int);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ScrBitmap := TBitmap.Create;
ScrBitmap.Width := Screen.Width;
ScrBitmap.Height := Screen.Height;
HD := GetDC(0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ScrBitmap.Free;
ScrBitmap := nil;
end;
-------------------------------------------------------------

← →
Alekss (2004-05-13 15:42) [3]

Извините, читать: PaintBox c размерами равными Screen.Width и Screen.Height.

← →
Семен Сорокин © (2004-05-13 15:49) [4]

2Alekss
попробуй поиграться с TBitmap.PixelFormat

← →
Alekss (2004-05-13 17:00) [5]

Пробовал, результат практически тот-же.

← →
WebErr © (2004-05-13 18:59) [6]

В общем всё это из-за реализации в TBitmap черепашьей скорости рендеринга, наподобие SetPixel в GDI.
Если кто знает такую GDI функцию StretchDIBits, тот понимает, что быстрее неё работать ничего не может в принципе. :)
Ну всё - я домой! Сорри....

← →
имя (2004-05-14 00:07) [7]

Удалено модератором

← →
Alekss (2004-05-14 11:59) [8]

WebErr
У нее в параметрах необходимо указать address of bitmap bits и address of bitmap data. Как их получить зная только хендел контекста Hd : HDC?
Пробовал сделать через CreateCompatibleBitmap, но работает так-же долго.
procedure TForm1.Button4Click(Sender: TObject);
Var int : Integer;
hbmp: HBITMAP;
hMemDC : HDC;
lpih : TBitmapInfo;
lpDibBits : Pointer;
wWidth : Integer;
wHeight : Integer;
HD : HDC;
begin
hd := GetDC(0);
wWidth := 1024;
wHeight := 768;
hbmp := CreateCompatibleBitmap(hd, wWidth, wHeight);
hMemDC := CreateCompatibleDC(hd);
// SetDIBits(hd, hbmp, 0, wHeight, lpDibBits, lpih, DIB_RGB_COLORS);
hbmp := SelectObject(hMemDC, hbmp);
int := GetTickCount;
BitBlt(hMemDC, 0, 0, wWidth, wHeight,
hd, 0, 0, SRCCOPY);
Button4.Caption := IntToStr(GetTickCount - Int);
// BitBlt(PaintBox1.Canvas.Handle, 0, 0, wWidth, wHeight,
// hMemDC, 0, 0, SRCCOPY);
DeleteObject(SelectObject(hMemDC, hbmp));
DeleteDC(hMemDC);
DeleteDC(HD);
end;

Alekss (14.05.04 11:59) [8]
смотри ф-ии GetDIBColorTable, CreateDIBSection, GetDIBits
посмотри примеры раздела "Bitmap Functions" справки...

Быстое копирование (снимок) рабочего стола Найти похожие ветки