عکس گرفتن

[blackhatgh]

سلام و خسته نباشید
میخواستم بدون استفاده از کامپوننت از صفحه عکس بگیرم ولی باید حجمش خیلی کم باشه هر چی گشتم یا حجمش بالای 5مگابایت بود یا کار نمیکرد یا با کامپوننت کار میکرد من میخوام حد اکثر حجمش 300 کیلو بایت باشه ولی کیفیتشم بد نباشه.ممنون:قلب:

[m.4.r.m]

آبلیمو هم داشته ؟

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 KEYEVENTF_KEYUP = &H2

Function GetScreenBitmap(Optional ActiveWindow As Boolean) As Picture

Dim pic As StdPicture
Set pic = Clipboard.GetData(vbCFBitmap)
' Alt-Print Screen captures the active window only
If ActiveWindow Then
' Press the Alt key
keybd_event vbKeyMenu, 0, 0, 0
End If
' Press the Print Screen key
keybd_event vbKeySnapshot, 0, 0, 0
DoEvents
' Release the Print Screen key
keybd_event vbKeySnapshot, 0, KEYEVENTF_KEYUP, 0
If ActiveWindow Then
' Release the Alt key
keybd_event vbKeyMenu, 0, KEYEVENTF_KEYUP, 0
End If
DoEvents
' return the bitmap now in the clipboard
Set GetScreenBitmap = Clipboard.GetData(vbCFBitmap)
' restore the original contents of the clipboard
Clipboard.SetData pic, vbCFBitmap
End Function

Private Sub Command1_Click()
CmSave.ShowSave
SavePicture GetScreenBitmap(True), CmSave.FileName
End Sub

[setroyd]

اگه میخوای به صورت پشت سر هم عکس بگیری این تابع بهتره در تابعی که دوست خوبمون اقای m.4.r.m گذاشتن صفحه در تعداد بالا شروع به چشمک زدن میکنه به علت printscreen چون اون تابع کلید PrntScrn رو ارسال میکنه البته خیلی از برنامه ها که صفحه رو کپچر میکنن از تابع بالا هم استفاده میکنن و خیلی ها هم نه ولی این تابع رو من بیشتر دوست دارم و سرعتش هم بهتره .

فقط یه پیکچر باکس بنداز رو صفحه .

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

Private Sub Form_Load()
H = GetDesktopWindow()
C = GetDC(H)
Picture1.Visible = False
Picture1.AutoRedraw = True
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
BitBlt Picture1.hdc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, C, 0, 0, SRCCOPY
SavePicture Picture1.Image, "f:\aa.bmp"
End Sub

[SlowCode]

setryod جان اين خط يادت رفت:
Picture1.Visible = True

[setroyd]

setryod جان اين خط يادت رفت:
Picture1.Visible = True

نه دوست عزیز visible باید false باشه که تو فرم دیده نشه اینجوری بهتره زمانی که شما auto redraw رو true میکنی حتی اگه picture box دیده نشه بازم میشه عکسش رو ذخیره کرد . اما اگر visible= true باشه چون پیکچر باکس ابعادش برابر فرم میشه واسه همین وقتی دیده شه برنامه زشت میشه درسته ؟ پس بهتره این کارو نکنید !

[blackhatgh]

ممنون از شما ولی یه مشکلی داشتن اولی که فقط یه تیکه از تصویر رو میگیره یه تیکه کوچیکش دومی هم حجمش 3 مگ میشه عکس حجمش برام خیلی مهم که کم باشه. چطور ما وقتی کلید Print screen رو میزنیم و در Paint سیو میکنم حجمش 300 تا 400 کیلوبایت با کیفیت خوب آیا میشه یه کاری کرد که همونجوری سیو کنه ولی Paint دیگه باز نشه. بازم ممنون.:قلب:

[blackhatgh]

آقا درست شد با همون اولی فقط باید کد کلید Alt رو برمیداشتم تا پنجررو نگیره کل رو بگیره بازم ممنون.

کد کلید Alt

If ActiveWindow Then
' Press the Alt key
keybd_event vbKeyMenu, 0, 0, 0
End If

گفتم برای بقیه دوستان که این مشکلو دارن.