Скачать: CL | DM;

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

← →
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;

---

← →
Семен Сорокин ©   (2004-05-14 12:18) [9]

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

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.47 MB
Время: 0.025 c