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

[ghafoori]

https://barnamenevis.org/showpo...3&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]

https://barnamenevis.org/showpo...9&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]

https://barnamenevis.org/showpo...9&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]

https://barnamenevis.org/showpo...4&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]

https://barnamenevis.org/showpo...7&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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]

https://barnamenevis.org/showpo...&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://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()

منبع
بیشتر

[titbasoft]

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

لطفا جهت یکپارچگی مطالب، فعالیت این تاپیک رو در تاپیک Code Sample ادامه بدید.

ممنون