طباعة شاشة سطح المكتب

السلام عليكم ورحمة الله وبركاته

هل تريد طباعة شاشة سطح المكتب بما عليه من ايكونات؟

هناك داله من دوال API وهى

Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long

ولكنها تقوم باخذ صوره من خلفية سطح المكتب

تقوم هذه الدالة بأخذ صورة من سطح المكتب وهذه الدالة لها وسيط واحد وهو المكان( هذا المكان لابد ان يكون له خاصية hdc ) الذي تريد وضع الصورة فيه مثلا picturebox او على الفورم نفسه picture1.hdc , me.hdc

تحياتى ;) ;) :rolleyes:

اشكرك اخي على الرد الرائع ..

اخي انا ليس لدي خبرة كبيرة بدوال الايه بي اي .. ممكن توضح لي بنفس الدالة السابقة بمثال مرفق

وشكرا

رمضان كريم ... وكل علم وانتم بخير

الكود هو

Const RC_PALETTE As Long = &H100

Const SIZEPALETTE As Long = 104

Const RASTERCAPS As Long = 38

Private Type PALETTEENTRY

peRed As Byte

peGreen As Byte

peBlue As Byte

peFlags As Byte

End Type

Private Type LOGPALETTE

palVersion As Integer

palNumEntries As Integer

palPalEntry(255) As PALETTEENTRY

End Type

Private Type GUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(7) As Byte

End Type

Private Type PicBmp

Size As Long

Type As Long

hBmp As Long

hPal As Long

Reserved As Long

End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long

Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long

Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long

Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long

Private Declare Function RealizePalette 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture

Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID

With IID_IDispatch

.Data1 = &H20400

.Data4(0) = &HC0

.Data4(7) = &H46

End With

With Pic

.Size = Len(Pic)

.Type = vbPicTypeBitmap

.hBmp = hBmp

.hPal = hPal

End With

R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

Set CreateBitmapPicture = IPic

End Function

Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture

Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long

Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long

Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE

hDCMemory = CreateCompatibleDC(hDCSrc)

hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)

hBmpPrev = SelectObject(hDCMemory, hBmp)

RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)

HasPaletteScrn = RasterCapsScrn And RC_PALETTE

PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then

LogPal.palVersion = &H300

LogPal.palNumEntries = 256

R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))

hPal = CreatePalette(LogPal)

hPalPrev = SelectPalette(hDCMemory, hPal, 0)

R = RealizePalette(hDCMemory)

End If

R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)

hBmp = SelectObject(hDCMemory, hBmpPrev)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then

hPal = SelectPalette(hDCMemory, hPalPrev, 0)

End If

R = DeleteDC(hDCMemory)

Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)

End Function

'امر الالتقاط

Private Sub Form_Load()

Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)

End Sub

Mody_Alb :D :D

السلام عليكم ورحمة الله وبركاته

اخى MODY_ALB

يجب وضع الكود بين علامتي الشفره حتى يظهر الكود مفسر بهذه الصوره

Const RC_PALETTE As Long = &H100
Const SIZEPALETTE As Long = 104
Const RASTERCAPS As Long = 38
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As PALETTEENTRY
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
End With
R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
Set CreateBitmapPicture = IPic
End Function
Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long
Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE
hDCMemory = CreateCompatibleDC(hDCSrc)
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
HasPaletteScrn = RasterCapsScrn And RC_PALETTE
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
R = RealizePalette(hDCMemory)
End If
R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
hBmp = SelectObject(hDCMemory, hBmpPrev)
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
R = DeleteDC(hDCMemory)

Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
End Function
'امر الالتقاط
Private Sub Form_Load()
Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
End Sub

;) ;) :rolleyes:

شكرا لكم اخواني ....

اخواني بالنسبة للكود الذي تم ارفاقه طويل جدا ولم افهمه حتى اين اضعه ممكن التسهيل ولكم العون

بالنسبة لاخي شريف عادل لقد طلبت ايميلي فهو ما يلي :

computer_xpp@hotmail.com

اخى العزيز العالم...

هذا هو المثال ...

