نکات، ایده ها و ترفندهای کوچک برنامه نویسی در vb.net

[ghafoori]

نکات این تاپیک با اجازه از کاربر sinpin از تاپیک نکات، ایده ها و ترفندهای کوچک برنامه نویسی در #C کپی شده و پس از تغییر زبان از سی شارپ به وی بی دات نت در این تاپیک نوشته شده است با درخواست ایشان تمام این نمونه کدها دارای لینکی به منبع اصلی انها در تالار سی شارپ است و من سعی کردم کدهای تا حد امکان بدون خطا تبدیل کنم اگر به هر نحوی خطایی در این کدها است لطفا با پیام خصوصی ان را به من متذکر شوید از نوشتن خطا ها در این تاپیک یا درخواستهای دیگر خودداری کنید نکاتی را که کاربر sinpin در تاپیک خودشان درج کردند را نیز من هم درج می کنم لطفا این نکات را رعایت فرمایید
باز هم از دوستانی که این نکات را در تالار سی شارپ قرار دادند تشکر می کنم نام کاربری این دوستان به ترتیب تبدیل کدsinpin
az_farzaneh-Masoud_TB-r.kiani- bermooda-razavi_university-saeid.yavary-danial82-pd_ze62-hassan razavi-shahali- dr_csharp-

کدها به مرور اضافه خواهند شد من تا حالا بیش از 80 پست را تبدیل کردم اگر از دوستان کسی می خواهد در این کار به من کمک کند پیام خصوصی برای من بفرستد

چند نکته قبل از فعالیت در این تاپیک:

امکان ادامه دار بودن حیات چنین تاپیکهایی مستلزم رعایت دقیق نظم و استاندارد توسط تمامی دوستان است که در غیراینصورت و با بیراهه رفتن، همواره شاهد قفل شدن تاپیکهایی از این دست بوده ایم. لذا از تمامی دوستان استدعا دارم با رعایت نکات زیر در نظم این تاپیک سهیم باشند :

0- سینتکس وی بی دات نت است

قابل توجه دوستانی که از سایر تالارها قصد فعالیت دارند : سینتکس پیشفرض ارسال کد در این تاپیک صرفا وی بی دات نت است.

1- چکیده نویسی

نکات و ترفندها رو بصورت کاملا خلاصه، مفید و ماژولار (تمرکز هر پست تنها روی یک نکته باشد) پست نمایید و از درج هرگونه نکته ی طولانی خودداری و چنانچه نکته ی قابل توجه ای سراغ دارید که نیاز به کدنویسی و توضیحات طولانی دارد؛ تنها به یک اشاره کوچک بسنده و فایل سورس و یا توضیحات کامل را ضمیمه فرمایید.

2- هر نکته ای مفید است

بدلیل تنوع کاربران تالار و گستردگی زبان و فریمورک؛ لزومی ندارد نکته ای که ارسال میکنید موضوعی غامض و یا بسیار پیچیده و چشمگیر باشد؛ در واقع هر نکته ای که به شکل صحیح ارسال شودمیتواند مفید باشد.

3- درج عنوان پست

عنوان مناسب و مختصری برای مطلب ارسالی خود پیدا کرده و آن را در قسمت عنوان پست بنویسید. (تغییر عنوان پستها در "حالت پیشرفته" قابل دسترسی میباشد)
عنوان پست را دقیق و قطعی انتخاب نمایید؛ برای مثال عنوان : "چند نکته مهم در سی شارپ" نامناسب است و یا بجای عنوان : "چند فیلم آموزشی مفید" بهتر است بنویسید : "معرفی لینک دانلود چند فیلم آموزشی ساده در مورد LINQ"

4- درج رفرنس اصلی

چنانچه نکته ارسالی را از منبعی برداشت میکنید لطفا لینک اصلی آن را نیز در انتهای مطلب درج فرمایید. (با اینکار دوستان میتوانند با مراجعه با اون لینک از جزییات نکته ارسالی نیز مطلع گردند.)

5- عدم ارسال نکات تکراری و ادامه دار

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

6- ارسال نکات تست شده

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

7- عدم نمایش امضا و تصاویر بزرگ

با توجه به ماهیت شلوغ این قبیل تاپیکها و جهت نظم بهتر؛ ترجیحا :

* پستهای خود را بدون درج امضا ارسال نمایید.

* جهت کند نشدن لودینگ صفحات از قرار دادن لینک تصاویر بزرگ خودداری و یا اینکه آنها را بصورت ضمیمه شده قرار دهید.

8- ماهیت تاپیک

این تاپیک محل مناسبی برای این موارد نیست :
آموزش برنامه نویسی، سئوال و جواب کردن، سعی در اثبات برتری یک روش خاص، بحث و ارسال توضیحات اضافی، خورده گیری از مطالب ارسالی دیگران، ارسال مطالب غیرفنی و نامرتبط، انتشار ادعاهای کاذب، تشکرهای بیمورد و ...
لذا چنانچه راجع به هر یک از نکات سئوال و یا مشکلی پیش آمد، لطفا موضوع رو از طریق ارسال پیام خصوصی به نویسنده مطلب و یا طرح در یک تاپیک مستقل، حل و فصل کنید.

9- نظم و استاندارد تاپیک

لطفا در نظم تاپیک کوشا باشید و چنانچه با پستی مواجه شدید که با توجه به بند شماره 9 به شکلی نامناسب ارسال شده بود؛ به جای تکرار اشتباه نویسنده قبلی، صرفا آن را به مدیران تالار گزارش کنید، قطعا آنان ما را در حفظ مسیر اصلی تاپیک یاری خواهند کرد.

_______________________________

از اینکه به حقوق خود و دیگران احترام میگذارید از شما متشکرم
موفق باشید.

[ghafoori]

اصول اولیه OOP و دات نت فریمورک :


