کیفیت تصویر برای چاپ

[aryajonbesh]

با سلام خدمت دوستان عزیز
دوستان من در برنامه ای که در حال نوشتن اون هستم به مشکلی برخورد کردم که امیدوارم با راهنمایی سازنده شما دوستان عزیز بتونم مشکلم رو برطرف کنم. بنده توی برنامه قطعه کدی نوشتم که با کوچکنمایی و بزرگنمایی تصویر کیفیت اون برای چاپ از بین می ره، یعنی وقتی تصویر رو برای چاپ می فرستم، عکس چاپ شده بصورت شطرنجی چاپ می شه، حتی از PrintQuality هم استفاده کردم. در ضمن وقتی بنده از خاصیت Zoom شیء پرینتر (Printer.Zoom) استفاده می کنم این اتفاق نمی افته و عکس با کیفیت مناسب چاپ می شه. من می خواستم ببینم آیا راهی هست که بشه این مشکل رو برطرف کرد و من نخوام از خاصیت Zoom پرینتر استفاده کنم؟
قطعه کد زیر دقیقاً همونی هست که من دارم ازش استفاده می کنم:



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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal hStretchMode As Long) As Long

Const STRETCHMODE = vbPaletteModeNone

Public Function StretchBMP(picA As PictureBox, PicB As PictureBox)
On Error Resume Next

'// Call StretchBMP (Picture1 , Picture2)

picA.AutoRedraw = True
PicB.AutoRedraw = True
picA.AutoSize = True
PicB.AutoSize = False
picA.ScaleMode = vbPixels
PicB.ScaleMode = vbPixels

Call SetStretchBltMode(PicB.hdc, STRETCHMODE)
Call StretchBlt(PicB.hdc, 0, 0, PicB.ScaleWidth, PicB.ScaleHeight, picA.hdc, 0, 0, picA.ScaleWidth, picA.ScaleHeight, vbSrcCopy)
PicB.Refresh
DoEvents
End Function

[aryajonbesh]

با سلام به تمامی دوستانم در سایت برنامه نویس.
من برای سوالی که در این تاپیک مطرح کرده بودم جواب مناسبی پیدا کردم که مشکلم رو کاملا برطرف کرد. از اونجا که اطلاع دارم این فقط مشکل من نبوده و مشکل خیلی از دوستان بوده. کسانی که میخوان تا مشکل شون حل بشه آدرس ایمیل شون رو بزارند تا سورس لازمه رو براشون ایمیل کنم.:چشمک:

[ali190]

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

[aryajonbesh]

1- قطعه کد زیر را در یک ماژول قرار دهید :



Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long


Public Sub PrintDC(hdc As Long, nWidth As Long, nHeight As Long)
Dim mDC As Long
Dim mPIC As Long
Dim hBrush As Long
Dim rDC As Long, rPic As Long
Dim nColor As Long, cX As Long, cY As Long

mDC = CreateCompatibleDC(hdc)
mPIC = CreateCompatibleBitmap(hdc, nWidth, nHeight)
SelectObject mDC, mPIC

rDC = CreateCompatibleDC(hdc)
rPic = CreateCompatibleBitmap(hdc, nHeight, nWidth)
SelectObject rDC, rPic


Printer.ScaleMode = vbPixels
BitBlt mDC, 0, 0, nWidth, nHeight, hdc, 0, 0, vbSrcCopy
Printer.Print ""

For cY = 0 To nHeight
For cX = 0 To nWidth
nColor = GetPixel(mDC, cX, cY)
SetPixel rDC, nHeight - cY, cX, nColor
Next cX
Next cY

StretchBlt Printer.hdc, 0, 0, nHeight * (Screen.TwipsPerPixelY / 2), nWidth * (Screen.TwipsPerPixelX / 2), _
rDC, 0, 0, nHeight, nWidth, vbSrcCopy

Printer.EndDoc

DeleteObject mPIC
DeleteObject rPic
End Sub


2- یک عدد PictureBox و یک عدد CommandButton در فرم قرار دهید.
3- خاصیت AutoRedraw آبجکت PictureBox رو True کنید.
4- خاصیت ScaleMode آبجکت PictureBox رو به Pixel تغییر بدید.
5- یک تصویر در PictureBox خود بارگذاری نمایید.
6- قطعه کد زیر را در رویداد کلیک commandButton خود قرار دهید.



PrintDC Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight


7- برنامه را اجرا نمایید --> Enjoy
موفق و پیروز باشید:چشمک:

[aryajonbesh]

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