وبالنسبه للكود السابق فهو يقوم بعمل Print Screen للشاشه التى امامك وطباعتها على الفورم وهو المرفق Print Screen

مع خالص تحياتى...

شريف..

;) ;) :rolleyes:

print desktop.rar

Print Screen.rar

السلام عليكم ورحمة الله وبركاته

اشكرك اخي على المبادرة...

ولكن اخي _ ( شريف عادل ) ... اطال الله عمرك ...

بالنسبة للمثال الثاني المرفق المسمى Print Screen هل من الممكن ان اعرض الصورة في اداة البكشر .. بدلا من عرضها على مل الفورم ... كيف يتم ذلك ...

وبالنسبة للمثال الاول .. فهو ممتاز بالنسبة لي لان الكود به قصير والعيب فيه انه يعرض صورة سطح المكتب ولكني اريد ان كل مع ما سطح المكتب من ايقونات وبرامج وغيرها ... هل ممكن

ارجوا الاجابة

وشكرا

اخى العالم

السلام عليكم ورحمة الله وبركاته

اقتباس

بالنسبة للمثال الثاني المرفق المسمى Print Screen هل من الممكن ان اعرض الصورة في اداة البكشر .. بدلا من عرضها على مل الفورم ... كيف يتم ذلك ...

يمكنك ذلك بتغيير القليل وهو وضع بكتشر بوكس على الفورم لها الاسم Picture1

وتقوم بالتعديل فى الكود التالى

Private Sub Form_Load()
Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
End Sub

حتى يصبح

Private Sub Form_Load()
Set Picture1.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
End Sub

اما عن المثال الاول

اقتباس

وبالنسبة للمثال الاول .. فهو ممتاز بالنسبة لي لان الكود به قصير والعيب فيه انه يعرض صورة سطح المكتب ولكني اريد ان كل مع ما سطح المكتب من ايقونات وبرامج وغيرها ...

عندى حيله لعمل ذلك لان لايوجد داله تقوم بما تريد الى الان

سوف اقوم بعمل مثال وارفقه

مع خالص تحياتى...

شريف..

;) ;) :rolleyes:

تشكر اخي

اخي العزيز : طبق الكود ولكن وجدت انه من اللازم عرضه على مستوى الفورم وانا اريد ان اتحكم في العرض بحيث عرض الصورة بالحجم الذي اريد لعل السبب يعود الى ابعاد الفورم .

والامر الثاني شاهدت طريقة عرض الصورة عند النقر عليها بالزر عدة مرات في انها ما تتحدث كما عملتها في التايمر وكأن التحديث يجعل الصورة تأتي بالتدريج وهكذا تصغر و...

والملف المرفق يوضح ذلك ..

وشكرا

Print Screen.rar

السلام عليكم ورحمة الله وبركاته

جرب هذه الحيله لطباعة سطح المكتب بما عليه من ايقونات

Print Screen.rar

اقتباس

اخي العزيز : طبق الكود ولكن وجدت انه من اللازم عرضه على مستوى الفورم وانا اريد ان اتحكم في العرض بحيث عرض الصورة بالحجم الذي اريد لعل السبب يعود الى ابعاد الفورم .

والامر الثاني شاهدت طريقة عرض الصورة عند النقر عليها بالزر عدة مرات في انها ما تتحدث كما عملتها في التايمر وكأن التحديث يجعل الصورة تأتي بالتدريج وهكذا تصغر و...

جرب المرفق بعد التعديل...

Print Screen.rar

السلام عليكم ورجمة الله وبركاته

تشكر اخي ...

اخي بالنسبة للمثال المسمى ( برنت اسكرين ) فهو تمام إلا انه عندما يتم تحديث الصورة في البكشر يتم تحديث بالتصغير تدريجيا ... وهذا مش تمام .. والذي اريده وهو ان تتحدث الصورة عبرالتايمر وكأنها تتحرك ... وما هو الافضل للتحديث استخدام التايمر أم الحلقة For

واما المثال الاول الذي عملت فيه الحيله وهو بنفس مشكلة الاول ان يعرض الصورة مل الفورم د

وشكرا