Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Screen / 10 сообщений из 10, страница 1 из 1
03.02.2004, 15:19
    #32396828
Я
Я
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Функция, которая реализует эту возможность - GetDesktopWindow. Полный код выглядит так.
Это поместить в область деклараций модуля

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function BitBlt Lib "gdi32" _

(ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _

ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _

ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Const SRCCOPY = &HCC0020

‘Код, копирующий изображение экрана в окно. Размещается в форме. Не забудьте свойство формы AutoRedraw ‘установить в True.

Dim hDesk, hDeskDC

hDesk = GetDesktopWindow()

hDeskDC = GetDC(hDesk) BitBlt Me.hDC, 0, 0, Width, Height, hDeskDC, 0, 0, SRCCOPY

‘Если необходимо изображение поместить в Picture, вместо Me.hDC укажите Picture1.hDC.
А что такое Me.hDC???
...
Рейтинг: 0 / 0
03.02.2004, 15:44
    #32396857
# Darth Vader #
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Молодец Уже на трех форумах с тобой ждем ответа.
...
Рейтинг: 0 / 0
03.02.2004, 16:18
    #32396927
mahoune
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Me.hDC похоже что это хэндлер на окно являющееся приложением!


. http://sql.ru/]mahoune
...
Рейтинг: 0 / 0
03.02.2004, 16:35
    #32396946
Я
Я
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
А проще, как мне изображение экрана перекинуть в Dim b() As Byte
...
Рейтинг: 0 / 0
04.02.2004, 01:41
    #32397327
andreiy
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Из Picture можно так вытащить:

Код: plaintext
1.
2.
3.
4.
5.
Declare Function GetBitmapBits Lib  "gdi32"  (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte
......
......
ReDim PicBits('здесь указать размер буфера') As Byte
GetBitmapBits Picture1.Image, UBound(PicBits), PicBits( 0 )
...
Рейтинг: 0 / 0
04.02.2004, 07:08
    #32397371
Я
Я
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Если я правильно понял то так:


Option Compare Database
Option Explicit
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal XSrc As Long, ByVal YSrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function GetDC _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Const SRCCOPY = &HCC0020

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Sub Command1_Click()
Dim hdc As Long
Dim hwndScreen As Long 'хендл рабочего стола
Dim hScreenDC As Long 'контекст устройства рабочего стола
Dim Res As Long
Dim PicBits() As Byte

ReDim PicBits(1440054) As Byte -а где этот размер взять?
hwndScreen = GetDesktopWindow() ' получаем хендл на рабочий стол
hScreenDC = GetDC(hwndScreen) 'получаем контекст устройства рабочего стола

GetBitmapBits hScreenDC, UBound(PicBits), PicBits(0)
Open "C:\1.bmp" For Binary Access Write As #1
Put #1, , PicBits
Res = ReleaseDC(hwndScreen, hScreenDC) 'освобождаем ресурс
End Sub

Получается пустой файл размером 1440054. Массив содержит одни нули. В чем ошибка?
...
Рейтинг: 0 / 0
04.02.2004, 16:39
    #32398311
andreiy
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Private Declare Function GetDesktopWindow Lib  "user32"  () As Long
Private Declare Function GetDC Lib  "user32"  (ByVal hWnd As Long) As Long
Private Declare Function GetBitmapBits Lib  "gdi32"  (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib  "gdi32"  (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Sub Form_Load()
Dim hDesk, hDeskDC, cb As Long
Dim PicBits() As Byte
Dim hBmp As Long
hDesk = GetDesktopWindow()
hDeskDC = GetDC(hDesk)
hBmp = CreateCompatibleBitmap(hDeskDC,  1024 ,  768 )
ReDim PicBits( 99999999 ) As Byte
cb = GetBitmapBits(hBmp, UBound(PicBits), PicBits( 0 ))
'сейчас в cb количество полученных байт'
End Sub
...
Рейтинг: 0 / 0
04.02.2004, 23:39
    #32398673
andreiy
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
только хендлы надо закрыть....
А как определить размер hBmp пока не знаю....
Кто знает, подскажите, плз..
...
Рейтинг: 0 / 0
05.02.2004, 01:09
    #32398699
guest
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Мне кажется нужно написать эту функцию на любом языке, в котором она уже реализована. Оформить как DLL и вызывать. На VB и WINAPI врядли получится это сделать просто.
Но если надо сделать как-нибудь, то можно через GetPixel, просто и понятно, но очень медленно. С другой стороны, насколько я понимаю, она (функция) часто вызываться не будет.
...
Рейтинг: 0 / 0
05.02.2004, 08:50
    #32398786
Я
Я
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Screen
Вотhttp://am.rusimport.ru/MsAccess/topic.aspx?ID=10/url]

тема закрыта
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Screen / 10 сообщений из 10, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]