Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

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

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

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

Семен Сорокин (2004-05-14 12:18:00) [1]
Alekss (14.05.04 11:59) [8]
смотри ф-ии GetDIBColorTable, CreateDIBSection, GetDIBits
посмотри примеры раздела "Bitmap Functions" справки...

Alekss (2004-05-14 11:59:00) [2]
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;

(2004-05-14 00:07:00) [3]
Удалено модератором

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

Alekss (2004-05-13 17:00:00) [5]
Пробовал, результат практически тот-же.

Семен Сорокин (2004-05-13 15:49:00) [6]
2Alekss
попробуй поиграться с TBitmap.PixelFormat

Alekss (2004-05-13 15:42:00) [7]
Извините, читать: PaintBox c размерами равными Screen.Width и Screen.Height.

Alekss (2004-05-13 15:40:00) [8]
Вот небольшой пример: на форме две кнопки и 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;
-------------------------------------------------------------

panov (2004-05-13 12:10:00) [9]
Разве можно решить на словах всё, без кода?

Наверх

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