فوری- تبدیل شکلهای رسم شده داخل picture box به یک تصویر واحد

[takkhal]

با سلام
چطور میشه شکلهای(Shape) رسم شده داخل picture box (مثلا خط و مربع و دایره) را به یک تصویرimage واحد تبدیل کرد و در جایی ذخیره کرد؟

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

For x = 1 To 70
For y = 1 To 70
Pix(x, y) = PicGray.Point(x, y)
Next y
Next x

For x = 1 To 70
For y = 1 To 70
bRed = Pix(x, y) Mod &H100
bGreen = (Pix(x, y) \ &H100) Mod &H100
bBlue = Pix(x, y) \ &H10000

bGray = bRed * 0.3 + bGreen * 0.59 + bBlue * 0.11
bAverage = RGB(bGray, bGray, bGray)
'bAverage = (bRed + bGreen + bBlue) / 3
PicColor.PSet (x, y), bAverage
Next y
Next x



Picture1.Picture = PicColor.Image

[takkhal]

دستور بالا که جواب نداد

وقتی بوسیله برنامه نویسی شکل رو رسم می کنم با دستور زیر میتونم شکل رو کامل ذخیره کنم ولی وقتی از قبل مثلا یک line توی پیکچر باکس کشیده باشم اون ذخیره نمیشه


SavePicture Picture1.Image, App.Path & "\pic.jpg"


آیا راه حلی بجز عکس گرفتن از فرم هست؟

[just4froum]

تا اون جایی که من می دونم وقتی شما از این روش استفاده می کنید انگار دارید از Picturebox به عنوان Frame استفاده می کننید. در این حالت حتی Command هم روی PictureBox قرار می گیره و از آن خارج نمیشه. پس من فکر می کنم تنها راهش عکس گرفتن مثلا با تابع Bitblt باشه.

[the king]

با سلام
چطور میشه شکلهای(Shape) رسم شده داخل picture box (مثلا خط و مربع و دایره) را به یک تصویرimage واحد تبدیل کرد و در جایی ذخیره کرد؟

همانطور که just4froum عزیز اشاره کردند آن Shape هایی که شما داخل PictureBox قرار می دهید صرفا داخل کادر PictureBox قرار می گیرند و جزئی از
تصویر اش نخواهند بود. پیشنهاد می کنم که بجای استفاده از کنترل های Line و Shape ابتدا مشخصه AutoRedraw اون PictureBox رو True کنید و بعد
مستقیما داخل PictureBox خط و اشکال هندسی رو رسم کنید، مثلا :

With Picture1
.AutoRedraw = True
.ScaleMode = vbPixels
Picture1.Line (5, 5)-(.ScaleWidth - 5, .ScaleHeight - 5), vbBlack, B
Picture1.Line (5, 30)-(.ScaleWidth - 5, 30), vbBlack
Picture1.Line (6, 6)-(.ScaleWidth - 6, 29), RGB(100, 255, 100), BF
Picture1.Line (6, 31)-(.ScaleWidth - 6, .ScaleHeight - 6), RGB(200, 200, 255), BF
Picture1.Circle (.ScaleWidth / 2, .ScaleHeight / 2 + 15), 15, vbBlack
End With


برای ذخیره کردن تصویر هم از Picture1.Image استفاده کنید، نه Picture1.Picture

[takkhal]

با تشکر از توجه همه دوستان

در واقع مشکلم با عناصری مثل text box هست که وقتی با کد به شکل کپی از یک باکس موجود
مثلا Load Text7(i)
میسازمشون با دستورات بالا ذخیره نمیشن

مثلا نمیشه دستوری نوشت که هر عنصر ایجاد شده داخل picture box تبدیل به عکس بشه! یه چیزی شبیه Rasterize فتوشاپ!
HELP me please

[vbhamed]

سلام

چرا نمي‌خواين از عكس گرفتن استفاده كنيد ؟

[MohammadGh2011]

سلام

چرا نمي‌خواين از عكس گرفتن استفاده كنيد ؟
سلام عليکم خدمت آقاي فرجام فر
فکر کنم شما منظور اين دوستمون رو کامل متوجه نشديد!
اين دوستمون ميخواد روي يک PictureBox چندتا line , shape که کشيده اونهارو ذخيره کنه!چه طور ميشه همونطور که فرموديد عکس رو ذخيره کرد و بعد از ذخيره عکس اون line هايي که کشيده هم ذخيره شده باشند.


موفق باشيد

[vbhamed]

سلام

منظور من عكس از صفحه بود چيزي شبيه كار كليد Print Screen

[the king]

