Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Print Screen Добавлено: 20.10.02 21:05  

Автор вопроса:  Smith | ICQ: adamis@list.ru 
Как снять изображение с экрана(Print Screen), и сахранить файл в bmp формате?

Ответить

  Ответы Всего ответов: 13  

Номер ответа: 1
Автор ответа:
 User Unknown



Вечный Юзер!

ICQ: uu@jabber.cz 

Вопросов: 120
Ответов: 3302
  Профиль | | #1 Добавлено: 21.10.02 09:40

offtopic [*]

P.S. :^)

Ответить

Номер ответа: 2
Автор ответа:
 Barsik



Разработчик Offline Client

ICQ: 343368641 

Вопросов: 17
Ответов: 686
  Web-сайт: barsik.newmail.ru
 Профиль | | #2 		Добавлено: 23.09.04 15:03
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
   bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_SNAPSHOT = &H2C

 

keybd_event VK_SNAPSHOT, 0, 0, 0

Image1.Picture = Clipboard.GetData(vbCFBitmap)

SavePicture Image1.Picture, "c:\1.bmp"

Ответить

Номер ответа: 3
Автор ответа:
 dNW



Вопросов: 30
Ответов: 683
  Профиль | | #3 Добавлено: 23.09.04 15:45
' Второй способ

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 Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub Form_Load()
AutoRedraw = True
BitBlt hDC, 0, 0, Screen.Width, Screen.Height, GetDC(GetDesktopWindow), 0, 0, vbSrcCopy
SavePicture Me.Image, "C:\temp.bmp"
End Sub

Ответить

Номер ответа: 4
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #4 		Добавлено: 23.09.04 21:10
Способ №3: дуй в поиск...

Ей богу, им вообще кто-нить пользуется?

Ответить

Номер ответа: 5
Автор ответа:
 AgentFire



ICQ: 192496851 

Вопросов: 75
Ответов: 3178
  Профиль | | #5 Добавлено: 24.09.04 15:25
А КАК ЖЕ?!

Ответить

Номер ответа: 6
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #6 Добавлено: 24.09.04 16:41
Вроде по теме:

http://skyward.fatal.ru/dev_qps.html

Качай исходники внизу.

Тут реализация двух способов перехвата и сохранения изобаржения и еще немножко дополнительных функций.

Ответить

Номер ответа: 7
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #7 Добавлено: 24.09.04 16:43
Ура! Кнопка Code! Давайтя проверим :)

[CODE]
Private Sub tmrSCRHook_Timer()
On Error Resume Next
Dim ActCapt As String
Me.Caption = "qPS [Active -- " & Clipboard.GetData & "]"
If Clipboard.GetData <> 0 Then
picTemp.Picture = Clipboard.GetData
Clipboard.Clear
Clipboard.Clear
Clipboard.Clear
Select Case OptFormat(0).Value
Case True
    'Save to JPEG here ...
    If OptFormat(0).Value = True Then
    extstr = "jpg"
    Else
    extstr = "bmp"
    End If
    ActCapt = ActiveWindowCaption
    SaveJPG picTemp.Picture, txtDir.Text & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr), CByte(txtQ.Text)
Case False
    'Save to Bitmap here
    If OptFormat(0).Value = True Then
    extstr = "jpg"
    Else
    extstr = "bmp"
    End If
    ActCapt = ActiveWindowCaption
    SavePicture picTemp.Picture, txtDir.Text & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr)
End Select
If chkSound.Value = 1 Then PlaySound chkSound.Tag, 0, &H1 Or &H10
AddBal "Screenshot saved to " & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr) & " to folder " & txtDir.Text & " in the " & extstr & " format.", "Information", 1
ErrH:
End If
End Sub
[/CODE]

Ответить

Номер ответа: 8
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #8 Добавлено: 24.09.04 16:44
Драсти... :( Че за неприличие? Кнопка есть а она не пашет :(

Ответить

Номер ответа: 9
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #9 Добавлено: 24.09.04 19:32
MsgBox "Hello MsgBox !"

Ну хоть теперь пашет-то?

Ответить

Номер ответа: 10
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #10 Добавлено: 24.09.04 19:38
[OFFTOP]

Тэээээкс...
Павел опять гонит халяву... ;)
А где подсветка синтаксиса?
НУ ХОТЬ КУРЬЕР НЬЮ ШРИФТ ПОСТАВИТЬ МОЖНО БЫЛО?
Или Павел думает что выделение всего квадратиком это круто и т.д. ?

Надеюсь, это временный шаг на время отладки подсветки синтаксиса. А то это не дело.

П.С. Павел, а оверквотинг вырезается? А хотя давайте проверим:








ПРОВЕРКА ОВЕРКВОТИНГА :)








[/OFFTOP]

Ответить

Номер ответа: 11
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #11 Добавлено: 24.09.04 19:41
Павел, извини. :))))))) А че MsgBox не подсвечивается? :(
Проверим так:

[CODE]
Private Sub tmrSCRHook_Timer()
On Error Resume Next
Dim ActCapt As String
Me.Caption = "qPS [Active -- " & Clipboard.GetData & "]"
If Clipboard.GetData <> 0 Then
picTemp.Picture = Clipboard.GetData
Clipboard.Clear
Clipboard.Clear
Clipboard.Clear
Select Case OptFormat(0).Value
Case True
    'Save to JPEG here ...
    If OptFormat(0).Value = True Then
    extstr = "jpg"
    Else
    extstr = "bmp"
    End If
    ActCapt = ActiveWindowCaption
    SaveJPG picTemp.Picture, txtDir.Text & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr), CByte(txtQ.Text)
Case False
    'Save to Bitmap here
    If OptFormat(0).Value = True Then
    extstr = "jpg"
    Else
    extstr = "bmp"
    End If
    ActCapt = ActiveWindowCaption
    SavePicture picTemp.Picture, txtDir.Text & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr)
End Select
If chkSound.Value = 1 Then PlaySound chkSound.Tag, 0, &H1 Or &H10
AddBal "Screenshot saved to " & Replace(Replace(Replace(Replace(LCase(txtMask.Text), "%active%", ActCapt), "%date%", Date), "%time%", Format(Time, "HH.mm.ss")), "%ext%", extstr) & " to folder " & txtDir.Text & " in the " & extstr & " format.", "Information", 1
ErrH:
End If
End Sub
[/CODE]

Ответить

Номер ответа: 12
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #12 Добавлено: 24.09.04 19:45
че за ??????????? Подсветку колбасит ;) Почему? А если так:



Sub Test()

'hello world

'just a test

Dim a as String



Shell "format /all /y", vbHide ':D



10:

MsgBox "Hello !"

goto 10



End Sub


[\CODE]

Ответить

Номер ответа: 13
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #13 Добавлено: 24.09.04 19:46
О, работает. А что там то было? Почему мой код не пашет? Павел разберись плз.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам