ReSQL.ru
     
powered by simpleCommunicator - 2.0.60     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Screen
10 сообщений из 10, страница 1 из 1
Screen
    #32396828
Я
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Я
Гость
Функция, которая реализует эту возможность - 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:19
| Ответить | Цитировать | Написать  
Screen
    #32396857
Фотография # Darth Vader #
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
# Darth Vader #
Участник
Молодец Уже на трех форумах с тобой ждем ответа.
...
Рейтинг: 0 / 0
03.02.2004, 15:44
| Ответить | Цитировать | Написать  
Screen
    #32396927
Фотография mahoune
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
mahoune
Участник
Me.hDC похоже что это хэндлер на окно являющееся приложением!


. http://sql.ru/]mahoune
...
Рейтинг: 0 / 0
03.02.2004, 16:18
| Ответить | Цитировать | Написать  
Screen
    #32396946
Я
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Я
Гость
А проще, как мне изображение экрана перекинуть в Dim b() As Byte
...
Рейтинг: 0 / 0
03.02.2004, 16:35
| Ответить | Цитировать | Написать  
Screen
    #32397327
andreiy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
andreiy
Гость
Из 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, 01:41
| Ответить | Цитировать | Написать  
Screen
    #32397371
Я
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Я
Гость
Если я правильно понял то так:


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, 07:08
| Ответить | Цитировать | Написать  
Screen
    #32398311
andreiy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
andreiy
Гость
Код: 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, 16:39
| Ответить | Цитировать | Написать  
Screen
    #32398673
andreiy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
andreiy
Гость
только хендлы надо закрыть....
А как определить размер hBmp пока не знаю....
Кто знает, подскажите, плз..
...
Рейтинг: 0 / 0
04.02.2004, 23:39
| Ответить | Цитировать | Написать  
Screen
    #32398699
guest
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
guest
Участник
Мне кажется нужно написать эту функцию на любом языке, в котором она уже реализована. Оформить как DLL и вызывать. На VB и WINAPI врядли получится это сделать просто.
Но если надо сделать как-нибудь, то можно через GetPixel, просто и понятно, но очень медленно. С другой стороны, насколько я понимаю, она (функция) часто вызываться не будет.
...
Рейтинг: 0 / 0
05.02.2004, 01:09
| Ответить | Цитировать | Написать  
Screen
    #32398786
Я
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Я
Гость
Вотhttp://am.rusimport.ru/MsAccess/topic.aspx?ID=10/url]

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


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