پیاده سازی حالت ساده ی الگوی سینگلتون در یک کلاس (http://barnamenevis.org/forum/showpost.php?p=484503&postcount=6)
چگونه از یک فرم تنها یک عدد بتواند باز شود ؟ (توسط Generic Singleton) (http://barnamenevis.org/forum/showpost.php?p=484581&postcount=28)
فراخونی یک رویداد از داخل رویداد دیگر (http://barnamenevis.org/forum/showpost.php?p=484918&postcount=38)
If Like و کاربرد آن (http://barnamenevis.org/forum/showpost.php?p=486351&postcount=42)
ارسال تعداد متغیر پارامتر به یک متود (http://barnamenevis.org/forum/showpost.php?p=488985&postcount=87)
تعریف عملگر های سفارشی (http://barnamenevis.org/forum/showpost.php?p=488992&postcount=93)
ساختن یک لیست ژنریک از اشیاء (http://barnamenevis.org/forum/showpost.php?p=489000&postcount=100)


کار کردن با انواع داده ها :


ایجاد متن و رشته های چند سطری (http://barnamenevis.org/forum/showpost.php?p=484590&postcount=35)
تبدیل نوع enum به int (http://barnamenevis.org/forum/showpost.php?p=487900&postcount=64)
بدست آوردن مقدار یک Enum از عدد متناظر آن (http://barnamenevis.org/forum/showpost.php?p=488980&postcount=84)
بدست آوردن مقدار یک Enum از رشته متنی متناظر با آن (http://barnamenevis.org/forum/showpost.php?p=488981&postcount=85)
چرا و کی باید از کلاس StringBuilder به جای string استفاده کنیم ؟ (http://barnamenevis.org/forum/showpost.php?p=488999&postcount=99)



کار با کنترلها و کامپوننتها :


انتقال آیتمهای یک آرایه از اعداد به یک لیست باکس (http://barnamenevis.org/forum/showpost.php?p=484501&postcount=5)
پاک کردن خاصیت Text گروهی از کنترلهای مشخص (http://barnamenevis.org/forum/showpost.php?p=484522&postcount=19)
عوض کردن نشانگر ماوس (cursor) روی یک کنترل (http://barnamenevis.org/forum/showpost.php?p=484523&postcount=20)
پاک کردن خاصیت Text کنترلهای موجود در یک Container بصورت بازگشتی (http://barnamenevis.org/forum/showpost.php?p=484525&postcount=21)
طریقه تغییر دادن خاصیت FontStyle یک کنترل در زمان اجرا (http://barnamenevis.org/forum/showpost.php?p=484583&postcount=29)
خواندن و نوشتن فایل به صورت unicode با استفاده از richTextBox (http://barnamenevis.org/forum/showpost.php?p=484585&postcount=31)
جابجا کردن فرم با کلیک بر روی هر قسمت از آن - با استفاده از توابع API (http://barnamenevis.org/forum/showpost.php?p=484587&postcount=32)
افزودن کنترل در زمان اجرا (http://barnamenevis.org/forum/showpost.php?p=487438&postcount=45)
وادار کردن لیست باکس به اسکرول تا یک آیتم مشخص (http://barnamenevis.org/forum/showpost.php?p=487443&postcount=48)
جابجا کردن فرم با کلیک بر روی هر قسمت از آن - بدون استفاده از توابع API (http://barnamenevis.org/forum/showpost.php?p=487444&postcount=49)
انتقال مقادیر خاصیت Text دو تکست باکس از طریق Drag & Drop (http://barnamenevis.org/forum/showpost.php?p=487445&postcount=50)
تبدیل اتوماتیک دکمه Enter به Tab جهت انتقال فوکوس در کنترلها (http://barnamenevis.org/forum/showpost.php?p=487479&postcount=59)
انتقال آیتمهای Enum به یک ListBox (http://barnamenevis.org/forum/showpost.php?p=487902&postcount=65)
نحوه Drag کردن عکس از یک pictureBox به یک pictureBox دیگه (http://barnamenevis.org/forum/showpost.php?p=487911&postcount=72)



آرایه ها و کالکشنها :


روشهای Initialize کردن انواع آرایه ها (http://barnamenevis.org/forum/showpost.php?p=484591&postcount=36)


دیتابیس و بانکهای اطلاعاتی :


بدست آوردن لیست نمونه های SQL Server موجود در شبکه (http://barnamenevis.org/forum/showpost.php?p=484509&postcount=9)
برگرداندن تعدادی مشخص و اتفاقی از رکوردها بوسیله کوئری (http://barnamenevis.org/forum/showpost.php?p=484521&postcount=18)
بدست آوردن آخرین Identity اضافه شده به جدول (http://barnamenevis.org/forum/showpost.php?p=484526&postcount=22)


فایلها، استریمها (I/O) :


تغییر خواص یک فایل (http://barnamenevis.org/forum/showpost.php?p=487454&postcount=56)
محاسبه ی حجم کلی یک دایرکتوری (http://barnamenevis.org/forum/showpost.php?p=487455&postcount=57)
خواندن و نوشتن فایلهای متنی (http://barnamenevis.org/forum/showpost.php?p=487896&postcount=60)
اضافه و جدا کردن نام فایل از مسیر کامل (http://barnamenevis.org/forum/showpost.php?p=487897&postcount=61)
ایجاد یک نام تصادفی برای فایل (http://barnamenevis.org/forum/showpost.php?p=487898&postcount=62)
انجام عملیات متداول روی فایلها و دایرکتوریها (http://barnamenevis.org/forum/showpost.php?p=487916&postcount=77)
کپی کردن فایلهای درون یک دایرکتوری (فقط فایلها) (http://barnamenevis.org/forum/showpost.php?p=487917&postcount=78)
کپی کامل یک دایرکتوری و تمامی زیرشاخه های آن بصورت بازگشتی (http://barnamenevis.org/forum/showpost.php?p=487918&postcount=79)



گرافیک : GDI, GDI+, DirectX, OpenGL


حاشیه دار کردن کنترل TextBox با یک رنگ دلخواه (http://barnamenevis.org/forum/showpost.php?p=484447&postcount=3)
محو شدن تدریجی یک فرم با تغییر دادن خاصیت Opacity (http://barnamenevis.org/forum/showpost.php?p=484493&postcount=4)
رسم یک چندضلعی توپر روی یک فرم (http://barnamenevis.org/forum/showpost.php?p=484504&postcount=7)
کشیدن نقاشی با توابع ساده گرافیکی و ذخیره خروجی در یک فایل (http://barnamenevis.org/forum/showpost.php?p=484506&postcount=8)
شفاف کردن پشت زمینه ی کنترلها (http://barnamenevis.org/forum/showpost.php?p=484513&postcount=13)
ایجاد فرمهایی با اشکال غیرمستطیلی (http://barnamenevis.org/forum/showpost.php?p=484575&postcount=24)
ایجاد طیف رنگ (Gradient) بعنوان پشت زمینه ی کنترلها (http://barnamenevis.org/forum/showpost.php?p=484580&postcount=27)
ایجاد تصاویر Bitmap در زمان اجرا (http://barnamenevis.org/forum/showpost.php?p=484593&postcount=37)
پرینت با استفاده از PrintDocument (http://barnamenevis.org/forum/showpost.php?p=486543&postcount=43)
پرینت فرم (http://barnamenevis.org/forum/showpost.php?p=486578&postcount=44)
گرفتن و تسخیر کردن (Capture) تصویر صفحه نمایش (http://barnamenevis.org/forum/showpost.php?p=487447&postcount=51)
بدست آوردن لیست چاپگرهای نصب شده در یک سیست (http://barnamenevis.org/forum/showpost.php?p=487451&postcount=54)
خواندن و نوشتن رنگ یک پیکسل به کمک توابع API (http://barnamenevis.org/forum/showpost.php?p=487456&postcount=58)
سیاه و سفید کردن عکس با کد نویسی (http://barnamenevis.org/forum/showpost.php?p=487913&postcount=74)
Resize کردن یک تصویر با کدنویسی (http://barnamenevis.org/forum/showpost.php?p=488974&postcount=81)
Crop کردن یک تصویر (یک برش مستطیلی از تصویر) (http://barnamenevis.org/forum/showpost.php?p=488977&postcount=82)
تبدیل یک تصویر رنگی به معادل GrayScal آن (http://barnamenevis.org/forum/showpost.php?p=488978&postcount=83)
چرخاندن یک تصویر با زاویه دلخواه (http://barnamenevis.org/forum/showpost.php?p=488983&postcount=86)



مالتی مدیا :


پخش کردن برخی اصوات و صداهای سیستمی تنها با یک خط! (http://barnamenevis.org/forum/showpost.php?p=487449&postcount=52)
نواختن یک فایل صوتی با فرمت Wave (http://barnamenevis.org/forum/showpost.php?p=487450&postcount=53)


نکات سیستمی :


افزودن و حذف کردن یک برنامه به StartUp ویندوز از طریق کلیدهای رجیستری (http://barnamenevis.org/forum/showpost.php?p=484510&postcount=10)
Hibernate و Standby کردن کامپیوتر (http://barnamenevis.org/forum/showpost.php?p=484511&postcount=11)
قفل کردن کامپیوتر از طریق کدنویسی (http://barnamenevis.org/forum/showpost.php?p=484512&postcount=12)
Shutdown، Restart و Logoff کردن یک کامپیوتر بوسیله کد (http://barnamenevis.org/forum/showpost.php?p=484516&postcount=14)
بستن یک پروسه در حال اجرا (http://barnamenevis.org/forum/showpost.php?p=484517&postcount=15)
بدست آوردن مسیر دایرکتوری جاری برنامه (http://barnamenevis.org/forum/showpost.php?p=484520&postcount=17)
تغییر زبان پیشفرض ویندوز بصورت داینامیک در برنامه (http://barnamenevis.org/forum/showpost.php?p=484578&postcount=26)
بدست آوردن مسیر فولدرهای ویژه (http://barnamenevis.org/forum/showpost.php?p=484584&postcount=30)
یافتن شماره سریال و مدل تمامی هارددیسکهای موجود در یک سیستم (http://barnamenevis.org/forum/showpost.php?p=484588&postcount=33)
اجرا کردن یک فایل اجرایی با کدنویسی (http://barnamenevis.org/forum/showpost.php?p=484589&postcount=34)
فرستادن کلیدهای ترکیبی با SendKeys (http://barnamenevis.org/forum/showpost.php?p=485196&postcount=40)
فرستادن کلیدهای ترکیبی با SendKeys (به صورت کامل) (http://barnamenevis.org/forum/showpost.php?p=485556&postcount=41)
نمایش تصاویر در Windows picture and fax viewer از طریق کدنویسی (http://barnamenevis.org/forum/showpost.php?p=487442&postcount=47)
برخی اعمال متدوال روی تاریخ میلادی (http://barnamenevis.org/forum/showpost.php?p=487453&postcount=55)
باز کردن یک سایت توسط internet explorer (http://barnamenevis.org/forum/showpost.php?p=487899&postcount=63)
بدست آوردن لیست تمامی فرمهای باز در یک برنامه (http://barnamenevis.org/forum/showpost.php?p=487904&postcount=67)
restart کردن (بستن و مجددا اجرا کردن) برنامه (http://barnamenevis.org/forum/showpost.php?p=487905&postcount=68)
ساده ترین راه برای جلوگیری از Not Respond شدن برنامه در حلقه های طولانی (http://barnamenevis.org/forum/showpost.php?p=487907&postcount=69)
فقط یک نمونه از برنامه بتواند اجرا شود (با استفاده از Process) (http://barnamenevis.org/forum/showpost.php?p=487909&postcount=70)
انجام عملیات متداول در رجیستری ویندوز (http://barnamenevis.org/forum/showpost.php?p=487919&postcount=80)
Serialize کردن باینری آبجکت در فایل (http://barnamenevis.org/forum/showpost.php?p=488986&postcount=88)
Serialize کردن object در XML (http://barnamenevis.org/forum/showpost.php?p=488987&postcount=89)
DeSerialize کردن object از XML (http://barnamenevis.org/forum/showpost.php?p=488988&postcount=90)
Serialize کردن object در SOAP XML (http://barnamenevis.org/forum/showpost.php?p=488989&postcount=91)
DeSerialize کردن object از SOAP XML (http://barnamenevis.org/forum/showpost.php?p=488990&postcount=92)
بدست آوردن شماره سریال پراسسور (CPU Id) (http://barnamenevis.org/forum/showpost.php?p=488994&postcount=94)
DeSerialize کردن باینری آبجکت از فایل (http://barnamenevis.org/forum/showpost.php?p=488995&postcount=95)
بدست آوردن نام شرکت سازنده پراسسور (CPU Manufacturer) (http://barnamenevis.org/forum/showpost.php?p=488996&postcount=96)
بدست آوردن میزان فضای خالی یک درایو (پارتیشن) (http://barnamenevis.org/forum/showpost.php?p=488997&postcount=97)
بدست آوردن حجم کلی یک درایو (پارتیشن) (http://barnamenevis.org/forum/showpost.php?p=488998&postcount=98)
sort کردن آبجکتهای یک کلاس با پیاده سازی اینترفیس IComparable (http://barnamenevis.org/forum/showpost.php?p=489001&postcount=101)

توزیع و Setup سازی:


اینترنت، شبکه، ... :


Ping کردن یک کامپیوتر تحت شبکه (http://barnamenevis.org/forum/showpost.php?p=484519&postcount=16)
قطع کردن اتصال اینترنت دایل آپ از طریق دستورات خط فرمان (http://barnamenevis.org/forum/showpost.php?p=484576&postcount=25)
یافتن MAC آدرس کارت شبکه (http://barnamenevis.org/forum/showpost.php?p=487440&postcount=46)
روش ارسال ایمیل به چندین گیرنده (http://barnamenevis.org/forum/showpost.php?p=487910&postcount=71)



مباحث مختص دات نت فریمورک 3.0 و 3.5 :


کار کردن با کلاس TimeZoneInfo (http://barnamenevis.org/forum/showpost.php?p=487914&postcount=75)
بدست آوردن لیست تمامی ناحیه های زمانی (Time Zone) (http://barnamenevis.org/forum/showpost.php?p=487915&postcount=76)


میانبرها و ترفندهای IDE :


ایجاد کردن یک Property (http://barnamenevis.org/forum/showpost.php?p=484574&postcount=23)
معرفی میانبرهای متداول در کدنویسی (http://barnamenevis.org/forum/showpost.php?p=487903&postcount=66)
نحوه ایجاد فرم About بدون کد نویسی و طراحی فرم (http://barnamenevis.org/forum/showpost.php?p=487912&postcount=73)

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467567&postcount=5


در کلاس TextBox خود (و یا سایر کنترلهای دلخواه : کامبوباکس، لیست باکس و ...) بنویسید :
کد:

Private Shared WM_NCPAINT As Integer = &H85
Private Shared WM_ERASEBKGND As Integer = &H14
Private Shared WM_PAINT As Integer = &HF

<DllImport("user32.dll")> _
Shared Function GetDCEx(ByVal hwnd As IntPtr, ByVal hrgnclip As IntPtr, ByVal fdwOptions As UInt32) As IntPtr
End Function
<DllImport("user32.dll")> _
Shared Function ReleaseDC(ByVal hwnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_NCPAINT Or m.Msg = WM_ERASEBKGND Or m.Msg = WM_PAINT Then

Dim hdc As IntPtr = GetDCEx(m.HWnd, CType(1, IntPtr), 1 Or &H20)

If (hdc <> IntPtr.Zero) Then

Dim graphics As Graphics = graphics.FromHdc(hdc)
Dim borderColor As Color = Color.Blue
Dim rectangle As Rectangle = New Rectangle(0, 0, Me.Width, Me.Height)
ControlPaint.DrawBorder(graphics, rectangle, borderColor, ButtonBorderStyle.Solid)
m.Result = CType(1, IntPtr)
ReleaseDC(m.HWnd, hdc)
End If
End If
End Sub

توجه داشته باشید که انجام اینکار صرفا بوسیله override کردن رویداد paint و رسم یک مستطیل امکانپذیر نیست.

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467568&postcount=6


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Me.Opacity = 1
Dim i As Integer
For i = 0 To 100
Me.Opacity -= 0.01
Application.DoEvents()
Next
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467569&postcount=7


Dim numbers As Integer() = {12, 23, 34, 45, 56, 67}
Dim oNumbers(numbers.Length) As Object
numbers.CopyTo(oNumbers, 0)
listBox1.Items.AddRange(oNumbers)

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=467571&postcount=8


Class SingletonClass
NotInheritable

' Static members are lazily initialized.
' .NET guarantees thread safety for static initialization
Private Shared ReadOnly instance As SingletonClass = New SingletonClass()

' Note: constructor is private.
Private Sub New()

End Sub

Public Shared Function GetInstance() As SingletonClass
Return instance
End Function

End Class

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467572&postcount=9


Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = e.Graphics
' Create pen.
Dim blackPen As Pen = New Pen(Color.Black, 3)
' Create points that define polygon.
Dim point1 As Point = New Point(30, 50)
Dim point2 As Point = New Point(100, 25)
Dim point3 As Point = New Point(200, 5)
Dim point4 As Point = New Point(250, 50)
Dim point5 As Point = New Point(270, 100)
Dim point6 As Point = New Point(250, 250)
Dim curvePoints As Point() = {point1, point2, point3, point4, point5, point6}
' Draw polygon to screen.
g.DrawPolygon(blackPen, curvePoints)
' Fill polygon
g.FillPolygon(Brushes.Red, curvePoints)
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467581&postcount=10


Public Sub Draw2File()

Dim bmp As Bitmap = New Bitmap(500, 400)
Dim gr As Graphics = Graphics.FromImage(bmp)
Dim rect As Rectangle = New Rectangle(20, 20, 450, 350)
gr.DrawRectangle(Pens.Red, rect)
gr.FillRectangle(Brushes.Pink, rect)
gr.DrawString("Salam", New Font("Arial", 10), Brushes.Red, 50, 50)
gr.DrawArc(Pens.Red, 30, 30, 60, 60, 0, 180)
gr.DrawEllipse(New Pen(Color.Yellow, 3), New Rectangle(200, 100, 200, 200))
bmp.Save("C:\1.bmp")
bmp.Dispose()
gr.Dispose()
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467590&postcount=11



Imports System.Data.Sql

Private Sub ShowSQLServerInstances()

Dim instance As SqlDataSourceEnumerator = SqlDataSourceEnumerator.Instance
Dim table As System.Data.DataTable = instance.GetDataSources()
dataGridView1.DataSource = (table)
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467595&postcount=12


Private Sub AddStartUpKey(ByVal _name As String, ByVal _path As String)

Dim key As RegistryKey = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
key.SetValue(_name, _path)
End Sub

Private Sub RemoveStartUpKey(ByVal _name As String)

Dim key As RegistryKey = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
key.DeleteValue(_name, False)
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467605&postcount=13


' Hibernate
Application.SetSuspendState(PowerState.Hibernate, True, True)

'// Standby
Application.SetSuspendState(PowerState.Suspend, True, True)

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467608&postcount=14


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
'// Lock workstation
LockWorkStation()
End Sub

<DllImport("user32.dll")> _
Public Shared Sub LockWorkStation()
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467610&postcount=15

ایجاد شفافیت کامل پشت زمینه ی یک کنترل :
کد:


control.BackColor = Color.Transparent

تعیین میزان شفافیت یک کنترل:
کد:


control.BackColor = Color.FromArgb(trancparency, control.BackColor)

در کد بالا مقدار trancparency از 0 (برای کاملا شفاف) تا 255 (کاملا کدر) قابل تغییر است.

مثال : یک Label با شفافیت 50%
کد:


label1.BackColor = Color.FromArgb(127, label1.BackColor)

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467612&postcount=16


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
'// Log Off
ExitWindowsEx(0, 0)

'// Reboot
ExitWindowsEx(2, 0)

'// Shutdown
ExitWindowsEx(1, 0)

'/ Force LogOff
ExitWindowsEx(4, 0)
End Sub

<DllImport("user32.dll")> _
Public Shared Function ExitWindowsEx(ByVal uFlags As Integer, ByVal dwReason As Integer) As Integer
End Function

و یا:


'// Log Off
System.Diagnostics.Process.Start("ShutDown", "/l")

'// Reboot
System.Diagnostics.Process.Start("ShutDown", "/r")

'// Shutdown
System.Diagnostics.Process.Start("ShutDown", "/s")

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467764&postcount=17


Imports System.Diagnostics

For Each p As Process In Process.GetProcesses()

If p.ProcessName.ToLower() = "notepad" Then
p.Kill()
End If
Next
و یا :
کد:

System.Diagnostics.Process.Start("TaskKill", "/f /im Notepad.exe /t")

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467766&postcount=18



Imports System.Net.NetworkInformation

Dim remoteMachineNameOrIP As String = "127.0.0.1"
Dim timeOut As Integer = 5
Dim ping As Ping = New Ping()
'// Pinging remote maching
Dim reply As PingReply = ping.Send(remoteMachineNameOrIP, timeOut)
'// Displaying the result
Dim sb As StringBuilder = New StringBuilder()
sb.Append("Address:" + reply.Address.ToString())
sb.Append("\nStatus:" + reply.Status.ToString())
sb.Append("\nRoundtripTime:" + reply.RoundtripTime.ToString())
MessageBox.Show(sb.ToString(), "Ping Result: " + remoteMachineNameOrIP)

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467768&postcount=19

کد:


MessageBox.Show(AppDomain.CurrentDomain.BaseDirect ory)

یا :
کد:


MessageBox.Show(System.IO.Directory.GetCurrentDire ctory())

یا :
کد:


MessageBox.Show(Application.StartupPath)

یا:
کد:


MessageBox.Show(System.IO.Path.GetDirectoryName(Ap plication.ExecutablePath))

کاربر bad_boy_2007 یاد اوری کردند با این کد هم می شود


My.Application.Info.DirectoryPath

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467774&postcount=20


مثال : برگرداندن 10 رکورد اخری که به جدول اضافه شده از جدول myTable
کد:


SELECT TOP 10 id,title
FROM myTable
ORDER BY NEWID()

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467782&postcount=21

کاربرد : زمانی که نمیتوان از یک الگوریتم بازگشتی استفاده کرد؛ برای مثال کنترلها در Container های متفاوتی هستند و تنها تعداد خاصی از آنها باید Clear شوند.
کد:


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
ClearControls(TextBox1, textBox2, comboBox1)
End Sub

Public Sub ClearControls(ByVal ctls As Control())
For Each ct As Control In ctls
ct.Text = ""
Next
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467784&postcount=22

استفاده از کرسرهای پیشفرض محیط :
کد:


Button1.Cursor = Cursors.Hand

لود کردن یک کرسر سفارشی از فایل :
کد:


button1.Cursor = new Cursor("C:\WINDOWS\Cursors\hibeam.cur")

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467785&postcount=23

کد:


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
ClearControls(Me.controls)
End Sub

Public Sub ClearControls(ByVal _parent As Control)
_parent.Text = ""
If _parent.HasChildren = True Then
For Each ct As Control In _parent.Controls
ClearControls(ct)
Next
End If

End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467790&postcount=24

کد:


INSERT INTO Sales.Customer ([TerritoryID],[CustomerType]) VALUES (8,'S')
GO
SELECT SCOPE_IDENTITY()

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467912&postcount=25

برای اینکه خیلی سریع یک Property ایجاد کنی کافیه که کلمه prop رو تایپ کنین و دوباره Tab بزنین. بعد نوع داده ای , نام متغییر private و در نهایت نام Propety مورد نظرتون. با تایپ کردن 5 کلمه Property تون آمادست.

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467954&postcount=31

ایجاد یک فرم دایره ای شکل :
کد:



Me.Height = 350
Me.Width = 350
'//Creating circle path
Dim path As System.Drawing.Drawing2D.GraphicsPath = New System.Drawing.Drawing2D.GraphicsPath()
path.AddEllipse(0, 0, 300, 300)
'//Creating the region from the circle path
Me.Region = New Region(path)
Me.Show()

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468034&postcount=32

کد:


System.Diagnostics.Process.Start("rasdial", "/disconnect")

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468038&postcount=33

کد:


Public Shared Sub SetLanguage2English()
InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(New CultureInfo("en-US"))
End Sub

Public Shared Sub SetLanguage2Farsi()
InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(New CultureInfo("fa-IR"))
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468043&postcount=34

کد:


Imports System.Drawing.Drawing2D
Imports System.Drawing


Public Sub PaintGradient(ByVal _control As Control, ByVal _direction As LinearGradientMode, ByVal _gradientColorStart As Color, ByVal _gradientColorEnd As Color)

Dim gradBrush As LinearGradientBrush
gradBrush = New LinearGradientBrush(New Rectangle(0, 0, _control.Width, _control.Height), _gradientColorStart, _gradientColorEnd, _direction)
Dim bmp As Bitmap = New Bitmap(_control.Width, _control.Height)
Dim g As Graphics = Graphics.FromImage(bmp)
g.FillRectangle(gradBrush, New Rectangle(0, 0, _control.Width, _control.Height))
_control.BackgroundImage = bmp
_control.BackgroundImageLayout = ImageLayout.Stretch
End Sub



حال این متود رو در رخداد Paint کنترلهای دلخواه (فرم، دکمه، پنل ...) بنویسید :
کد:



Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
PaintGradient(Me, LinearGradientMode.Vertical, Color.RoyalBlue, Color.DarkBlue)
End Sub




خصوصا ظاهر بهتر و مناسبتری برای دکمه های شما ایجاد میکند.

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468053&postcount=35


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

کد:

public class SingletonProvider(Of T As new)
Sub New()

End Sub

Public Shared ReadOnly Property Instance() As T
Get
Return SingletonCreator.Instance
End Get
End Property

Class SingletonCreator

Shared Sub New()

End Sub
Private Shared _instance As T
Public Shared ReadOnly Property Instance() As T
Get

Dim frm As System.Windows.Forms.Form = CType(CType(Instance, Object), Windows.Forms.Form)
If Instance Is Nothing Then
Instance = New T
End If
Return Instance
End Get
End Property
End Class
End Class



و برای استفاده :
کد:


Dim boat As Form = SingletonProvider(Of Form).Instance
boat.Show()

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468255&postcount=36

کد:


TextBox1.Font = New Font(TextBox1.Font, FontStyle.Bold Or FontStyle.Italic Or FontStyle.Underline)

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=468440&postcount=38


برای مثال :
کد:

Dim path As String = Environment.GetFolderPath(Environment.SpecialFolde r.ProgramFiles)

سایر مسیرها قابل دستیابی با این روش :
کد:

Desktop, MyDocuments, System, ...

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468822&postcount=39

کد:


'// read text file
richTextBox1.LoadFile("C:\Log.txt", RichTextBoxStreamType.UnicodePlainText)
'// save text file
richTextBox1.SaveFile("C:\Log.txt", RichTextBoxStreamType.UnicodePlainText)

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468975&postcount=40

کد:



<DllImport("user32.dll")> _
Shared Function ReleaseCapture() As Integer
End Function
Declare Auto Function SendMessageA Lib "user32.dll" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Object) As Integer

Private Const WM_NCLBUTTONDOWN As Integer = 161

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
ReleaseCapture()
SendMessageA(Me.Handle.ToInt32(), WM_NCLBUTTONDOWN, 2, 0)
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=468982&postcount=41

ابتدا System.Management رو به References پروژه بیفزایید و سپس :
کد:


Imports System.Management

Private Sub GetHDDSerialNumber()

Dim searcher As ManagementObjectSearcher
Dim query1 As String = "SELECT * FROM Win32_DiskDrive"
Dim query2 As String = "SELECT * FROM Win32_PhysicalMedia"

searcher = New ManagementObjectSearcher(query1)
For Each wmi_HD As ManagementObject In searcher.Get()
If Not wmi_HD("Model") Is Nothing Then
MessageBox.Show(wmi_HD("Model").ToString())
End If
Next
searcher = New ManagementObjectSearcher(query2)
For Each wmi_HD As ManagementObject In searcher.Get()
If Not wmi_HD("SerialNumber") Is Nothing Then
MessageBox.Show(wmi_HD("SerialNumber").ToString())
End If
Next

End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=469007&postcount=43

کد:


System.Diagnostics.Process.Start("mspaint.exe")

چنانچه فایل اجرایی نیاز به آرگومان خط فرمان داشته باشد :
کد:


System.Diagnostics.Process.Start("mspaint.exe", "c:\Test.bmp")

مثال بالا تصویر Test را در msPaint باز میکند.

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=469011&postcount=44

کد:


Dim myString1 As String = "This is the first line of my string." + vbCrLf _
+ "This is the second line of my string." + vbCrLf + _
"This is the third line of the string." + vbCrLf

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=469017&postcount=45


'// Single-dimensional array (numbers).
Dim n1 As Integer() = {2, 4, 6, 8}
Dim n2() As Integer = {2, 4, 6, 8}

'// Single-dimensional array (strings).
Dim s1() As String = New String() {"John", "Paul", "Mary"}
Dim s3 As String() = {"John", "Paul", "Mary"}

'// Multidimensional array.
Dim n4 As Integer(,) = {{1, 2}, {3, 4}, {5, 6}}
Dim n6(,) As Integer = {{1, 2}, {3, 4}, {5, 6}}


' // Jagged array.
Dim n7 As Integer()() = {New Integer() {2, 4, 6}, New Integer() {1, 3, 5, 7, 9}}
Dim n9()() As Integer = {New Integer() {2, 4, 6}, New Integer() {1, 3, 5, 7, 9}}

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=469022&postcount=46
کد:


Private Function CreateBitmap() As Image

Dim flag As Bitmap = New System.Drawing.Bitmap(10, 10)
Dim x, y As Integer
For x = 0 To flag.Height
For y = 0 To flag.Width
flag.SetPixel(x, y, Color.White)
Next
Next

For x = 0 To flag.Height
flag.SetPixel(x, x, Color.Red)
Next
Return flag
End Function

[raravaice]

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
MessageBox.Show(sender.Text)
End Sub


و



Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim arg As New System.EventArgs
Form1_Load(Button1, arg)
End Sub

[bad_boy_2007]

منبع:http://barnamenevis.org/forum/showpost.php?p=467566&postcount=4


این کد را در کلاس مربوط به کنترل TextBox خود بنویسید :
کد:


Protected Overrides Function ProcessDialogKey(ByVal keyData As System.Windows.Forms.Keys) As Boolean

If keyData = Keys.Return Then
SendKeys.Send("{TAB}")
End If
Return MyBase.ProcessDialogKey(keyData)
End Functionو در مورد استفاده در کنترلهای استاندارد :
کد:


Private Sub TextBox1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
If e.KeyCode = Keys.Return Then
SendKeys.Send("{TAB}")
End If
End Sub



من هم از این کد تو فرمهام استفاده میکنم ولی یک مشکل دارم اونم اینه که اگه بخوام Shift + Tab رو بزنم چطور باید کار کنم ؟؟؟



Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
MessageBox.Show(sender.Text)
End Sub
و



Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim arg As New System.EventArgs
Form1_Load(Button1, arg)
End Sub



بجای این کد میتونید از کد زیر هم استفاده کنید که مختصر تره :


Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Form1_Load(New Object, New System.EventArgs)
End Sub

[ghafoori]

کد


'shift tab
SendKeys.Send("+{TAB}")
'ctrl tab
SendKeys.Send("^{TAB}")
'alt tab
SendKeys.Send("%{TAB}")

لطفا اشکالها و پیشنهاد ها را با پیام خصوصی ارسال کنید تا نظم تاپیک بهم نخورد

[amirsajjadi]

با سلام
سال نو رو به شما دوستان عزیز تبریک عرض میکنم
با اجازه از آقای غقوری
این پست در واقع کامل کننده ی پست قبلی (پست آقای غفوری) هست
------------------------------------------------------------------------------
در صورتی که بخواهید بدون فشردن یک کلید از کیبورد کاری کنید که یک کلید خاص فشرده بشه میتونید از این دستور به صورت زیر استفاده میکنید :
((دقت کنید که هیچ تفاوتی بین فشردن یک کلید رو کیبورد و دستور sendkeys وجود نداره))


SendKeys String[,wait]

String : رشته ای که در واقع همون نویسه هایی هست که باید به عنوان کلید ارسال بشن
Wait : پارامتری منطقی است. اگر روی False تنظیم بشه (پیش فرض) ، روال اجرا کننده دستور Sendkeys بلافاصله بعد از ارسال نویسه ها مجددا کنترل برنامه رو در دست میگیره و به کار خودش ادامه میده. اما اگه رو True تنظیم بشه سیستم تا پردازش کامل نویسه ها ، کنترل رو به روال اجرا کننده ی دستور Sendkeys باز پس نمیده

توجه کنید که برای ارسال نویسه های خاص (~ , { , } , % , ( , ) , - , + , ^) باید اونا رو داخل {} قرار بدیم
به عنوال مثال :

SendKyes "+ {+} 4 {*} 6

کلیدهای ویژه در دستور Sendkeys :

کلید TAB : معادل {TAB}
کلید UP ARROW : معادل {UP}
کلید F1 : معادل {F1}
کلید F2 : معادل {F2}
کلید F3 : معادل {F3}
کلید F4 : معادل {F4}
کلید F5 : معادل {F5}
کلید F6 : معادل {F6}
کلید F7 : معادل {F7}
کلید F8 : معادل {F8}
کلید F9 : معادل {F9}
کلید F10 : معادل {F10}
کلید F11 : معادل {F11}
کلید F12 : معادل {F12}
کلید F13 : معادل {F13}
کلید F14 : معادل {F14}
کلید F15 : معادل {F15}
کلید F16 : معادل {F16}
کلید BACKSPACE: معادل {BACKSPACE} یا {BS} یا {BKSP}
کلید BREAK : معادل {BREAK}
کلید CAPS LOCK : معادل {CAPSLOCK}
کلید DELETE یا DEL : معادل {DELETE} یا {DEL}
کلید DOWN ARROW : معادل {DOWN}
کلید END : معادل {END}
کلید ENTER : معادل {ENTER} یا {~}
کلید ESC : معادل {ESC}
کلید HELP : معادل {HELP}
کلید HOME : معادل {HOME}
کلید INS یا INSERT : معادل {INSERT} یا {INS}
کلید LEFT ARROW : معادل {LEFT}
کلید NUM LOCK : معادل {NUMLOCK}
کلید PAGE DOWN : معادل {PGDN}
کلید PAGE UP : معادل {PGUP}
کلید PRINT SCREEN : معادل {PRTSC}
کلید RIGHT ARROW : معادل {RIGHT}
کلید SCROLL LOCK : معادل {SCROLLLOCK}توجه کنید که تنها کلیدی که نمیتونیم اون رو به برنامه ها بفرستیم ، کلید Print Screen هست (شماره ی 34)
برای استفاده از کلید های Alt , Ctrl , Shift همون طور که آقای غفوری گفتند میتونید از معادل های زیر استفاده کنید

کلید Shift : معادل {+}
کلید Ctrl : معادل {^}
کلید Alt : معادل {%}به عنوان مثال :

Sendkeys "+(ES)"
یعنی فشردن کلید Shift به همراه کلید های E , S

Sendkeys "+ES"
یعنی فشرن کلید Shift به همراه E و پس از رها کردن ، فشردن کلید S است

توجه : اگه میخواین کلیدی رو چندین بار تکرار کنید میتونید از این الگو استفاده کنید :

SendKeys "{key num}"
که در اینجا key کلیدی است که میخواهید به برنامه بفرستید و num تعداد تکرار آن کلید هست
با تشکر

[raravaice]

If "Barnamenevis" Like "*name*" Then
Console.Write("Ok")
End If
'Result = Ok
If "Barnamenevis" Like "*evis" Then
Console.Write("Ok")
End If
'Result = Ok
If "Barnamenevis" Like "*Barna*" Then
Console.Write("Ok")
else
Console.Write("Err")
End If
'Result = Err

[bad_boy_2007]

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




PublicClass Form1
Inherits Windows.Forms.Form
FriendWithEvents PrintDocument1 AsNew System.Drawing.Printing.PrintDocument
FriendWithEvents TextBox1 AsNew System.Windows.Forms.TextBox
FriendWithEvents Button1 AsNew Windows.Forms.Button
PrivateSub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
PrintDocument1.Print()
EndSub
PrivateSub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
Dim pfont AsNew Font("Arial", 20)
e.Graphics.DrawString(TextBox1.Text, pfont, Brushes.AliceBlue, 0, 0)
Dim lmargin, Rmargin, Tmargin, Bmargin AsInteger
With PrintDocument1.DefaultPageSettings.Margins
lmargin = .Left
Rmargin = .Right
Tmargin = .Top
Bmargin = .Bottom
EndWith
Dim printWidth, PrintHeight AsInteger
With PrintDocument1.DefaultPageSettings.PaperSize
printWidth = .Width - lmargin - Rmargin
PrintHeight = .Height - Tmargin - Bmargin
EndWith
Dim r As Rectangle
r = New Rectangle(lmargin, Tmargin, printWidth, PrintHeight)
e.Graphics.DrawRectangle(Pens.Black, r)
EndSub
PrivateSub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesMyBase.Load
TextBox1.Left = 0
TextBox1.Width = Me.Width
TextBox1.Top = 0
Button1.Top = TextBox1.Top + TextBox1.Height + 10
Button1.Left = 0
Button1.Width = Me.Width
Button1.Text = "پ©یë¢"
Me.Controls.Add(Button1)
Me.Controls.Add(TextBox1)
EndSub
EndClass

[bad_boy_2007]

با این کد میتونید یک فرم رو مستقیما به پرینتر بفرستید تو 2008 کار میکنه ولی تو 2005 یا 2003 رو تست نکردم





PublicClass Form1
FriendWithEvents TXTBox1 AsNew TextBox
FriendWithEvents PrintForm1 As Microsoft.VisualBasic.PowerPacks.Printing.PrintFor m
FriendWithEvents BTN AsNew Button
PrivateSub btn_Click(ByVal a AsObject, ByVal b As System.EventArgs) Handles BTN.Click
PrintForm1.Print()
EndSub


PrivateSub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesMyBase.Load
Me.PrintForm1 = New Microsoft.VisualBasic.PowerPacks.Printing.PrintFor m(Me.components)
Me.PrintForm1.DocumentName = "document"


Me.PrintForm1.Form = Me


Me.PrintForm1.PrintAction = System.Drawing.Printing.PrintAction.PrintToPrinter
Me.PrintForm1.PrintFileName = Nothing


'Design New Text Box To Form


TXTBox1.Multiline = True


TXTBox1.Left = 10
TXTBox1.Top = 10
TXTBox1.Height = Me.Height - 20
TXTBox1.Width = Me.Width - 20
TXTBox1.Text = "This is Sample Code For Test Print Form " & vbCrLf & "Designer : -_- MHM (Ict_Boy_2005@yahoo.com)" & _
vbCrLf & "Publisher WWW.BarnameNevis.ORG"


Me.Controls.Add(TXTBox1)
'Design new Button to form


Me.Height += 100
BTN.Left = 0
BTN.Width = Me.Width
BTN.Top = TXTBox1.Top + TXTBox1.Height
Me.Controls.Add(BTN)
BTN.Height = 100
BTN.Text = "Do Print"


EndSub
EndClass

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469032&postcount=47


مثال: یک تکست باکس به فرم اضافه میکند:
کد:


Dim myText As TextBox = New TextBox()
myText.Location = New Point(25, 25)
Me.Controls.Add(myText)

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469293&postcount=49


ابتدا System.Management رو به References پروژه بیفزایید و سپس :
کد:


Imports System.Management

Private Sub GetMACAddress()

Dim searcher As ManagementObjectSearcher
Dim qry As String = "select * FROM Win32_NetworkAdapter"
searcher = New ManagementObjectSearcher(qry)
For Each wmi_HD As ManagementObject In searcher.Get()
If Not wmi_HD("MacAddress") Is Nothing Then
MessageBox.Show(wmi_HD("MacAddress").ToString())
End If
Next
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469320&postcount=50
کد:


' //Open with the 'Windows picture and fax viewer':
System.Diagnostics.Process.Start("C:\Windows\system32\rundll32.exe ", _
"C:\Windows\system32\shimgvw.dll,ImageView_Fullscre en " + "filename")

اینهم که آسونه اما شاید واسه دوستانی مفید باشه :
کد:

'//Open with the 'Microsoft Paint':
System.Diagnostics.Process.Start("C:\Windows\system32\MSPaint.exe ", " filename")

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469373&postcount=51

مثال - برای آخرین آیتم :
کد:



'// Set the TopIndex property of the ListBox to ensure the
'// most recently added items are visible.
ListBox1.TopIndex = ListBox1.Items.Count - 1
ListBox1.SelectedIndex = ListBox1.Items.Count - 1

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469375&postcount=52


کد:


Private dragging As Boolean
Private pointClicked As Point

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
If (e.Button = MouseButtons.Left) Then

'// Turn drag mode on and store the point clicked.
dragging = True
pointClicked = New Point(e.X, e.Y)
Else

dragging = False
End If
End Sub

Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If dragging Then

Dim pointMoveTo As Point
'// Find the current mouse position in screen coordinates.
pointMoveTo = Me.PointToScreen(New Point(e.X, e.Y))
'// Compensate for the position the control was clicked.
pointMoveTo.Offset(-pointClicked.X, -pointClicked.Y)
'// Move the form.
Me.Location = pointMoveTo
End If
End Sub

Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
dragging = False
End Sub

[ghafoori]

کد:

ابتدا خاصیت allow drop را true کنید


Private Sub TextBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles TextBox1.MouseDown
TextBox1.SelectAll()
TextBox1.DoDragDrop(TextBox1.Text, DragDropEffects.Copy)
End Sub

Private Sub TextBox2_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles TextBox2.DragEnter
If (e.Data.GetDataPresent(DataFormats.Text)) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub

Private Sub TextBox2_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles TextBox2.DragDrop
TextBox2.Text = CType(e.Data.GetData(DataFormats.Text), String)
End Sub

[ghafoori]

کد:

http://barnamenevis.org/forum/showpost.php?p=469378&postcount=54


Private Function CaptureScreen() As Image

Dim screen As Bitmap = New Bitmap(Windows.Forms.Screen.PrimaryScreen.Bounds.W idth, Windows.Forms.Screen.PrimaryScreen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(screen)
Using (g)
g.CopyFromScreen(0, 0, 0, 0, screen.Size)
End Using
Return screen
End Function

[ghafoori]

کد:
http://barnamenevis.org/forum/showpost.php?p=469379&postcount=55


'// Play a beep with default frequency
'// and duration (800 and 200, respectively)
Console.Beep()

'/ Play a beep with frequency as 200 and duration as 300
Console.Beep(200, 300)

Media.SystemSounds.Asterisk.Play()

Media.SystemSounds.Hand.Play()

Media.SystemSounds.Exclamation.Play()

Media.SystemSounds.Beep.Play()

Media.SystemSounds.Question.Play()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469385&postcount=56


Imports System.Media

Dim player As Media.SoundPlayer = New SoundPlayer()
Dim path As String = "C:\windows\media\ding.wav"
player.SoundLocation = path ' //Set the path
player.Play() ' //play it

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469387&postcount=57


Imports System.Drawing.Printing

Private Sub GetInstalledPrinters()

For Each printerName As String In PrinterSettings.InstalledPrinters
MessageBox.Show(printerName)
Next

End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469390&postcount=58



' // Create a TimeSpan representing 2.5 days.
Dim timespan1 As TimeSpan = New TimeSpan(2, 12, 0, 0)

'// Create a TimeSpan representing 4.5 days.
Dim timespan2 As TimeSpan = New TimeSpan(4, 12, 0, 0)

'// Create a TimeSpan representing 1 week.
Dim oneWeek As TimeSpan = timespan1 + timespan2

'// Create a DateTime with the current date and time.
Dim now As DateTime = DateTime.Now

'// Create a DateTime representing 1 week ago.
Dim past As DateTime = now - oneWeek

'// Create a DateTime representing 1 week in the future.
Dim future As DateTime = now + oneWeek




مثال :‌ پیدا کردن اختلاف تعداد روزهای بین دو تاریخ :
کد:


Dim dateFrom As DateTime = DateTime.Parse("10/10/2007")
Dim dateTo As DateTime = DateTime.Parse("11/12/2007")
Dim ts As TimeSpan = dateTo - dateFrom
Dim days As Integer = ts.Days

و یا :
کد:


Dim dtFirst As DateTime = New DateTime(2007, 10, 10)
Dim dtSecond As DateTime = New DateTime(2007, 11, 12)
Dim diffResult As TimeSpan = dtSecond.Subtract(dtFirst)

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469393&postcount=59


Imports System.IO

Dim file As FileInfo = New FileInfo("C:\test.txt")
file.Attributes = file.Attributes Or FileAttributes.ReadOnly Or FileAttributes.Hidden

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469394&postcount=60


Imports System.IO


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
MessageBox.Show(CalculateDirectorySize(New DirectoryInfo("C:\WINDOWS\System32"), True).ToString())

End Sub

Public Function CalculateDirectorySize(ByVal directory As DirectoryInfo, ByVal includeSubdirectories As Boolean) As Long

Dim totalSize As Long = 0
'// Examine all contained files.
Dim files() As FileInfo = directory.GetFiles()
For Each file As FileInfo In files

totalSize += file.Length
Next
' // Examine all contained directories.

If includeSubdirectories Then

Dim dirs() As DirectoryInfo = directory.GetDirectories()
For Each dir As DirectoryInfo In dirs
totalSize += CalculateDirectorySize(dir, True)
Next
End If
Return totalSize
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472144&postcount=91


<DllImport("user32.dll")> _
Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("gdi32.dll")> _
Shared Function GetPixel(ByVal hDC As IntPtr, ByVal x As Integer, ByVal y As Integer) As Integer
End Function
<DllImport("gdi32.dll")> _
Shared Function SetPixel(ByVal hDC As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal color As Integer) As Integer
End Function
Public Shared Function GetPixel(ByVal control As Control, ByVal x As Integer, ByVal y As Integer) As Color

Dim color As Color = color.Empty
If Not control Is Nothing Then

Dim hDC As IntPtr = GetDC(control.Handle)
Dim colorRef As IntPtr = GetPixel(hDC, x, y)
color = color.FromArgb((colorRef.ToInt32 & &HFF) Or (colorRef.ToInt32 & &HFF00 >> 8) Or (colorRef.ToInt32 & &HFF0000 >> 16))
ReleaseDC(control.Handle, hDC)
End If
Return color
End Function
Public Shared Sub SetPixel(ByVal control As Control, ByVal x As Integer, ByVal y As Integer, ByVal color As Color)

If Not control Is Nothing Then

Dim hDC As IntPtr = GetDC(control.Handle)
Dim argb As Integer = color.ToArgb()
Dim colorRef As Integer = ((argb & &HFF0000) >> 16) Or (argb & &HFF00) Or ((argb & &HFF) << 16)
SetPixel(hDC, x, y, colorRef)
ReleaseDC(control.Handle, hDC)
End If
End Sub

[ghafoori]

منبع:http://barnamenevis.org/forum/showpost.php?p=467566&postcount=4


این کد را در کلاس مربوط به کنترل TextBox خود بنویسید :
کد:


Protected Overrides Function ProcessDialogKey(ByVal keyData As System.Windows.Forms.Keys) As Boolean

If keyData = Keys.Return Then
SendKeys.Send("{TAB}")
End If
Return MyBase.ProcessDialogKey(keyData)
End Function
و در مورد استفاده در کنترلهای استاندارد :
کد:


Private Sub TextBox1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
If e.KeyCode = Keys.Return Then
SendKeys.Send("{TAB}")
End If
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469396&postcount=61


Imports System.IO

Private Sub CreateTextFile()
Dim fs As FileStream = New FileStream("C:\test.txt", FileMode.Create)
Dim w As StreamWriter = New StreamWriter(fs, Encoding.UTF8)
Using (fs)
Using (w)
w.WriteLine(124.23)
w.WriteLine("Salaam!")
w.WriteLine("!")
End Using
End Using
End Sub


Private Function ReadFromTextFile() As String

Dim sb As StringBuilder = New StringBuilder()
Dim fs As FileStream = New FileStream("C:\test.txt", FileMode.Open)
Dim r As StreamReader = New StreamReader(fs, Encoding.UTF8)
Using (fs)
Using (r)
sb.AppendLine(r.ReadLine())
sb.AppendLine(r.ReadLine())
sb.AppendLine(r.ReadLine())
End Using
End Using
Return sb.ToString()
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469397&postcount=62


Dim filename As String = "..\..\myfile.txt"
Dim fullPath As String = "c:\Temp"
Dim filename As String = Path.GetFileName(filename)
Dim fullPath As String = Path.Combine(fullPath, filename)
'// (fullPath is now "c:\Temp\myfile.txt")

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469398&postcount=63


Dim randomFileName As String = System.IO.Path.GetRandomFileName()

و برای ایجاد نام منحصر بفرد برای فایلهای موقت :
کد:


Dim tfile As String = Path.GetTempFileName()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469410&postcount=64


System.Diagnostics.Process.Start("iexplore.exe", "www.barnamenevis.org")

و برای مثال در فایرفاکس :
کد:


System.Diagnostics.Process.Start("C:\Program Files\Mozilla Firefox\FireFox.exe", "www.barnamenevis.org")

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469478&postcount=65


Public Enum Days
Sat = 1
Sun
Mon
Tue
Wed
Thu
Fri
End Enum

Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

Dim x As Integer = Days.Mon
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=469501&postcount=66


Public Enum Days
Sat = 1
Sun
Mon
Tue
Wed
Thu
Fri
End Enum

Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

Dim t As System.Type = GetType(Days)
For Each s As String In Days.GetNames(t)

ListBox1.Items.Add(s)
Next
End Sub

[ghafoori]

عادت کردن به میانبرها میتواند سرعت کدنویسی شما را افزایش دهد :

http://barnamenevis.org/forum/showpost.php?p=470176&postcount=67

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=470316&postcount=68

مثال :‌ تغییر رنگ پشت زمینه ی تمامی فرمهای باز در یک برنامه :


For Each frm As Form In Application.OpenForms
frm.BackColor = Color.Fuchsia
Next

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=470320&postcount=69


Application.Restart()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=470328&postcount=70

برنامه تمامی message های درون message queue فعلی (از قبیل رخدادها و ...) را پردازش میکند.
کد:


Application.DoEvents()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=470337&postcount=71

این تغییرات را در کلاس مربوط به StartUp برنامه اعمال کنید :
کد:


Imports System.Diagnostics

Class Program

<STAThread()> _
Shared Sub Main()

If IsPrevInstance() Then
Return
End If
Application.EnableVisualStyles()
Application.SetCompatibleTextRenderingDefault(Fals e)
Application.Run(New Form1())
End Sub

Private Shared Function IsPrevInstance() As Boolean
Dim processName As String = Process.GetCurrentProcess().ProcessName
Dim instances() As Process = Process.GetProcessesByName(processName)
If instances.Length > 1 Then
Return True
Else
Return False
End If
End Function

End Class

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471091&postcount=78


Imports System.Net.Mail

Class SendEmail

Public Shared Sub SendMessage(ByVal subject As String, ByVal messageBody As String, ByVal fromAddress As String, ByVal toAddress As String, ByVal ccAddress As String)

Dim message As MailMessage = New MailMessage()
Dim client As SmtpClient = New SmtpClient()
message.From = New MailAddress(fromAddress)

'// Allow multiple "To" addresses to be separated by a semi-colon
If toAddress.Trim().Length > 0 Then
For Each addr As String In toAddress.Split(";")
message.To.Add(New MailAddress(addr))
Next
End If

'// Allow multiple "Cc" addresses to be separated by a semi-colon
If ccAddress.Trim().Length > 0 Then
For Each addr As String In ccAddress.Split(";")
message.CC.Add(New MailAddress(addr))
Next
End If

message.Subject = subject
message.Body = messageBody
client.Host = "YourMailServer"
client.Send(message)
End Sub
End Class

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471135&postcount=79

برای این عمل به یک رویداد (MouseMove) برای pictureBox منبع نیاز دارید و دو رویداد (DragDrop) و ( DragEnter) از pictureBox مقصد. که نحوه کد کردن آن ها به شکل زیر است


Private Sub PictureBox1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = MouseButtons.Left And Not PictureBox1.Image Is Nothing Then
PictureBox1.DoDragDrop(PictureBox1.Image, DragDropEffects.All)
End If
End Sub

Private Sub PictureBox2_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles PictureBox2.DragEnter
If e.Data.GetDataPresent(DataFormats.Bitmap) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub

Private Sub PictureBox2_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles PictureBox2.DragDrop
If e.Data.GetDataPresent(DataFormats.Bitmap) Then

PictureBox1.Image = CType(e.Data.GetData(DataFormats.Bitmap), Image)
End If

End Sub

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

[ghafoori]

به لینک زیر مراجعه کنید

http://barnamenevis.org/forum/showpost.php?p=471143&postcount=80

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471151&postcount=81

توسط متد زیر می توانید هر عکسی را به حالت سیاه و سفید یا همون grayScale در بیارین

کد:


Imports System.Drawing.Imaging


Public Function GrayScaleImage(ByVal graph As Graphics, ByVal img As Image, ByVal left As Integer, ByVal top As Integer) As Image


Dim colorMix As ColorMatrix = New ColorMatrix()
colorMix.Matrix00 = 1 / 3.0F
colorMix.Matrix01 = 1 / 3.0F
colorMix.Matrix02 = 1 / 3.0F
colorMix.Matrix10 = 1 / 3.0F
colorMix.Matrix11 = 1 / 3.0F
colorMix.Matrix12 = 1 / 3.0F
colorMix.Matrix20 = 1 / 3.0F
colorMix.Matrix21 = 1 / 3.0F
colorMix.Matrix22 = 1 / 3.0F

Dim imgAttrib As ImageAttributes = New ImageAttributes()
imgAttrib.SetColorMatrix(colorMix)


graph.DrawImage(img, New Rectangle(left, top, img.Width, img.Height), 0, 0, img.Width, img.Height, GraphicsUnit.Pixel, imgAttrib)
Dim bmp As Bitmap = New Bitmap(img)
Return bmp


End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471160&postcount=82


این کلاس مختص دات نت 3.5 (به بعد) است و جهت استفاده باید System.Core رو نیز به References پروژه ی خود بیافزایید.

مثال - بدست آوردن تاریخ و زمان فعلی در توکیو :
کد:


Dim tzSource As TimeZoneInfo = TimeZoneInfo.Local
Dim tzDestination As TimeZoneInfo = TimeZoneInfo.FindSystemTimeZoneById("Tokyo Standard Time")
Dim sourceTime As String = TimeZoneInfo.ConvertTime(DateTime.Now, tzSource, tzDestination).ToShortTimeString()
MessageBox.Show(sourceTime)

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471161&postcount=83

این روش مختص دات نت 3.5 (به بعد) است.

کد:


Imports System.Collections.ObjectModel

بدست آوردن Id و DisplayName نواحی :
کد:


Dim zones As ReadOnlyCollection(Of TimeZoneInfo) = TimeZoneInfo.GetSystemTimeZones()
For Each zone As TimeZoneInfo In zones
ListBox1.Items.Add(zone.Id)
listBox2.Items.Add(zone.DisplayName)
Next

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471273&postcount=84


Imports System.IO

'//To create a directory
Directory.CreateDirectory("C:\MyNewDir")

'//To move a directory
Directory.Move("C:\MyNewDir", "C:\MyMovedDir")

'//To delete a directory
Directory.Delete("C:\MyMovedDir")

'//To Delete a directory recursively
Directory.Delete("C:\MyNewDir", True)

'//To Delete a File
File.Delete("C:\MyFile.Txt")

'//To Move a File
File.Move("C:\MyFile.Txt", "C:\MyOtherDir\MyFile.Txt")

'//To Copy a file
File.Copy("C:\MyFile.Txt", "C:\MyOtherDir\MyFile.Txt")

'//To copy to a different file name is also possible
File.Copy("C:\MyFile.Txt", "C:\MyOtherDir\MyNewFileName.Txt")

'//To get information about a file, like the length
'//You can also get the extension, directory, LastAccessedtime,
'//LastModifiedTime, wether the file exists or not, the creation date,
'//attributes of the file etc, from the FileInfo class
Dim FI As FileInfo = New FileInfo("C:\MyFile.Txt")
Console.WriteLine("File size of MyFile.Txt: {0}", FI.Length)

'//copy example
Dim DateTemp As String = DateTime.Now.ToString
File.Copy("P:\PRD\Products\AHM\prod.CD\Database\data.mdb", "P:\PRD\Products\AHM\prod.CD\Database\" + DateTemp + "-data.mdb")

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471343&postcount=86


فایلها را در مسیرC:\CopiedFolder کپی میکند :
کد:



Imports System.IO


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Dim fbd As FolderBrowserDialog = New FolderBrowserDialog()
fbd.Description = "Find Folder to Copy."
If fbd.ShowDialog() = DialogResult.OK Then

Dim files() As String = Directory.GetFiles(fbd.SelectedPath)
Directory.CreateDirectory("C:\CopiedFolder")
Dim i As Integer
For i = 0 To files.Length

Dim tmpFileExt As String = Path.GetExtension(files(i))
Dim tmpFileName As String = Path.GetFileNameWithoutExtension(files(i))
File.Copy(files(i), "C:\CopiedFolder\" + tmpFileName + tmpFileExt, True)
Next
End If
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=471479&postcount=88


Imports System.IO


Sub CopyDirectory(ByVal source As DirectoryInfo, ByVal destination As DirectoryInfo)

If Not destination.Exists Then
destination.Create()
End If
'// Copy all files.
Dim files() As FileInfo = source.GetFiles()
For Each file As FileInfo In files
file.CopyTo(Path.Combine(destination.FullName, file.Name))
Next
'// Process subdirectories.
Dim dirs() As DirectoryInfo = source.GetDirectories()
For Each dir As DirectoryInfo In dirs

' // Get destination directory.
Dim destinationDir As String = Path.Combine(destination.FullName, dir.Name)
'// Call CopyDirectory() recursively.
CopyDirectory(dir, New DirectoryInfo(destinationDir))
Next

End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472244&postcount=93


Imports Microsoft.Win32


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
' // Create SubKey
Registry.LocalMachine.CreateSubKey("Software\Sinpin", RegistryKeyPermissionCheck.ReadWriteSubTree)

'//Create Key and Set Value
Dim reg As RegistryKey = Registry.LocalMachine.OpenSubKey("Software\Sinpin", True)
reg.SetValue("DWord", "1", RegistryValueKind.DWord)
reg.SetValue("ExpandString", "1", RegistryValueKind.ExpandString)
reg.SetValue("QWord", "1", RegistryValueKind.QWord)
reg.SetValue("String", "1", RegistryValueKind.String)
reg.SetValue("Unknown", "1", RegistryValueKind.Unknown)

'// Delete Key
reg.DeleteValue("DWOrd")

'// Delete SubKey
Registry.LocalMachine.DeleteSubKey("Software\Sinpin")

'// Read Key Value
Dim val As String = reg.GetValue("QWord").ToString()

'// Retrieve All Keys
For Each s As String In reg.GetValueNames()
MessageBox.Show(s)
Next

End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472253&postcount=94


Imports System.Drawing.Drawing2D


Private Shared Function resizeImage(ByVal imgToResize As Image, ByVal size As Size) As Image

Dim sourceWidth As Integer = imgToResize.Width
Dim sourceHeight As Integer = imgToResize.Height

Dim nPercent As Decimal = 0
Dim nPercentW As Decimal = 0
Dim nPercentH As Decimal = 0

nPercentW = (size.Width / sourceWidth)
nPercentH = size.Height / sourceHeight

If nPercentH < nPercentW Then
nPercent = nPercentH
Else
nPercent = nPercentW
End If
Dim destWidth As Integer = (sourceWidth * nPercent)
Dim destHeight As Integer = (sourceHeight * nPercent)

Dim b As Bitmap = New Bitmap(destWidth, destHeight)
Dim g As Graphics = Graphics.FromImage(b)
g.InterpolationMode = InterpolationMode.HighQualityBicubic

g.DrawImage(imgToResize, 0, 0, destWidth, destHeight)
g.Dispose()

Return b
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472259&postcount=95




Private Shared Function cropImage(ByVal img As Image, ByVal cropArea As Rectangle) As Image

Dim bmpImage As Bitmap = New Bitmap(img)
Dim bmpCrop As Bitmap = bmpImage.Clone(cropArea, bmpImage.PixelFormat)
Return (bmpCrop)
End Function

مثال از نحوه ی استفاده :
کد:


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
PictureBox2.Image = cropImage(PictureBox1.Image, New Rectangle(10, 10, 100, 100))
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472269&postcount=96


Imports System.Drawing.Imaging


Public Shared Function MakeGrayscale(ByVal original As Bitmap) As Bitmap

' //create a blank bitmap the same size as original
Dim newBitmap As Bitmap = New Bitmap(original.Width, original.Height)

'//get a graphics object from the new image
Dim g As Graphics = Graphics.FromImage(newBitmap)

'//create the grayscale ColorMatrix
Dim array()() As Single = New Single()() {New Single() {0.3F, 0.3F, 0.3F, 0, 0}, _
New Single() {0.59F, 0.59F, 0.59F, 0, 0}, _
New Single() {0.11F, 0.11F, 0.11F, 0, 0}, _
New Single() {0, 0, 0, 1, 0}, _
New Single() {0, 0, 0, 0, 1}}
Dim colorMatrix As ColorMatrix = New ColorMatrix(array)

'//create some image attributes
Dim attributes As ImageAttributes = New ImageAttributes()

'//set the color matrix attribute
attributes.SetColorMatrix(colorMatrix)

'//draw the original image on the new image
'//using the grayscale color matrix
g.DrawImage(original, New Rectangle(0, 0, original.Width, _
original.Height), 0, 0, original.Width, _
original.Height, GraphicsUnit.Pixel, attributes)

'//dispose the Graphics object
g.Dispose()
Return newBitmap
End Function

Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Dim b As Bitmap = PictureBox1.Image
PictureBox2.Image = MakeGrayscale(b)
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472274&postcount=97


Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Dim day As Integer = 3

Dim d As DaysOfWeek = NumToEnum(Of DaysOfWeek)(day)
MsgBox(d.ToString)
End Sub

Public Function NumToEnum(Of T)(ByVal number As Integer) As T

Return [Enum].ToObject(GetType(T), number)
End Function

Public Enum DaysOfWeek
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday
Sunday
End Enum

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472277&postcount=98


Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim d As DaysOfWeek = StringToEnum(Of DaysOfWeek)("Monday")
'//d is now DaysOfWeek.Monday
MsgBox(d.ToString)

If [Enum].IsDefined(GetType(DaysOfWeek), "Katillsday") Then
StringToEnum(Of DaysOfWeek)("Katillsday")
End If
End Sub

Public Shared Function StringToEnum(Of T)(ByVal name As String) As t

Return [Enum].Parse(GetType(T), name)
End Function

Public Enum DaysOfWeek
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday
Sunday
End Enum

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472281&postcount=100


Private Function rotateImage(ByVal b As Bitmap, ByVal angle As Single) As Bitmap

' //create a new empty bitmap to hold rotated image
Dim returnBitmap As Bitmap = New Bitmap(b.Width, b.Height)
'//make a graphics object from the empty bitmap
Dim g As Graphics = Graphics.FromImage(returnBitmap)
'//move rotation point to center of image
g.TranslateTransform(b.Width / 2, b.Height / 2)
'//rotate
g.RotateTransform(angle)
'//move image back
g.TranslateTransform(-b.Width / 2, -b.Height / 2)
'//draw passed in image onto graphics object
g.DrawImage(b, New Point(0, 0))
Return returnBitmap
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim b As Bitmap = PictureBox1.Image
PictureBox2.Image = rotateImage(b, 60)
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472295&postcount=101

با استفاده از کلمه کلیدی params مانند نمونه زیر :
کد:


Public Function Add(ByVal list() As Integer) As Integer
Dim sum As Integer = 0
For Each i As Integer In list
sum += i
Next
Return sum
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Dim ans2 As Integer = Add(New Integer() {1, 2, 3, 4, 5, 6, 7, 8, 9, 10})

End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472315&postcount=102


Imports System.IO
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary


Public Sub SerializeObject(ByVal filename As String, ByVal o As Object)

Dim stream As Stream = File.Open(filename, FileMode.Create)
Dim bFormatter As BinaryFormatter = New BinaryFormatter()
bFormatter.Serialize(stream, o)
stream.Close()
End Sub

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472343&postcount=105

برای Serialize کردن یک object در فایل XML می تونین از این کد استفاده کنین:
کد:


Imports System.Xml.Serialization

Dim xmSer As XmlSerializer = New XmlSerializer(GetType(Person))
Dim st As FileStream = New FileStream("C:\Test.xml", FileMode.OpenOrCreate)
Dim p As Person = New Person("Ali Rezaei", 44)
xmSer.Serialize(st, p)
st.Close()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472347&postcount=106


Imports System.Xml.Serialization

Dim xmSer As XmlSerializer = New XmlSerializer(GetType(Person))
Dim st As FileStream = New FileStream("C:\Test.xml", FileMode.Open)
Dim p As Person = xmSer.Deserialize(st)
st.Close()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472352&postcount=107

برای Serialize کردن object تون توی فایل Soap می تونین از این کد استفاده کنین.
دقت کنین که باید System.Runtime.Serialization.Formatters.Soap رو Add Reference و Imports کنین.

کد:


Imports System.Runtime.Serialization.Formatters.Soap

Dim soap As SoapFormatter = New SoapFormatter()
Dim st As FileStream = New FileStream("C:\Test.soap", FileMode.OpenOrCreate)
Person(p = New Person("Ali Rezaei", 33))
soap.Serialize(st, p)
st.Close()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472353&postcount=108

برای بازیابی شیء تون از یک فایل SOAP می تونین از این کد استفاده کنین:
کد:


Dim soap As SoapFormatter = New SoapFormatter()
Dim st As FileStream = New FileStream("C:\Test.soap", FileMode.Open)
p = soap.Deserialize(st)
st.Close()

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472382&postcount=109


Class newClass

Private number As Integer
Public Sub New(ByVal _number As Integer)
Me.number = _number
End Sub

Public Overloads Shared Operator +(ByVal c1 As newClass, ByVal c2 As newClass) As newClass
Return New newClass(c1.number + c2.number)
End Operator
End Class

تعریف یک Operator overloading همیشه باید بصورت shared و Public باشد و مقدار برگشتی آن نیز نمیتواند nothing باشد.

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472611&postcount=111

ابتدا System.Management رو به References پروژه بیفزایید و سپس :
کد:


Imports System.Management

Public Shared Function GetCPUId() As String

Dim cpuInfo As String = String.Empty
'//create an instance of the Managemnet class with the
'//Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol
If cpuInfo = String.Empty Then

'// only return cpuInfo from first CPU
cpuInfo = obj.Properties("ProcessorId").Value.ToString()
End If
Next
Return cpuInfo
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472615&postcount=112


Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Xml.Serialization


Public Function DeSerializeObject(ByVal filename As String) As Object

Dim o As Object
Dim stream As Stream = File.Open(filename, FileMode.Open)
Dim bFormatter As BinaryFormatter = New BinaryFormatter()
o = bFormatter.Deserialize(stream)
stream.Close()
Return o
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472619&postcount=113

ابتدا System.Management رو به References پروژه بیفزایید و سپس :
کد:


Imports System.Management


Public Function GetCPUManufacturer() As String

Dim cpuMan As String = String.Empty
'//create an instance of the Managemnet class with the
'//Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol

If cpuMan = String.Empty Then

' // only return manufacturer from first CPU
cpuMan = obj.Properties("Manufacturer").Value.ToString()
End If
Next
Return cpuMan
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472621&postcount=114


Imports System.Management

Public Function GetHDDFreeSpace(ByVal drive As String) As Double

' //check to see if the user provided a drive letter
' //if not default it to "C"
If drive = "" Or drive Is Nothing Then

drive = "C"
End If
'//create our ManagementObject, passing it the drive letter to the
'//DevideID using WQL
Dim disk As ManagementObject = New ManagementObject("Win32_LogicalDisk.DeviceID=""" + drive + ":\""")
'//bind our management object
disk.Get()
'//return the free space amount
Return Convert.ToDouble(disk("FreeSpace"))
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472622&postcount=115

ابتدا System.Management رو به References پروژه بیفزایید و سپس :
کد:


Imports System.Management

Public Function getHDDSize(ByVal drive As String) As Double

' //check to see if the user provided a drive letter
' //if not default it to "C"
If drive = "" Or drive Is Nothing Then

drive = "C"
End If
'//create our ManagementObject, passing it the drive letter to the
'//DevideID using WQL
Dim disk As ManagementObject = New ManagementObject("Win32_LogicalDisk.DeviceID=""" + drive + ":\""")
'//bind our management object
disk.Get()
'//return the HDD's initial size
Return Convert.ToDouble(disk("Size"))
End Function

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472639&postcount=116

آبجکتهای string در دات نت immutable (غیرقابل تغییر) هستند :‌به این معنا که پس از مقدار گرفتن، دیگر قابل تغییر نیستند.

به مثال زیر دقت کنید :
کد:


Dim temp As String = "a"
temp = temp + "b"
temp += "c"
temp += "d"

در این مثال ابتدا یک آبجکت از نوع string میسازید، اما در خطوط بعدی با هر بار تغییر مقدار آن؛ آبجکتهای قدیمی فراموش و یک آبجکت جدید از نوع string - با مقدار جدید - ساخته میشود.
به این ترتیب میشه انتظار داشت که کد زیر چه سربار وحشتناکی روی منابع سیستم میتونه داشته باشه :
کد:


Dim s2 As String = New String("x", Int32.Parse(args(0)))
Dim loops As Integer = Int32.Parse(args(1))
Dim j, i As Integer
For j = 0 To 10000000
Dim s As String = ""
For i = loops To 0 Step -1
s += s2
Next
Next

بصورت کلی در حالتیکه اعمال تغییرات زیاد روی رشته ها نیاز باشد بهتر است آبجکتی از کلاس StringBuilder ساخته و با خاصیت Append آن کار کنیم.

مثال - پیاده سازی همان کد قبلی :
کد:


Dim s2 As String = New String("x", Int32.Parse(args(0)))
Dim loops As Integer = Int32.Parse(args(1))
Dim i, j As Integer
For j = 0 To 10000000
Dim sb As StringBuilder = New StringBuilder()
For i = loops To 0 Step -1
sb.Append(s2)
Next
sb.ToString()
Next

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472644&postcount=117

با فرض داشتن کلاسی مانند :
کد:



Public Class Person
Public Sub New(ByVal _firstName As String, ByVal _lastName As String)

Me.FirstName = _firstName
Me.lastName = _lastName
End Sub
Private _firstName As String
Public Property FirstName() As String
Get
Return _firstName
End Get

Set(ByVal value As String)
_firstName = value
End Set
End Property
Private _lastName As String
Public Property LastName() As String
Get
Return _lastName
End Get
Set(ByVal value As String)
_lastName = value
End Set
End Property
End Class


میتونیم بنویسیم :
کد:


Dim persons As List(Of Person) = New List(Of Person)
persons.Add(New Person("ali", "ahmadi"))
persons.Add(New Person("maryam", "hosseini"))

[ghafoori]

http://barnamenevis.org/forum/showpost.php?p=472866&postcount=120

کلاس مورد نظر باید اینترفیس IComparable رو پیاده سازی کند. (این اینترفیس تنها یک متود CompareTo دارد)
به نحوه ی پیاده سازی متود CompareTo دقت کنید :
کد:


Public Class Person
Implements IComparable

Private _firstname As String
Public Property Firstname() As String
Get
Return _firstname
End Get
Set(ByVal value As String)
_firstname = value
End Set

End Property

Private _lastname As String
Public Property Lastname() As String
Get
Return _lastname
End Get
Set(ByVal value As String)
_lastname = value
End Set

End Property

Private _age As Integer
Public Property Age() As Integer
Get
Return _age
End Get
Set(ByVal value As Integer)
_age = value
End Set

End Property

Public Sub New(ByVal firstname As String, ByVal lastname As String, ByVal age As Integer)

_firstname = firstname
_lastname = lastname
_age = age
End Sub

Public Function CompareTo(ByVal obj As Object) As Integer Implements IComparable.CompareTo

If obj.GetType Is GetType(Person) Then

Dim p2 As Person = obj
Return _firstname.CompareTo(p2.Firstname)
Else
Throw New ArgumentException("Object is not a Person.")
End If
End Function


Public Overrides Function ToString() As String

Return String.Format("{0} {1}, Age = {2}", _firstname, _lastname, _age.ToString())
End Function
End Class

مثال - Sort کردن افراد از روی اسم کوچک (استفاده از کلاس بالا) :
کد:


Dim persons As List(Of Person) = New List(Of Person)()
persons.Add(New Person("Behrouz", "Rad", 30))
persons.Add(New Person("Omid", "Mottaghi Rad", 31))
persons.Add(New Person("Mehdi", "Keramati", 32))
persons.Add(New Person("Ali", "Keshavarz", 33))
persons.Add(New Person("Mohammad", "Heshemian", 34))
persons.Add(New Person("Farhad", "XXX", 35))

'//Before Sorting
ListBox1.Items.AddRange(persons.ToArray())

'//ُSorting List
persons.Sort()

'//Sorted List
listBox2.Items.AddRange(persons.ToArray())

[bad_boy_2007]

حتما تا الان برنامه ای واسه نوشتن داشتید که در اون مانده حساب اشخاص نمایش داده میشه و تمایل داشتید که بجای مثلا -230 برنامه تون اطلاعات رو در دیتاگرید بصورت "بدهکار230" یا همینطور در مورد بستانکار و بی حساب نشون بده ، یک راه برای انجام این کار اینه که یک دستور Select بنویسید (که همه باهاش آشنایی دارید) ولی راه ساده تری هم هست ، کافیه روی دیتاگرید راست کلیک کنید و پس از انتخاب فیلد حساب ، در بخش ویژگی Default Cell Style روی کلید سمت راست کلیک کنید و در پنجره باز شده در بخش Format کد زیر را بنویسید :


بستانکار 0;بدهکار0;بی حسابhttp://i31.tinypic.com/2llh9af.jpg

برای کسب اطلاعات بیشتر یه سری به لینک زیر بزنید :
http://msdn2.microsoft.com/en-us/library/0c899ak8.aspx

[bad_boy_2007]

چندین راه مختلف برای کلیک کردن روی کلیدها وجود داره ولی عموما 2 شکل اون رایج تر و ساده تره :



Button1_Click(New Object, New System.EventArgs)

که بعضی ها هم دوست دارن اینطوری بنویسن :

Dim sender1 As New Object
Dim e1 As New System.EventArgs
Button1_Click(sender1, e1)

ولی در هر حال فرقی نمیکنه


و اما راه دوم که کمی ساده تره و باعث خوانایی بیشتر کدها میشه :


Button1.PerformClick()

[Dariuosh]

یه کلاس Add کنید


Imports System.IO
PublicClass MP3ID3v1
' Constructor
PublicSubNew(OptionalByVal Filename AsString = "")
MyBase.New()
If (Filename <> "") ThenMe.Filename = Filename
EndSub
' Genres
PublicEnum Genres AsByte
Blues = 0
ClassicRock = 1
Country = 2
Dance = 3
Disco = 4
Funk = 5
Grunge = 6
HipHop = 7
Jazz = 8
Metal = 9
NewAge = 10
Oldies = 11
Other = 12
Pop = 13
RnB = 14
Rap = 15
Reggae = 16
Rock = 17
Techno = 18
Industrial = 19
Alternative = 20
Ska = 21
DeathMetal = 22
Pranks = 23
Soundtrack = 24
EuroTechno = 25
Ambient = 26
TripHop = 27
Vocal = 28
JazzFunk = 29
Fusion = 30
Trance = 31
Classical = 32
Instrumental = 33
Acid = 34
House = 35
Game = 36
SoundClip = 37
Gospel = 38
Noise = 39
AlternRock = 40
Bass = 41
Soul = 42
Punk = 43
Space = 44
Meditative = 45
InstrumentalPop = 46
InstrumentalRock = 47
Ethnic = 48
Gothic = 49
Darkwave = 50
TechnoIndustrial = 51
Electronic = 52
PopFolk = 53
Eurodance = 54
Dream = 55
SouthernRock = 56
Comedy = 57
Cult = 58
Gangsta = 59
Top40 = 60
ChristianRap = 61
PopFunk = 62
Jungle = 63
NativeAmerican = 64
Cabaret = 65
NewWave = 66
Psychadelic = 67
Rave = 68
Showtunes = 69
Trailer = 70
LoFi = 71
Tribal = 72
AcidPunk = 73
AcidJazz = 74
Polka = 75
Retro = 76
Musical = 77
RocknRoll = 78
HardRock = 79
None = 255
EndEnum
' Frame types
PublicEnum FrameTypes AsByte
Title = 0
Artist = 1
Album = 2
Year = 3
Track = 4
Comment = 5
Genre = 6
EndEnum
' Filename
Private mstrFilename AsString
PublicProperty Filename() AsString
Get
Return mstrFilename
EndGet
Set(ByVal Value AsString)
'Dim objFile As File
If (File.Exists(Value)) Then
mstrFilename = Value
Refresh()
Else
ThrowNew System.IO.FileLoadException( _
"The specified file does not exist", Value)
EndIf
EndSet
EndProperty
' TagExists
Private mblnTagExists AsBoolean
PublicReadOnlyProperty TagExists() AsBoolean
Get
Return mblnTagExists
EndGet
EndProperty
' Frame
Private mobjFrame(7) AsObject
PublicProperty Frame(ByVal FrameType As FrameTypes)
Get
Return mobjFrame(FrameType)
EndGet
Set(ByVal Value)
mobjFrame(FrameType) = Value
EndSet
EndProperty
' Refresh (gets all tags from the specified file)
PublicSub Refresh()
' Declarations
Dim strTag AsNewString(" ", 3)
Dim strTitle AsNewString(" ", 30)
Dim strArtist AsNewString(" ", 30)
Dim strAlbum AsNewString(" ", 30)
Dim strYear AsNewString(" ", 4)
Dim strComment AsNewString(" ", 28)
Dim bytDummy AsByte
Dim bytTrack AsByte
Dim bytGenre AsByte
' Open the file
Dim intFile AsInteger = FreeFile()
FileOpen(intFile, mstrFilename, OpenMode.Binary, _
OpenAccess.Read, OpenShare.LockWrite)
' Gets length of file
Dim lngLOF AsLong = LOF(intFile)
If (lngLOF > 128) Then
' Check for the ID3v1 tag
FileGet(intFile, strTag, lngLOF - 127, True)
If (strTag.ToUpper <> "TAG") Then
' No ID3v1 tag found
mblnTagExists = False
mobjFrame(0) = ""
mobjFrame(1) = ""
mobjFrame(2) = ""
mobjFrame(3) = ""
mobjFrame(4) = ""
mobjFrame(5) = ""
mobjFrame(6) = ""
Else
' ID3v1 tag found
mblnTagExists = True
' Read all frames from the file
FileGet(intFile, strTitle)
FileGet(intFile, strArtist)
FileGet(intFile, strAlbum)
FileGet(intFile, strYear)
FileGet(intFile, strComment)
FileGet(intFile, bytDummy)
FileGet(intFile, bytTrack)
FileGet(intFile, bytGenre)
' Assign the frame content to the properties
mobjFrame(0) = strTitle
mobjFrame(1) = strArtist
mobjFrame(2) = strAlbum
mobjFrame(3) = strYear
mobjFrame(4) = bytTrack
mobjFrame(5) = strComment
mobjFrame(6) = bytGenre
EndIf
EndIf
' Close the file
FileClose(intFile)
EndSub
' Update
PublicSub Update()
' Declarations
Dim strTag AsNewString(" ", 3)
Dim strTitle AsNewString(" ", 30)
Dim strArtist AsNewString(" ", 30)
Dim strAlbum AsNewString(" ", 30)
Dim strYear AsNewString(" ", 4)
Dim strComment AsNewString(" ", 28)
Dim bytDummy AsByte
Dim bytTrack AsByte
Dim bytGenre AsByte
' Open the file
Dim intFile AsInteger = FreeFile()
FileOpen(intFile, mstrFilename, OpenMode.Binary, _
OpenAccess.ReadWrite, OpenShare.LockWrite)
' Gets length of file
Dim lngLOF AsLong = LOF(intFile)
If (lngLOF > 0) Then
If (lngLOF > 128) Then
' Check for an existing ID3v1 tag
FileGet(intFile, strTag, lngLOF - 127)
If (strTag.ToUpper <> "TAG") Then
' No ID3v1 tag found, so just add one
Seek(intFile, lngLOF)
strTag = "TAG"
FilePut(intFile, strTag)
EndIf
' Fix the length of the frames
strTitle = LSet(mobjFrame(0), Len(strTitle))
strArtist = LSet(mobjFrame(1), Len(strArtist))
strAlbum = LSet(mobjFrame(2), Len(strAlbum))
strYear = LSet(mobjFrame(3), Len(strYear))
bytTrack = mobjFrame(4)
strComment = LSet(mobjFrame(5), Len(strComment))
bytGenre = mobjFrame(6)
' Write the frames to the file
FilePut(intFile, strTitle)
FilePut(intFile, strArtist)
FilePut(intFile, strAlbum)
FilePut(intFile, strYear)
FilePut(intFile, strComment)
FilePut(intFile, bytDummy)
FilePut(intFile, bytTrack)
FilePut(intFile, bytGenre)
EndIf
EndIf
' Close the file
FileClose(intFile)
EndSub
EndClass

اینجوری تعریف میشه


Dim objMP3V1 AsNew MP3ID3v1("C:\Song.mp3")

اگه TagExists برابر True بود


If (objMP3V1.TagExists) Then
MessageBox.Show(objMP3V1.Frame(MP3ID3v1.FrameTypes .Album))
MessageBox.Show(objMP3V1.Frame(MP3ID3v1.FrameTypes .Artist))
EndIf

برا ست کردن تگ جدید Property اونو ست کنید و Update کنید


objMP3V1.Frame(MP3ID3v1.FrameTypes.Album) = "Album name"
objMP3V1.Update()



منبع (http://www.codeproject.com/KB/vb/mp3id3v1.aspx)
بیشتر (http://www.codeproject.com/KB/recipes/vbmp3header.aspx)

[titbasoft]

ضمن هماهنگی با آقای غفوری،

لطفا جهت یکپارچگی مطالب، فعالیت این تاپیک رو در تاپیک Code Sample (http://barnamenevis.org/forum/showthread.php?t=58718) ادامه بدید.

ممنون