Вопрос: Скриншот экрана (только чтоб не глючило) | Добавлено: 14.11.07 20:23 |
Автор вопроса: ![]() |
Как сделать Скриншот экрана (только чтоб не глючило на 512 озу и фотка чтоб не больше 1 МВ или разришения по меньше или графику хуже) |
Ответы | Всего ответов: 18 |
Номер ответа: 1 Автор ответа: ![]() ![]() Вопросов: 4 Ответов: 11 |
Профиль | Цитата | #1 | Добавлено: 14.11.07 20:25 |
Visual Basic 6 |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 14.11.07 21:04 |
какая связь между RAM и скриншотами? |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 14.11.07 21:58 |
чтоб не больше одного метра пакуй в JPEG ![]() |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() Вопросов: 5 Ответов: 152 |
Профиль | Цитата | #4 | Добавлено: 14.11.07 22:26 |
Cкриншот экрана, формы или контрола
Автор: неизвестен, если знаете напишите ![]() Данный пример покажет, как можно сделать скриншот всего экрана, формы, 2 разных контрола и сохранить их изображения в файл. Расположите на форме 4 элемента CommandButton и элемент DirListBox (или любой другой контрол). Не забудьте проверить, чтобы папка "C:\1\" существовала. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function CloseClipboard Lib "user32" () 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 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 CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Const CCHDEVICENAME = 32 Private Const CCHFORMNAME = 32 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type DEVMODE dmDeviceName As String * CCHDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCHFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Public Sub Capture(control_hWnd As Long, fNAME As String, Optional OnlyToClipBoard As Boolean = False) On Error GoTo ErrorCapture Dim sp As RECT, x As Long If fNAME <> "" Then x = GetWindowRect(control_hWnd, sp) ScrnCap sp.Left, sp.Top, sp.Right, sp.Bottom If OnlyToClipBoard = False Then SavePicture Clipboard.GetData, fNAME End If End If Exit Sub ErrorCapture: MsgBox Err & ":Error in Caputre(). Error Message:" & Err.Description, vbCritical, "Warning" Exit Sub End Sub Private Sub ScrnCap(Lt, Top, Rt, Bot) On Error GoTo ErrorScrnCap Dim rWIDTH As Long, rHEIGHT As Long Dim SourceDC As Long, DestDC As Long, bHANDLE As Long, Wnd As Long Dim dHANDLE As Long, dm As DEVMODE rWIDTH = Rt - Lt rHEIGHT = Bot - Top SourceDC = CreateDC(" ![]() DestDC = CreateCompatibleDC(SourceDC) bHANDLE = CreateCompatibleBitmap(SourceDC, rWIDTH, rHEIGHT) SelectObject DestDC, bHANDLE BitBlt DestDC, 0, 0, rWIDTH, rHEIGHT, SourceDC, Lt, Top, &HCC0020 Wnd = 0 OpenClipboard Wnd EmptyClipboard SetClipboardData 2, bHANDLE CloseClipboard DeleteDC DestDC ReleaseDC dHANDLE, SourceDC Exit Sub ErrorScrnCap: MsgBox Err & ":Error in ScrnCap(). Error Message:" & Err.Description, vbCritical, "Warning" Exit Sub End Sub Public Sub CaptureDesktop() On Error GoTo ErrorCaptureDesktop Dim dhWND As Long, sp As RECT, x As Long dhWND = GetDesktopWindow If dhWND <> 0 Then x = GetWindowRect(dhWND, sp) ScrnCap sp.Left, sp.Top, sp.Right, sp.Bottom End If Exit Sub ErrorCaptureDesktop: MsgBox Err & ":Error in CaptureDesktop. Error Message: " & Err.Description, vbCritical, "Warning" Exit Sub End Sub Private Sub Form_Load() Command1.Caption = "Экран" Command2.Caption = "Форма" Command3.Caption = "Кнопка" Command4.Caption = "Текстовое окно" End Sub Private Sub Command1_Click() On Error Resume Next Call CaptureDesktop SavePicture Clipboard.GetData, "C:\1\desktop.bmp" MsgBox "Картинка экрана сохранена в C:\1\desktop.bmp" End Sub Private Sub Command2_Click() On Error Resume Next Call Capture(Me.hwnd, "C:\1\form.bmp" ![]() MsgBox "Картинка формы сохранена в C:\1\form.bmp" End Sub Private Sub Command3_Click() On Error Resume Next Call Capture(Me.Command1.hwnd, "C:\1\button.bmp" ![]() MsgBox "Картинка кнопки сохранена в C:\1\button.bmp" End Sub Private Sub Command4_Click() On Error Resume Next Call Capture(Me.Dir1.hwnd, "C:\1\drv.bmp" ![]() MsgBox "Картинка DriveListBox сохранена в C:\1\drv.bmp" End Sub Сохраняется в BMP(2,84МБ) осталося тебе только сделать чтобы сжималось в JPEG чтобы уменьшить размер ![]() |
Номер ответа: 5 Автор ответа: ![]() ![]() Вопросов: 4 Ответов: 11 |
Профиль | Цитата | #5 | Добавлено: 14.11.07 22:54 |
я так делал только когда нажимаю фоткать комп на одну или две секунды тормозит.Мне надо чтоб незометно было!!! |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 427682013 Вопросов: 14 Ответов: 464 |
Профиль | Цитата | #6 | Добавлено: 14.11.07 23:08 |
Шпиона пишешь? ![]() |
Номер ответа: 7 Автор ответа: ![]() ![]() Вопросов: 4 Ответов: 11 |
Профиль | Цитата | #7 | Добавлено: 14.11.07 23:11 |
да |
Номер ответа: 8 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #8 | Добавлено: 14.11.07 23:18 |
нафик трои на VB. я писал раньше - говнотема. учи асм, ну или Си накряйняк. VB штука замечательная, но не для таких целей. Чтобы сделать скрин ЛЮБОГО окна надо читать видеопамять. этот способ не фотает LAYERED-окна |
Номер ответа: 9 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 8068014 Вопросов: 18 Ответов: 817 |
Web-сайт: Профиль | Цитата | #9 | Добавлено: 15.11.07 00:33 |
лееред не просто фоткать даже имея доступ к видеопамяти, ибо оверлеи хранятся отдеьлно от памяти экрана. есть один хитрый прием, который требует лишь инжекта длл и нескольких строк на direct x ![]() |
Номер ответа: 10 Автор ответа: ![]() ![]() ![]() ICQ: 387761649 Вопросов: 32 Ответов: 169 |
Web-сайт: Профиль | Цитата | #10 | Добавлено: 15.11.07 08:49 |
Если не хочешь, чтобы тормозил процесс сохранения, для процесса поставь низкий приоритет. |
Номер ответа: 11 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #11 | Добавлено: 15.11.07 08:51 |
да видел я этот прием ![]() Топикстартер, зяйдите на cracklab, там был такой топик. |
Номер ответа: 12 Автор ответа: ![]() ![]() ![]() Вопросов: 5 Ответов: 152 |
Профиль | Цитата | #12 | Добавлено: 15.11.07 16:15 |
Вот еще 2 примера написанные на Visual Basic 6 на тему: Скриншот экрана. Автор которых: Чистяков Максим
http://vbrus.narod.ru/Primers/Graf/123414.zip http://vbrus.narod.ru/Primers/Graf/ScreenShot.zip |
Номер ответа: 13 Автор ответа: ![]() ![]() ![]() Вопросов: 5 Ответов: 152 |
Профиль | Цитата | #13 | Добавлено: 15.11.07 16:46 |
И вот еще: http://vbnet.ru/samples/download.aspx?id=831 |
Номер ответа: 14 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 8068014 Вопросов: 18 Ответов: 817 |
Web-сайт: Профиль | Цитата | #14 | Добавлено: 15.11.07 23:45 |
на кряклабе тему до конца не раскрыли ![]() ![]() |
Номер ответа: 15 Автор ответа: ![]() ![]() ![]() Вопросов: 5 Ответов: 152 |
Профиль | Цитата | #15 | Добавлено: 16.11.07 00:38 |
Короче вот еще один пример который несколько минут назад написал Я![]() Работает он следующим образом, запускаеш прогу, затем жмеш на кнопку СДЕЛАТЬ СКРИН, программа делается невидимой и Программано нажимает на Клавишу Prt Sc которая находится в правом верхнем углу клавиатуры и преднозначана которая специально для снятия скриншотов, сохраняет она изображение в Буфер Обмена. Так вот после того как программа симулирует нажатие этой клавиши, через несколько милисекунд она вытаскивает из буфера обмена Изображение и вводится оно в PictureBox ![]() Запускай ВБ6, на форму кинь 1 PictureBox и 1 кнопку, теперь копируй код: Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Const VK_SNAPSHOT = &H2C Const KEYEVENTF_KEYUP = &H2 Private Sub Command1_Click() Form1.Visible = False Dim PauseTime, Start, Finish, TotalTime PauseTime = 0.0001: Start = Timer Do While Timer < Start + PauseTime: DoEvents: Loop Finish = Timer: TotalTime = Finish - Start keybd_event VK_SNAPSHOT, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 PauseTime = 0.0001: Start = Timer Do While Timer < Start + PauseTime: DoEvents: Loop Finish = Timer: TotalTime = Finish - Start Form1.Visible = True Picture1.Picture = Clipboard.GetData Clipboard.Clear End Sub Private Sub Form_Load() Form1.Caption = "Скриншот экрана - Автор: Stuart" Command1.Height = 315 Command1.Width = 3000 Command1.Caption = "СДЕЛАТЬ СКРИН" Command1.Left = 0 Command1.Top = 0 Picture1.Left = 0 Picture1.Top = 300 End Sub Private Sub Form_Resize() Picture1.Width = Form1.Width Picture1.Height = Form1.Width End Sub |
|