اینطوری کار تون راه می افته؟ تصویر C:\test.bmp از روی محتویات Picture1 که در pic قرار می گیره ساخته بشه :

Private Declare Function BitBlt Lib "gdi32.dll" (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.dll" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Sub Command1_Click()
Dim hDC As Long
Dim pic As PictureBox
Set pic = Controls.Add("VB.PictureBox", "temp_pic", Form1)
Picture1.ScaleMode = vbPixels
pic.Width = Picture1.Width
pic.Height = Picture1.Height
pic.Cls
pic.AutoRedraw = True
hDC = GetDC(Picture1.hWnd)
BitBlt pic.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, vbSrcCopy
ReleaseDC Picture1.hWnd, hDC
SavePicture pic.Image, "C:\test.bmp"
End Sub

[takkhal]

بازم سپاس از توجه دوستان

جناب vbhamed (http://barnamenevis.org/member.php?10624-vbhamed)
بله یکی از راهها استفاده از capture Screen است ولی دنبال یک راه متفاوت می گردم

جناب the king (http://barnamenevis.org/member.php?259237-the-king)
متاسفانه نتیجش فرقی با دستور اول خودم نداره

راستی یجایی یه کدی دیده بودم که بجای کل فرم فقط از پیکچر باکس عکس میگرفت (بدون دادن ابعاد) ولی پیداش نمیکنم! کسی چیزی یادش هست؟

[the king]

اگر پیغام WM_PRINT رو به PictureBox ارسال کنید می تونه محتویات PictureBox و کنترل های داخلش رو در یک جای دیگه توسط یک hDC رسم کنه،
اما قاعدتا نتیجه اش نباید فرقی با اینکاری که تا حالا کردین داشته باشه.

[takkhal]

سورس برنامه ای که گفته بودم میتونه از پیکچر باکس یا هر کنترل دیگه ای عکس بگیره رو پیدا کردم
چیز بدرد بخوریه ، تا حالا خیلی وقتا بکارم اومده

89077

البته خوشحال میشم دوستان اگه راه دیگه ای بجز Capture Screen بلدن هم بگن

[setroyd]

شما پارامترهارو با ابعاد picturebox پر کن این که کاری نداره !!!!! با bitblt میتونی راحت این کارو بکنی

[takkhal]

شما پارامترهارو با ابعاد picturebox پر کن این که کاری نداره !!!!! با bitblt میتونی راحت این کارو بکنی

عرض کرده بودم که!
نمیخوام عکس بگیرم و تا اونجایی که میدونم bitblt عکس میگیره!
ضمنا اگه نمونه ای که گذاشتم رو بررسی بفرمایید میبینید که یه روش جالب برای عکس گرفتن ار هر عنصری توی فرمه!
موقع عکس گرفتن همیشه این امکان هست که یچیزی بیاد روی فرم یا فرم ریسایز بشه و عکس خراب بشه

[setroyd]

نه این مشکل رو هم میشه به راحتی بر طرف کرد که خراب نشه ولی مشکل این هست که شما میگی عکس گرفته نشه !!! فکر نکنم بشه حتی یک راه هم فک نکنم وجود داشته باشه چون یا باید sendkeys ارسال بشه مثل printscrn یا bitblt بشه .

[takkhal]

نه این مشکل رو هم میشه به راحتی بر طرف کرد که خراب نشه ولی مشکل این هست که شما میگی عکس گرفته نشه !!! فکر نکنم بشه حتی یک راه هم فک نکنم وجود داشته باشه چون یا باید sendkeys ارسال بشه مثل printscrn یا bitblt بشه .

از توجه شما ممنونم
ولی می خوام اگه بشه اصلا بدون اینکه کاربر تصویر رو ببینه (مثلا فرم در حالت مینیمایز ) بتونیم اونو به شکل تصویر ذخیره دکنیم

[vbhamed]

سلام

ميشه يك عكس از فرمي كه قراره اينكار روش انجام بشه بزاريد

ممكنه تنها راه اين باشه كه اون قسمتي كه ميشه رو عكس گرفت (با SavePicture) و در مورد بقيه، خودتون شكل كنترلها رو با توجه به مختصات و اندازه اونها رسم كنيد كه البته كار ساده اي نيست ولي اگر اصرار داريد كه از چيزي شبيه Print Screen استفاده نشه يكي از راههاش اينه

البته فكر كنم در API توابعي وجود داره كه مي‌تونه شكل ظاهري يك كنترل رو رسم كنه

----------------------------------------

يك راه ديگه هم بايد جواب بده
تابع API زير
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

1 - هندل فرم رو بهش بديد و فراخواني كنيد
2 - با استفاده از تكنيكهايي مشابه Print Screen عكس بگيريد و ذخيره كنيد
3 - اين تابع رو با پارامتر 0 فراخواني كنيد

كار اين تابع اينه كه نمايش بصري عمليات شي ئي كه هندل اون رو بهش داديم قفل ميكنه يعني پنجره شما كارهاش انجام ميشه ولي روي صفحه همون حالت قبليش ديده ميشه و وقتي با پارامتر 0 فراخواني ميشه نتيجه نهايي رو نشون ميده كه شما هم قبل از اونموقع چيزهايي كه كاربر نبايد ببينه رو مخفي كردين

[setroyd]

میشه این کارو کرد فوق العاده راحت هست منظور شما اینه فرم minimize باشه و شما عکس بگیری و ذخیره کنی در واقع کاری کنی فرم دیده نشه وعکس گرفته بشه دیگه ؟؟؟ اگه منظورت اینه بگو برات درست کنم بزارم اگر نه پس بهتر توضیح بده تا با هم به یه نتیجه ی مطلوب برسیم

[takkhal]

میشه این کارو کرد فوق العاده راحت هست منظور شما اینه فرم minimize باشه و شما عکس بگیری و ذخیره کنی در واقع کاری کنی فرم دیده نشه وعکس گرفته بشه دیگه ؟؟؟ اگه منظورت اینه بگو برات درست کنم بزارم اگر نه پس بهتر توضیح بده تا با هم به یه نتیجه ی مطلوب برسیم
بله منظورم تقریبا همینه

[setroyd]

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 Command1_Click()
Dim hwnd As Long
Dim hdc As Long
hwnd = GetDesktopWindow()
hdc = GetDC(hwnd)
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Picture1.AutoRedraw = True
BitBlt Picture1.hdc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, hdc, 0, 0, SRCCOPY
SavePicture Picture1.Image, "c:\a.bmp"

End Sub


حالا جای این میتونی پنجره ی مورد نظر رو فقط کپچر کنی picturebox رو هم visible=false کنی بازم عکس درست ذخیره میشه .

[setroyd]

یا با این تابع میتونی حتی اگر پنجره minimize باشه یک عکس از اون بگیری

Private Declare Function PrintWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Form_Load()
Dim mWnd As Long
Me.AutoRedraw = True
Shell "Notepad.exe", vbNormalNoFocus
DoEvents
mWnd = FindWindow("Notepad", vbNullString)
If mWnd = 0 Then
Me.Print "NotePad not found"
Else
PrintWindow mWnd, Me.hDC, ByVal 0&
End If
End Sub


به غیر از این 2 روش دیگه امکان نداره مگر با sendkeys که باید printscreen رو send کنی که کار خوبی نیست و سرعت رو میگیره و بهینه نیست . امید وارم به دردت بخوره

[takkhal]

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 Command1_Click()
Dim hwnd As Long
Dim hdc As Long
hwnd = GetDesktopWindow()
hdc = GetDC(hwnd)
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Picture1.AutoRedraw = True
BitBlt Picture1.hdc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, hdc, 0, 0, SRCCOPY
SavePicture Picture1.Image, "c:\a.bmp"

End Sub


حالا جای این میتونی پنجره ی مورد نظر رو فقط کپچر کنی picturebox رو هم visible=false کنی بازم عکس درست ذخیره میشه .


ممنون از توجه شما
تستش کردم ولی نمیدونم من اشتباه میکنم یا وقتی picturebox رو visible=false میکنم عکس درست گرفته نمیشه
ضمنا من فقط می خوام از picturebox عکس بگیرم!






یا با این تابع میتونی حتی اگر پنجره minimize باشه یک عکس از اون بگیری

Private Declare Function PrintWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Form_Load()
Dim mWnd As Long
Me.AutoRedraw = True
Shell "Notepad.exe", vbNormalNoFocus
DoEvents
mWnd = FindWindow("Notepad", vbNullString)
If mWnd = 0 Then
Me.Print "NotePad not found"
Else
PrintWindow mWnd, Me.hDC, ByVal 0&
End If
End Sub


به غیر از این 2 روش دیگه امکان نداره مگر با sendkeys که باید printscreen رو send کنی که کار خوبی نیست و سرعت رو میگیره و بهینه نیست . امید وارم به دردت بخوره

اینم که تقریبا مثل روشهای قبلیه
آخرش به این نتیجه رسیدم که دردسر روش خودم کمتره!
به هر حال از همه عزیزانی که مشارکت کردند ممنونم
اگه ایده جدیدی پیدا بشه هم در خدمتم و سپاسگذار

[setroyd]

خوب میتونی با همون از picture box هم عکس بگیری !!