| Вопрос: Блин, тупой ворпрос... | Добавлено: 07.05.07 22:37 |
Автор вопроса:  Black Berill
|
|
Вот такой код:
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 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Type POINTAPI x As Long y As Long End Type Const SRCCOPY = &HCC0020 Dim Papi As POINTAPI Private Sub Timer1_Timer() GetCursorPos Papi BitBlt GetDC(picMonitor.hwnd), 0, 0, picMonitor.ScaleWidth, picMonitor.ScaleHeight, GetDC(GetDesktopWindow), (Papi.x - (picMonitor.ScaleWidth / 2)), (Papi.y - (picMonitor.ScaleHeight / 2)), SRCCOPY End Sub Все работает, но когда пытаюсь сохранить картинку в файл: Private Sub picMonitor_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then SavePicture picMonitor.Image, App.Path & "\Screen.bmp" End If End Sub сохраняеться просто желтый квадрат :( ИМХО, дело в последнем параметре BitBlt. Блин, ну сохранить картинку? |
| Ответы | Всего ответов: 11 |
|
Номер ответа: 1 Автор ответа:  Black Berill Вопросов: 17 Ответов: 151 |
Профиль | | #1 | Добавлено: 07.05.07 22:46 |
Очепятка, всмысле, КАК её сохранить
|
||
|
Номер ответа: 2 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #2 | Добавлено: 07.05.07 23:14 |
Вопрос на засыпку: что нарисовано на картинке? 
|
||
|
Номер ответа: 3 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #3 | Добавлено: 08.05.07 00:06 |
|
Помоему SavePicture надо передавать не Image, а Picture
А ка нарисуешь что-нибудь (или BitBlt), то делай Set picMonitor.Picture = picMonitor.Image
|
||
|
Номер ответа: 4 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #4 | Добавлено: 08.05.07 00:08 |
|
2 Александр, как что нарисовано? GetDC(GetDesktopWindow). Рабочий стол вестимо
2 Ber, SRCCOPY в ApiViewer объявлена точно также как и у тебя, т.ч. с ней все в порядке |
||
|
Номер ответа: 5 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #5 | Добавлено: 08.05.07 00:24 |
|
Я извеняюсь, мимо просто проходил, у тебя случайно picMonitor.BorderStyle не желтый? Так тогда сам понимаешь? А вообще сохранить Desktop
но уменьшив размеры в разы проще через StretchBlt (Papi.x - (picMonitor.ScaleWidth / 2)), (Papi.y - (picMonitor.ScaleHeight / 2)), SRCCOPY
Это строчка для чего?
|
||
|
Номер ответа: 6 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #6 | Добавлено: 08.05.07 11:02 |
|
Держи Адольф.
Option Explicit
Private Declare Function StretchBlt Lib "gdi32" _  ByVal hdc 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 hSrcWidth As Long, ByVal nSrcHeight As Long, _ ByVal dwRop As Long) As Long ' ************************** Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Type POINTAPI X As Long Y As Long End Type Const SRCCOPY = &HCC0020 Dim Papi As POINTAPI Private Sub Form_Load() picMonitor.AutoRedraw = True picMonitor.ScaleMode = 3 End Sub Private Sub Timer1_Timer() GetCursorPos Papi StretchBlt picMonitor.hdc, 0, 0, picMonitor.Width, picMonitor.Height, GetDC(GetDesktopWindow), Papi.X, Papi.Y, picMonitor.Width, picMonitor.Height, SRCCOPY picMonitor.Refresh End Sub Private Sub picMonitor_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 32 Then SavePicture picMonitor.Image, App.Path & "\Screen.bmp" End If End Su Остальное сам допишеш. |
||
|
Номер ответа: 7 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #7 | Добавлено: 08.05.07 11:06 |
|
Если заменить строчку на эту
StretchBlt picMonitor.hdc, 0, 0, picMonitor.Width * 2, picMonitor.Height * 2, GetDC(GetDesktopWindow), Papi.X, Papi.Y, picMonitor.Width, picMonitor.Height, SRCCOPY
То получишь 2_Х кратную лупу и сохранишь так же. |
||
|
Номер ответа: 8 Автор ответа: Black BerillВопросов: 17 Ответов: 151 |
Профиль | | #8 | Добавлено: 08.05.07 12:40 |
|
Zag-Zag,спасибо!
Боцман,спасибо,хотел лупу сбацать, не знал как
Да,эта сторочка: (Papi.x - (picMonitor.ScaleWidth / 2)), (Papi.y - (picMonitor.ScaleHeight / 2)), нужна, чтобы курсор указывал в центр "фотографируемого" квадрата.
А ведь все дело в этом идиотизме: GetDC(picMonitor.hwnd)
вместо picMonitor.hDC
Абидна
|
||
|
Номер ответа: 9 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #9 | Добавлено: 08.05.07 12:46 |
|
Хочешь центра вот почти кино с центром на курсоре. Private Sub Timer1_Timer()
GetCursorPos Papi StretchBlt picMonitor.hdc, 0, 0, picMonitor.Width * 2, picMonitor.Height * 2, GetDC(GetDesktopWindow), Papi.X - (picMonitor.Width / 4) / 15, Papi.Y - (picMonitor.Height / 4) / 15, picMonitor.Width, picMonitor.Height, SRCCOPY picMonitor.Refresh SavePicture picMonitor.Image, App.Path & "\Skr-" & № & ".bmp" 'снимаем кино № = № + 1 If № = 100 Then Timer1.Enabled = False End Sub |
||
|
Номер ответа: 10 Автор ответа: Black BerillВопросов: 17 Ответов: 151 |
Профиль | | #10 | Добавлено: 08.05.07 13:05 |
|
Гы-ы-ы, еще б в AVIшку это все засунуть
|
||
|
Номер ответа: 11 Автор ответа: VβÐUηìtВопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | | #11 | Добавлено: 09.05.07 15:28 |
|
Гы-ы-ы, еще б в AVIшку это все засунуть
Это было бы очень хорошо. А то нигде не могу найти подобный исходник |
||
Страница: 1 |