PDA

View Full Version : نحوه ذخيره عكس با يك شناسه به صورت آرايه اي



unforgiven
چهارشنبه 21 بهمن 1388, 20:53 عصر
سلام
مخواستم در مورد اين كد راهنمايي كنيد يا سورسي در اين مورد بذاريد .
بنا به نياز برنامه ام بايد عكس هاي در مورد فرش رو ذخيره كنم . فيلدي دارم براي شناسنامه هر فرش كه همه اطلاعات اون من جمله عكس هاي اون رو ذخيره كنه . هر شناسنامه فرش شامل چند فيلد هست . مثلا
فرش نايين اصفهان با شماره 100 در بانك ذخيزه شده و عكس هاي اون هم بايد با استفاده از شماره شناسنامه فرش ذخيره بشن .
مثلا : 1-100 و 2-100 و 3-100 و به همين ترتيب . مي خواستم بدونم كد مربوط به اين قسمت رو بايد به چه صورت بنويسم . لازم به ذكر هست كه تعداد عكس هاي يك فرش كه بايد به شناسنامش ضميمه بشه حداكثر 12 تا عكس مي باشد .
با سپاس

javadt
پنج شنبه 22 بهمن 1388, 00:50 صبح
فکر می کنم بهتره عکس رو توی یک پوشه برنامه ذخیره کنی
و آدرس عکس رو در بانک ذخیره کنی و فراخوانی کنی

unforgiven
پنج شنبه 22 بهمن 1388, 01:05 صبح
منم دقيقا همين كار رو كردم غير از اون كه حجم بانك كه اكسس هم هست وحشتناك مي شد . مي خوام نام كس كه همون شماره ID هست داخل يه پوشه ذخيره بشه . فكر كنم مثالي كه تو پست بالايي زدم كاملا واضح باشه .
نحوه نوشتن كد رو مي خواست. مثلا كد ID فرش 100 هست و عكس هاي مربوط به اون به ترتيب 1- 100 و 2-100 و به همين ترتيب ذخيره بشن . در واقع نام عكس ها با شماره ID يكي باشه و بقيه فقط با 1 و 2 ... به اون اضافه بشن .
اگه سورسي در اينباره باشه كه عاليه .( يه تشكر خوشگل مهمونش مي كنم ):چشمک:

vbhamed
پنج شنبه 22 بهمن 1388, 03:39 صبح
سلام

خب شما راه رو که درست رفتید مشکل کجاست ؟
فقط باید بتونید اسم فایل رو ایجاد کنید
Id رو که دارید
یک خط تیره هم بهش اضافه کنید
حالا از 1 تا 12 به ترتیب بهش اضافه کنید و هربار چک کنید ببینید فایلی که نامش از ترکیب ID و خط تیره و عدد 1 تا 12 بدست می یاد، موجود هست یا نه اگر موجود نبود تصویر جدید رو به همون نام ذخیره کنید
برای تست موجود بودن فایل هم به روش زیر عمل کنید


Dim i%, FileName$

