این کد در رویداد FormLoad برنامه قرار می گیرد و مسیر اجرای برنامه را بررسی می کند. اگر درایوی که برنامه از روی آن اجرا می شود از نوع CD Rom, CD Writer و ... نبود، برنامه با دستور End بسته می شود.
کد زیر را در رویداد FormLoad فرم اصلی قرار دهید:
Dim appdrive As New IO.DriveInfo(Application.StartupPath.Substring(0, 2))
If appdrive.DriveType <> 5 Then End
ravegoat
08-01-09, 21:27
کد زیر را در رویداد FromClosing فرم قرار دهید تا با کلیک بر روی دکمه ی Close X فرم بسته نشود:
'Stand By
Application.SetSuspendState(PowerState.Suspend, True, False)
ravegoat
09-01-09, 11:21
ابتدا کد زیر را در Public Class فرم قرار دهید:
Public Declare Function BlockInput Lib "user32" (ByVal Block As Boolean) As Long
سپس با فرمان های زیر می توانید صفحه کلید و موشواره را قفل یا آزاد کنید:
'قفل کردن
BlockInput(True)
'آزاد کردن
BlockInput(False)
عمل قفل کردن را می توان با کلید ترکیبی Alt + Ctrl + Del خنثی کرد.
ravegoat
09-01-09, 11:36
ابتدا کد زیر را در Public Class فرم قرار دهید:
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal Command As String, ByVal ReturnString As String, ByVal ReturnLength As Long, ByVal Callback As Long) As Long
بعد از فرمان های زیر استفاده می کنید:
'باز کردن
mciSendString("Set CDAudio Door Open Wait", 0, 0, 0)
'بستن
mciSendString("Set CDAudio Door Closed Wait", 0, 0, 0)
ravegoat
23-01-09, 07:39
My.Computer.Clipboard.Clear()
ravegoat
23-01-09, 08:05
Dim helpoint As New Point(0 , 0)
Help.ShowPopup(Me, "Your Text", helpoint)
به جای اعداد 0 و 0 می توانید مختصات مکان دلخواه خود برای نمایش PopUp را وارد کنید.
به جای Your Text ، متن PopUp دلخواه خود را درون نقل قول قرار دهید.
به جای عبارت File Path، مسیر فایل صوتی را داخل نقل قول قرار دهید.
ravegoat
23-01-09, 08:08
ابتدا مرجع System.Management را به پروژه خودتان اضافه کنید. برای این کار به منوی Project رفته و گزینه ی Add Refrence را انتخاب کنید سپس در پنجره ی جدید باز شده مرجع System.Management را انتخاب و آن را به برنامه اضافه کنید.
سپس کد زیر را در خارج Public Class فرم برنامه قرار دهید:
Imports System.Management
اکنون از کد زیر استفاده کنید:
Dim objMOS As ManagementObjectSearcher
Dim objMOC As Management.ManagementObjectCollection
Dim objMO As Management.ManagementObject
objMOS = New ManagementObjectSearcher("Select * From Win32_Processor")
objMOC = objMOS.Get
For Each objMO In objMOC
MessageBox.Show("CPU ID = " & objMO("ProcessorID"))
Next
ابتدا کد (API) زیر را در Public Class فرم برنامه قرار دهید:
Private Declare Function MonTurnOff Lib "user32" Alias "SendMessageA"(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
اگر برنامه ی شما شامل چندین فرم است، با این کد می توانید عنوان پنجره هایی از برنامه که بارگذاری شده اند را در قالب یک جعبه ی متنی مشاهده کنید:
Dim openfrmtle As String
For Each appform As Form In Application.OpenForms
openfrmtle += Chr(13) + appform.Text
MsgBox(openfrmtle, 64, "Open Form(s) : " + CStr(Application.OpenForms.Count))
Next
ravegoat
06-02-09, 07:57
هر بار كه اين كد اجرا شود يك عدد بين 1 تا 6 -اعداد تاس- را به طور تصادفي با جبعه متني نمايش مي دهد:
Dim diceno As New Random
MsgBox(diceno.Next(1, 6), 64, "Dice")
ravegoat
13-02-09, 09:16
این کد عکس گرفته شده را در متغیر screenshot ذخیره می کند.
Dim bounds As Rectangle
Dim screenshot As Bitmap
Dim graph As Graphics
bounds = Screen.PrimaryScreen.Bounds
screenshot = New Bitmap(bounds.Width, bounds.Height)
graph = Graphics.FromImage(screenshot)
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
منبع (Only the registered members can see the link)
ravegoat
13-02-09, 09:19
ابتدا مرجع (Reference) System.Management را به پروژه ي خود اضافه مي كنيم. سپس از كد زير استفاده مي كنيم. اين كد تمام نام هاي كاربري را با يك جعبه ي متني نمايش مي دهد:
Dim compusrs As String
Dim query As New System.Management.SelectQuery("Win32_UserAccount")
Dim searcher As New System.Management.ManagementObjectSearcher(query)
For Each envVar As System.Management.ManagementObject In searcher.Get()
compusrs += envVar("Name") + Chr(13)
Next
MsgBox(compusrs, 64, My.Computer.Name + "'s Users")
منبع (Only the registered members can see the link)
ravegoat
20-02-09, 09:00
برای اين كار از الگوی زير پيروی كنيد:
Windows.Forms.Cursor.Position = New Point(x As Integer, y As Integer)
مثال
'با اين كد نشانگر به مكانی به طول 400 و عرض 300 پيكسل می رود
Windows.Forms.Cursor.Position = New Point(400, 300)
ravegoat
20-02-09, 09:00
MsgBox(Windows.Forms.Cursor.Position.ToString)
ravegoat
20-02-09, 09:01
'پنهان كردن
Windows.Forms.Cursor.Hide()
'آشكار كردن
Windows.Forms.Cursor.Show()
ravegoat
20-02-09, 09:03
برای اين كار كد زير را در رويداد Form_Load برنامه قرار دهيد:
For i As Integer = 0 To 100
Opacity = i / 100
Next
ravegoat
20-02-09, 09:05
كد زير را در رويداد Form_FromClosing برنامه قرار دهيد:
e.Cancel = True
For i As Integer = 99 To 25 Step -1
Opacity = i / 100
Next
End
ravegoat
20-02-09, 09:06
Controls.Clear()
ravegoat
20-02-09, 09:08
اين كد با InputBox يک متن را از كاربر دريافت می كند و سپس اعداد موجود در رشته را با جعبه ی متنی به او نمايش می دهد.
Dim mychr As String = InputBox("Type sth here:")
For i As Integer = 0 To mychr.Length - 1
If IsNumeric(mychr.Chars(i)) Then
nochar += mychr.Chars(i)
Else
nochar += "-"
End If
Next
MsgBox(nochar, 64, "The String contains these number(s):")
ravegoat
20-02-09, 09:09
بخش اول اين كد جالب، زمانی كه فرم در حال بسته شدن است مختصات فرم و اندازه ی آن را در رجيستری ذخيره می كند. بخش دوم كد نيز زمانی كه فرم در حال بار گذاری است، مختصات و اندازه ی ذخيره شده در رجيستری را دريافت می كند و آن ها را روی فرم برنامه اعمال می نمايد.
این کد درایو های مربوط به حافظه های فلش را شناسایی می کند و نام آن ها را با جعبه متنی بر می گرداند:
كد زير را در خارج از Public Class فرم برنامه قرار می دهيم:
Imports System.IO
سپس از این کد استفاده کنید:
On Error Resume Next
Dim rmdrvs As String
For iDrive As Integer = 0 To DriveInfo.GetDrives.Length - 1
If DriveInfo.GetDrives(iDrive).DriveType = 2 And DriveInfo.GetDrives(iDrive).Name <> "A:\" And DriveInfo.GetDrives(iDrive).Name <> "B:\" Then
rmdrvs += ControlChars.NewLine + DriveInfo.GetDrives(iDrive).Name + " - " + DriveInfo.GetDrives(iDrive).VolumeLabel
End If
Next
MsgBox(rmdrvs)
ravegoat
16-07-09, 13:31
For Each prntr As String In Drawing.Printing.PrinterSettings.InstalledPrinters
MsgBox(prntr)
Next
بر گرفته شده از کد علی جان (Only the registered members can see the link)
ravegoat
21-07-09, 11:45
Function getMD5Hash(ByVal strToHash As String) As String
Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
bytesToHash = md5Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult
End Function
منبع (Only the registered members can see the link)
™Ali
24-07-09, 19:11
Function getMD5Hash(ByVal strToHash As String) As String
Dim md5Obj As New Security.Cryptography.MD5CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
bytesToHash = md5Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult
End Function
منبع (Only the registered members can see the link)
فقط توجه داشته باشید MD5Hash دیگه قابلیت Decode شدن رو نداره.
پس واسه رمزنگاری مطالب نباید ازش استفاده کنید چون میشه شتر دیدی ندیدی :1. (38): (انگار نه انگار چیزی وجود داشته ! )
با تشکر :1. (21):
ravegoat
26-07-09, 10:44
For Each appf As Form In Application.OpenForms
msgbox(appf.Text)
Next
برگرفته شده از سایت برنامه نویس (Only the registered members can see the link)
ravegoat
02-08-09, 14:06
این سورس مقدار TimeZone رو بر می گردونه (نشون میده الگوی زمانی برای چه منطقه ای تنظیم شده):
MsgBox(TimeZone.CurrentTimeZone.StandardName)
ravegoat
02-08-09, 14:15
این کد به شما نشون آدرس ایمیلی را که کاربر وارد کرده، معتبر است یا خیر؟
مثلا" example@dom@main.com یه آدرس غیر معتبره.
Imports System.Text.RegularExpressions
Dim emailAddress As String = InputBox("Plz enter ur Email Address:")
Dim pattern As String = "^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$"
Dim emailAddressMatch As Match = Regex.Match(emailAddress, pattern)
If emailAddressMatch.Success Then
MsgBox("Correct Email Address.", 64)
Else
MsgBox("Invalid Email Address.", 48)
End If
نویسنده ی کد: Muhammed Mohiudeen.M.N
ravegoat
05-08-09, 09:59
این کد رو در رویداد KeyPress ، جعبه متنی (TextBox) قرار بدید. با این کار جعبه متنی فقط از صفحه کلید کارکتر های عددی رو دریافت می کنه؛ نه چیز دیگه !
If Not IsNumeric(e.KeyChar) Then e.Handled = True
ravegoat
27-08-09, 17:20
ابتدا API زیر را تعریف می کنیم (این تعریف می تواند در Public Class فرم یا در یک ماژول صورت گیرد.):
Private Declare Auto Function SystemParametersInfo Lib "user32.dll" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer
به جای عبارت Bitmap Image Path ، مسیر عکس Bitmap (با پسوند BMP) را قرار می دهیم. این تصویر به عنوان پس زمینه ی میزکار ویندوز قرار می گیرد.
ravegoat
10-09-09, 11:55
این سورس نشان می دهد سیستم عامل از چه مسیری راه اندازی شده است.
برای استفاده از این کد باید مرجع System.Management را به پروژه خود اضافه کنید و سپس این خط را در خارج از Public Class فایل وی بی قرار دهید:
Imports System.Management
حال این کد مسیر را با جعبه متنی نمایش می دهد:
Dim BootDevice As String
Dim searcher As New ManagementObjectSearcher("select * from Win32_BootConfiguration")
For Each share As ManagementObject In searcher.Get
BootDevice = share("Description").ToString()
Next
MsgBox(BootDevice)
منبع: dotNetSpider
ravegoat
18-10-09, 20:46
اين تابع يك رشته ي ورودي را به عنوان آرگومان دريافت مي كند. سپس حروف رشته را از آخر به اول به ترتيب در يك متغير قرار مي دهد. در نهايت تابع مقدار مقلوب شده را بر مي گرداند.
Function Reserver(ByVal UrText As String) As String
For i As Integer = UrText.Length - 1 To 0 Step -1
Reserver += UrText.Chars(i)
Next
End Function
مثال:
MsgBox(Reserver("PC Network"))
ravegoat
20-10-09, 18:19
استاندارد اسكي براي حروف، از 0 تا 255 شماره گذاري مي شود. براي دريافت كد اسكي يك كاركتر از دستور زير استفاده مي كنيم:
Asc(Your Character As String)مانند:
Asc("A")
براي تبديل كد اسكي به حرف معادل آن از اين فرمان كمك مي گيريم:
Chr(Your Code As Integer)مانند:
Chr(65)
ravegoat
23-01-10, 09:32
در ويژوال استاديو 2008 يه سري كد هاي پايه براي آشنايي با زبان هاي دات نت قرار داده شده. براي كساني كه دوست دارن سريع خودشون را با زبان .Net تطبيق بدن اين الگو ها خيلي مفيده.
براي دست يابي به اين الگو هاي آماده؛ ابتدا ويژوال استاديو رو باز كنيد. در نوار منو به قسمت Help برويد و روي گزينه ي Samples كليك كنيد.
حالا يه زبانه ي جديد باز ميشه. در اين برگه روي لينك local Samples folder كليك كنيد تا وارد پوشه ي الگو بشيد.
در اين پوشه بسته به تنظيمات نصب مي تونيد سورس هاي آماده ويژوال بيسيك، سي شارپ و سي پلاس پلاس رو مشاهده كنيد. در نهايت با Extract كردن بسته ي مورد نظر خودتون، مي تونيد به پروژه ها دسترسي داشته باشيد و از اون ها استفاده كنيد.:party:
ravegoat
04-02-10, 09:36
با سلام!
براي اين كار ابتدا مجموعه Globalization را به برنامه اضافه مي كنيم:
Imports System.Globalization
سپس روي فرم برنامه جعبه متني مورد نظر خود را با نام TextBox1 اضافه مي كنيم.
حال در رويداد TextBox1_GotFocus كد زير را قرار مي دهيم:
بر گرفته شده از مبتكر برتر (Only the registered members can see the link)
arallu
26-10-10, 18:37
تشکر خیلی زیاد
ravegoat
12-02-11, 21:23
فرض كنيد كه ما مي خواهيم در بازه هاي زماني متفاوت متني را وارد جعبه ي متني كنيم و توجه كاربر را به آن متن جديد معطوف كنيم. اگر طول متن ها از اندازه ي TextBox فرضا" TextBox1 بيش تر باشد، متن ها جديد كه به جعبه اضافه مي شوند ديگر نمايش داده نخواهند شد و كاربر مي بايستي براي مشاهده ي اين متن هاي جديد، Scrollbar مربوط به TextBox1 را به سمت پايين بكشد تا بتواند ادامه ي متن و در واقع متن هاي جديد را مشاهده كنيد. با اجراي كد زير عمل Scroll كردن را به طور خودكار صورت مي گيرد:
نمونه از اين كاربرد در برنامه اي مثل Hyper Terminal يا پنجره ي گفتمان پيام رسان ها مشاهده مي شود كه همواره بخش انتهايي جعبه ي حاوي متن نمايش داده مي شود و در واقع Scrollbar هميشه در پايين نگه داشته مي شود.
ravegoat
21-08-11, 20:02
اين تابع با دريافت يك تصوير از نوع Bitmap، مقدار Grayscale شده ي آن تصوير را بر مي گرداند. اساس كار تابع ذيل، تصوير بردار هاي رنگ به روي بردار (1, 1, 1) است. البته روش هاي سريع تري نظير ماتريس تبديل و يا توابع ويرايش قالب پيكسل (در Framework 4.0) براي اين كار وجود دارد.
Function ToGrayscale(ByVal inpImg As Bitmap) As Bitmap
Dim bytrgb As Byte
For i As Integer = 0 To inpImg.Width - 1
For j As Integer = 0 To inpImg.Height - 1
bytrgb = Convert.ToByte((Val(inpImg.GetPixel(i, j).R) + Val(inpImg.GetPixel(i, j).G) + Val(inpImg.GetPixel(i, j).B)) / 3)
inpImg.SetPixel(i, j, Color.FromArgb(bytrgb, bytrgb, bytrgb))
Next
Next
Return inpImg
End Function
ravegoat
26-08-11, 11:35
تابع زير با دريافت يك تصوير Bitmap به عنوان آرگومان، با اعمال يك نگاشت ساده روي رنگ تك تك پيكسل ها تصوير ورودي، مقدار Negative شده ي عكس را بر مي گرداند:
Function ToNegative(ByVal inpImg As Bitmap) As Bitmap
For i As Integer = 0 To inpImg.Width - 1
For j As Integer = 0 To inpImg.Height - 1
inpImg.SetPixel(i, j, Color.FromArgb(255 - Val(inpImg.GetPixel(i, j).R), 255 - Val(inpImg.GetPixel(i, j).G), 255 - Val(inpImg.GetPixel(i, j).B)))
Next
Next
Return inpImg
End Function
ravegoat
10-09-11, 20:05
اين كد مقدار Boolean مربوط به روشن/خاموش بودن كليد CapsLock را بر مي گرداند:
Control.IsKeyLocked(Keys.CapsLock)
ravegoat
15-12-11, 09:34
اگر سورس زير را در رويداد Tick يك Timer قرار دهيد، به هنگام شروع به كار تايمر، فرم با جلوه اي زيبا به شكل يكنواخت از گوشه ها كوچك شده و در نهايت بسته مي شود:
Size = New Size(Width - 2, Height - 2)
Location = New Point(Location.X + 1, Location.Y + 1)
If Size.Height < 120 Then End
ravegoat
14-02-12, 06:50
كد زير در رشته ي mystr، تمامي عبارات قديمي مورد نظر شما (old) را با عبارات جديدي كه شما تعيين مي كنيد (new) جايگزين مي كند:
Dim mystr As String = "Old Technology, Old Life"
While mystr.Contains("Old")
mystr = mystr.Replace("Old", "New")
End While
ravegoat
08-03-13, 13:10
با اجرای کد زیر در هر تابع یا رویدادی می توانید شکل نشانگر موشواره روی فرم را به شکل ساعت شنی تبدیل کنید:
Cursor = Cursors.WaitCursor
ravegoat
10-03-13, 20:13
با کد ساده ی زیر بدون استفاده از هیچ کتابخونه یا الگوریتمی می توانید تاریخ جاری میلادی را به تاریخ خورشیدی تبدیل کنید:
Dim persian As New System.Globalization.PersianCalendar()
MsgBox(persian.GetYear(Now.Date).ToString() + "/" + persian.GetMonth(Now.Date).ToString() + "/" + persian.GetDayOfMonth(Now.Date).ToString())
ravegoat
06-04-13, 18:50
کد زیر مربوط به الگوریتم تشخیص خطای CRC-16 است:
Private Function CRC16(ByVal modbus() As Byte) As Int32
Dim crc As Int32 = 0
For i As Integer = 0 To modbus.Length - 1
crc = crc Xor modbus(i)
For j As Byte = 1 To 8
If crc And &H1 Then
crc = (crc >> 1) Xor &H8408
Else
crc = crc >> 1
End If
Next
Next
Return crc
End Function
ravegoat
18-04-13, 11:25
کد زیر رشته ای را تحت شبکه به یک IP خاص با شماره پورت TCP مشخص ارسال می کند:
Dim clientSocket As New System.Net.Sockets.TcpClient()
clientSocket.Connect("127.0.0.1", 1001) 'IP:Port
Dim serverStream As System.Net.Sockets.NetworkStream = clientSocket.GetStream()
Dim data() As Byte = System.Text.Encoding.ASCII.GetBytes("Hello World") 'Message
serverStream.Write(data, 0, data.Length)
ravegoat
12-08-13, 13:48
گاهی اوقات میشه مثال های ساده و در عین حال جالبی رو تو DotNetPerls (Only the registered members can see the link) پیدا کرد؛ مثل این ماژول زیر که زمان و تاریخ سیستم رو در فرمت های متنوعی نمایش میده:
Module Module1
Sub Main()
' Acquire current time and then try format strings.
Dim now As DateTime = DateTime.Now
Console.WriteLine(now.ToString("d"))
Console.WriteLine(now.ToString("D"))
Console.WriteLine(now.ToString("f"))
Console.WriteLine(now.ToString("F"))
Console.WriteLine(now.ToString("g"))
Console.WriteLine(now.ToString("G"))
Console.WriteLine(now.ToString("m"))
Console.WriteLine(now.ToString("M"))
Console.WriteLine(now.ToString("o"))
Console.WriteLine(now.ToString("O"))
Console.WriteLine(now.ToString("s"))
Console.WriteLine(now.ToString("t"))
Console.WriteLine(now.ToString("T"))
Console.WriteLine(now.ToString("u"))
Console.WriteLine(now.ToString("U"))
Console.WriteLine(now.ToString("y"))
Console.WriteLine(now.ToString("Y"))
End Sub
End Module
5/18/2010
Tuesday, May 18, 2010
Tuesday, May 18, 2010 4:47 PM
Tuesday, May 18, 2010 4:47:55 PM
5/18/2010 4:47 PM
5/18/2010 4:47:55 PM
May 18
May 18
2010-05-18T16:47:55.9620000-06:00
2010-05-18T16:47:55.9620000-06:00
2010-05-18T16:47:55
4:47 PM
4:47:55 PM
2010-05-18 16:47:55Z
Tuesday, May 18, 2010 10:47:55 PM
May, 2010
May, 2010
ravegoat
15-08-13, 22:19
تابع زیر عبارتی را درون یک رشته جست و جو می کند و آرایه ای از اندیس مکان های این عبارت را درون آن رشته بر می گرداند:
Function IndexOfArray(ByVal inputStr As String, ByVal searchStr As String) As Integer()
Dim strCount As Integer = 0
Dim currInx As Integer = inputStr.IndexOf(searchStr)
Dim inxArr(0) As Integer
While currInx > -1
ReDim Preserve inxArr(strCount)
inxArr(strCount) = currInx
strCount += 1
currInx = inputStr.IndexOf(searchStr, currInx + 1)
End While
If strCount = 0 Then inxArr(0) = -1
Return inxArr
End Function
ravegoat
16-08-13, 09:34
دستور String.Join برای چسباندن آرایه ای از رشته ها با یک جدا کننده (Separator) به کار می رود و به گونه ای عکس عمل Split است که یک رشته را با توجه به یک جدا کننده به آرایه ای از رشته ها تبدیل می کند.
مثال:
Dim alphabet() As String = {"A", "B", "C"}
String.Join(",", alphabet)
خروجی:
A,B,C
ravegoat
16-08-13, 10:04
حتما" با دستور CInt آشنا هستید که یک شی مانند String را تبدیل به یک Integer می کند. ولی اگر بخواهیم آرایه ای از رشته ها را تبدیل به Integer کنیم چطور؟ کافیست نگاهی به مثال زیر بیاندازیم:
Dim numStr() As String = {"1", "10", "100"}
Dim numInt = numStr.ToList.ConvertAll(AddressOf Int32.Parse)
ravegoat
29-10-13, 18:50
تابع زیر با دریافت مسیر جست و جو و نام فایل، به دنبال آن فایل در مسیر تعیین شده می گردد و در صورتی که فایل مورد نظر را یافت، مسیر آن را بر می گرداند:
Function searcher(ByVal path As String, ByVal fileName As String) As String
Try
For Each folderName As String In My.Computer.FileSystem.GetDirectories(path)
If My.Computer.FileSystem.FileExists(folderName + "\" + fileName) Then Return folderName
searcher(folderName, fileName)
Next
Catch
End Try
Return "File Not Found."
End Function
ravegoat
02-03-14, 07:42
کد زیر با دریافت تصویر راست و چپ تصویر سه بعدی را به صورت Anaglyph ایجاد می کند:
Function CreateAnaglyph(ByVal left As Bitmap, ByVal right As Bitmap) As Bitmap
If left.Width <> right.Width Or left.Height <> right.Height Then Return Nothing
Dim final As New Bitmap(left.Width, left.Height)
For i As Integer = 0 To left.Width - 1
For j As Integer = 0 To left.Height - 1
final.SetPixel(i, j, Drawing.Color.FromArgb(left.GetPixel(i, j).R, right.GetPixel(i, j).G, right.GetPixel(i, j).B))
Next
Next
Return final
End Function
ravegoat
04-03-14, 21:55
اگر تمایل دارید که در یک جعبه ی متنی فقط کارکتر عددی وارد شود، کافیست کد زیر را در رویداد KeyPress آن جعبه ی متنی وارد کنید:
e.Handled = Not Char.IsDigit(e.KeyChar)
ravegoat
11-03-14, 07:37
کد زیر با گرفتن تصاویر سمت راست و چپ تصویر پولاریزه شده ی سه بعدی رو تولید می کنه:
Function Polarizor(ByVal left As Bitmap, ByVal right As Bitmap) As Bitmap
If left.Width <> right.Width And left.Height <> right.Height Then Return Nothing
Dim final As New Bitmap(left.Width, left.Height)
For j As Integer = 1 To left.Height / 2 - 1
For i As Integer = 0 To left.Width - 1
final.SetPixel(i, 2 * j, left.GetPixel(i, 2 * j))
final.SetPixel(i, 2 * j + 1, right.GetPixel(i, 2 * j + 1))
Next
Next
Return final
End Function
ravegoat
08-08-14, 11:26
برای تشخیص معتبر بودن یا نبودن تاریخ شمسی می توانید از کد زیر استفاده کنید:
Try
Const pd As String = "1393/3/30"
Dim spd As String() = Split(pd, "/")
Dim yy As Integer = Val(spd(0))
Dim mm As Integer = Val(spd(1))
Dim dd As Integer = Val(spd(2))
Dim fpd As String = String.Format("{0:0000}/{1:00}/{2:00}", yy, mm, dd)
Dim pc As New PersianCalendar()
pc.ToDateTime(yy, mm, dd, 12, 0, 0, 0)
MsgBox(fpd, 64)
Catch
MsgBox("تاریخ اشتباه است", 48)
End Try
ravegoat
05-01-15, 23:08
کد زیر در صورت 64 بیتی بودن سیستم عامل مقدار True و در غیر این صورت مقدار False را بر می گرداند: