| Вопрос: PrintScrin | Добавлено: 21.09.04 12:45 |
Автор вопроса:  Nord
|
| Люди может кто знает как сделать принтскрин экрана и занести все точки(координаты и цвет) в массив? |
| Ответы | Всего ответов: 9 |
|
Номер ответа: 1 Автор ответа:  Barsik Разработчик Offline Client ICQ: 343368641 Вопросов: 17 Ответов: 686 |
Web-сайт: Профиль | | #1 | Добавлено: 21.09.04 17:21 |
|
Принтскрин легко...
Public 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 Public Declare Function GetDesktopWindow Lib "user32" () As Long Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Public Sub GetScreen(m_Form As Form) Dim XSrc As Long, YSrc As Long Dim dwRop As Long, hwndSrc As Long, hSrcDC As Long m_Form.ScaleMode = vbPixels m_Form.Move 0, 0, Screen.Width + 1, Screen.Height + 1 dwRop = &HCC0020 hwndSrc = GetDesktopWindow() hSrcDC = GetDC(hwndSrc) Call BitBlt(m_Form.hdc, 0, 0, m_Form.ScaleWidth, m_Form.ScaleHeight, hSrcDC, 0, 0, dwRop) Call ReleaseDC(hwndSrc, hSrcDC) m_Form.Show SavePicture Picture:=m_Form.Image, FileName:="c:\1.bmp" Unload m_Form End Sub Private Sub Form_Load() GetScreen Me End Sub Ну а в массив занести.... это нужно юзать каждую точку...Этож долго... 
А зачем те в массив вносить??? |
||
|
Номер ответа: 2 Автор ответа:  RomaVisICQ: 266287351 Вопросов: 31 Ответов: 147 |
Профиль | | #2 | Добавлено: 21.09.04 18:09 |
|
Наверное для того, чтоб его трояном изображение десктопа жертвы передать по сети  )))
|
||
|
Номер ответа: 3 Автор ответа: RomaVisICQ: 266287351 Вопросов: 31 Ответов: 147 |
Профиль | | #3 | Добавлено: 21.09.04 18:10 |
|
SavePicture Picture:=m_Form.Image, FileName:="c:\1.bmp" Это что такое????? 8-ое чудо света????????? |
||
|
Номер ответа: 4 Автор ответа: CyRax   Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #4 | Добавлено: 21.09.04 18:33 |
|
Хорошо что ты поднял эту тему. Решил я ради интереса покопать свой старый неполучившийся исходник и нашёл закономерность расположения битов в рисунке.
Создай в Paint квадрат 4*4 и закрась любыми цветами. Создай массив меток Label1 (с 0 по 15). Кинь на форму Picture1 и вставь туда созданный в Paint рисунок. Теперь код. Заранее коментарии. Код настроен на ширину и высоту равную 4. По MSDN цвета хранятся в массиве начиная с нижнего левого угла. Код переворачивания я не делал. По этому будет выглядеть так: 4 линия, затем 3,2 и 1-я. Private Const BI_RGB = 0& Private Const DIB_RGB_COLORS = 0 ' color table in RGBs Private Type BITMAPINFOHEADER '40 bytes biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Dim iBitmap As Long, iDC As Long Private Sub Form_Click() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net '-> Compile this code for better performance  im RQ As RGBQUAD
im bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
With bi24BitInfo.bmiHeader .biBitCount = 24 .biCompression = BI_RGB .biPlanes = 1 .biSize = Len(bi24BitInfo.bmiHeader) .biWidth = 4 .biHeight = 4 End With ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * (Len(RQ) - 1)) As Byte iDC = CreateCompatibleDC(0) iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0& 
SelectObject iDC, iBitmap BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS For Cnt2 = LBound(bBytes) To UBound(bBytes) - 2 Step 3 RQ.rgbRed = bBytes(Cnt2 + 2) RQ.rgbGreen = bBytes(Cnt2 + 1) RQ.rgbBlue = bBytes(Cnt2 + 0) Label1(Cnt2 / 3).BackColor = RGB(RQ.rgbRed, RQ.rgbGreen, RQ.rgbBlue) Next Cnt2 eleteDC iDC
eleteObject iBitmap
End Sub Private Sub Form_Load() 'Просто для сравнения. Сделай его покрупнее и Stretch=True Set Image1 = Picture1.Image End Sub |
||
|
Номер ответа: 5 Автор ответа: ISpyРазработчик Offline Client Вопросов: 47 Ответов: 621 |
Web-сайт: Профиль | | #5 | Добавлено: 21.09.04 18:35 |
|
SavePicture Picture:=m_Form.Image, FileName:="c:\1.bmp"
Это что такое????? 8-ое чудо света????????? Похоже pascal или delphi. Сглючило барсика, с кем не бывает
|
||
|
Номер ответа: 6 Автор ответа: DaSharmICQ: 780477 Вопросов: 72 Ответов: 1297 |
Web-сайт: Профиль | | #6 | Добавлено: 21.09.04 19:17 |
|
А можно ваще 2 строчками кода экран сграбить, токо я на 100% не знаю как:
SendKeys "вот тут я не знаю, как нажать на PrintScrin" Picture1.Picture=clipboard.GetData(тип данных) Кому нужно, тот найдет недостающую часть кода
|
||
|
Номер ответа: 7 Автор ответа:  MihalыchICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #7 | Добавлено: 21.09.04 19:35 |
|
DaSharm, ты наверное про это:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Command2_Click() keybd_event &H2C, 0, 0, 0 Picture1.Cls Picture1.Picture = Clipboard.GetData Clipboard.Clear End Sub |
||
|
Номер ответа: 8 Автор ответа: Nord Вопросов: 15 Ответов: 28 |
Профиль | | #8 | Добавлено: 22.09.04 15:50 |
|
Пасибо всем пойду проверять
|
||
|
Номер ответа: 9 Автор ответа: BarsikРазработчик Offline Client ICQ: 343368641 Вопросов: 17 Ответов: 686 |
Web-сайт: Профиль | | #9 | Добавлено: 23.09.04 13:03 |
|
да не сглючил я...
я просто по сайту полазил и нашел код... |
||
Страница: 1 |