For i = 1 To 12
FileName = Id & "-" & CStr(i)
If Dir$(App.Path & "\pictures\" & FileName) = "" Then
'دستورات مربوط به ذخیره تصویر با نام جدید
Exit For
End If
Next
در مثال بالا، فرض شده تصاویر در پوشه Pictures درون پوشه اصلی برنامه قرار گرفتن
filename هم نام فایلی است از ترکیب Id و خط تیره و شماره

برای خوندن هم به ترتیبی مشابه عمل کنید

unforgiven
پنج شنبه 22 بهمن 1388, 11:24 صبح
آقا حامد ممنون, تست مي كنم . فعلا يه تشكر ناقابل رو از من قبول كن .

unforgiven
پنج شنبه 22 بهمن 1388, 13:22 عصر
اقا حامد - با استفاده از كد شما و البته تغييرات اون تونستم عكس ها رو با ID و پسوند هاي 1 و 2 و... ذخيره كنم, ولي موقع ذخيره عكس, يك عكس رو با همون ID و با همون شكل بالا ذخيره ميكنه اما به تعداد 12 بار .
من ميخوام اولين عكس رو 100-1 و دومي رو 100-2 و به همين منوال ذخيره كنم .
لطفا اگه مقدره سورس بذاريد
بازم ممنونم

vbhamed
پنج شنبه 22 بهمن 1388, 13:40 عصر
سلام

کد بالا اصلاح شد، اما شما 12 تا عكستون رو چطوري به برنامه مي دين ؟

unforgiven
پنج شنبه 22 بهمن 1388, 14:03 عصر
سلام

کد بالا اصلاح شد، اما شما 12 تا عکستون رو چطوری به برنامه می دین ؟
با استفاده از كد زير :


Dim DbFileName As String
Dim i%
On Error GoTo errHandler:
cdbox.CancelError = True
cdbox.DialogTitle = " Add Image To Profile"
cdbox.Filter = "All (*.bmp,*.gif,*.jpg,*.emf,*.wmf)|*.bmp;*.gif;*.jpg; *.emf;*.wmf |Bitmap Image File (*.bmp)|*.bmp|CompuServe GIF File (*.gif)|*.gif|JPG Image File (*.jpg;*.jpeg)|*.jpg;*.jpeg|Enhanced Metafile Format (*.emf)|*.emf|Windows Metafile Format (*.wmf)|*.wmf"
cdbox.FilterIndex = 1
cdbox.Flags = cdlOFNHideReadOnly
cdbox.ShowOpen
DbFileName = cdbox.FileName
lblDBFilename.Caption = DbFileName
For i = 1 To 12
CopyFile cdbox.FileName, App.Path & "\pic" & "\img" & Txtid & "-" & CStr(i) & ".gif", False
Next
If cdbox.FileName <> "" Then
Image1.Picture = LoadPicture(cdbox.FileName)
End If
errHandler:
Exit Sub

با استفاده از يك common dialog - Picbox
براي هر عكس اين كار انجام نميشه . مي خوام با استفاده از ابزار هاي بالا هر بار كه عكسي رو ذخيره مي كنم با يك پسوند ذخيره بشه

vbhamed
جمعه 23 بهمن 1388, 01:26 صبح
سلام

اين كدي كه شما نوشتين كه ظاهرا براي لود كردنه، من پرسيدم براي انتخاب 12 عكس چكار مي كنيد، 12 تا PictureBox داريد يا با زدن مثلا دكمه عكس بعدي، يكي يكي نشون مي دين

ضمنا طبق كدي كه دادم ننوشتيد، دستور شرطي داخل حلقه هست و Exit For هم داريم

unforgiven
جمعه 23 بهمن 1388, 11:12 صبح
سلام
ظاهرا كد رو اشتباهي ارسال كردم . به اين نتيجه رسيدم كه 12 تا picturebox بزارم و مثل كرد زير براي هر كدوم پسوند در نظر بگيرم - اينجوري مشكل حل شد .


Dim i%
App.Path & "\pic" & "\img" & Txtid & "-" & CStr(1) & ".gif", False

يه سوال ديگه كه مربوط به اين تاپيك نميشه , دستور Kill براي پاك كردن عكسي كه حجمش بيشتر از 1 مگ باشه ارور ميده - وقتي عكسي با حجم 300 k مي زارم بدون مشكل اونو حذف ميكنه ! مشكل از كجاست ؟ فكر نمي كنم دستور Kill با حذف فايل هاي حجيم مشكل داشته باشه .
لطفا در اين مورد هم راهنمايي كنيد.

vbhamed
جمعه 23 بهمن 1388, 11:40 صبح
سلام

احتمالا فايلتون در حال استفاده است
در هر حال بهتره از منوي Project گزينه References رو انتخاب و سپس Microsoft Scripting Runtime رو تيك بزنيد، بعد متغيري به شكل زير در قسمت عمومي فرم تعريف و از متدهاي اون استفاده كنيد


Dim fso As New FileSystemObject

مثال پاك كردن فايل

fso.DeleteFile "c:\test.jpg", True

unforgiven
جمعه 23 بهمن 1388, 13:11 عصر
سلام
آقا حامد گل
من منظورم خطاي حذف فايل در استفاده از دستور kill بود . شما از FSO مثال زديد . به هر حال ممنون .
راستش مشكل رو هم پيدا كردم . اگه از دستور kill استفاده كنيم و فايل Read-Only باشه خطا مي گيره ! ولي با FSO اگر هم Read-only باشه خطايي به وجود نمياد و كار حذف رو انجام ميده .