首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

请高手将上面这段vb.net的代码翻译成vb6

2012-07-15 
请高手将下面这段vb.net的代码翻译成vb6分数太少,但是感激不尽!VB codeImports System.DrawingImports Sys

请高手将下面这段vb.net的代码翻译成vb6
分数太少,但是感激不尽!

VB code
Imports System.DrawingImports System.Drawing.ImagingImports System.Runtime.InteropServicesPublic Class Form1    Inherits System.Windows.Forms.Form    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load        Dim pic As Image = Image.FromFile("test.jpg")        SaveGIFWithNewColorTable(pic, "test.gif", 16, True)    End Sub    Class Win32API        <DllImport("KERNEL32.DLL", EntryPoint:="RtlMoveMemory", _           SetLastError:=True, CharSet:=CharSet.Auto, _           ExactSpelling:=True, _           CallingConvention:=CallingConvention.StdCall)> _        Public Shared Sub CopyArrayTo(<[In](), MarshalAs(UnmanagedType.I4)> ByVal hpvDest As Int32, <[In](), Out()> ByVal hpvSource() As Byte, ByVal cbCopy As Integer)            ' Leave function empty - DLLImport attribute forwards calls to CopyArrayTo to            ' RtlMoveMemory in KERNEL32.DLL.        End Sub    End Class    Private Function GetColorPalette(ByVal nColors As Integer) As ColorPalette        ' Assume monochrome image.        Dim bitscolordepth As PixelFormat = PixelFormat.Format1BppIndexed        Dim palette As ColorPalette 'The Palette we are stealing        Dim bitmap As Bitmap        'The source of the stolen palette        ' Determine number of colors.        If nColors > 2 Then            bitscolordepth = PixelFormat.Format4BppIndexed        End If        If (nColors > 16) Then            bitscolordepth = PixelFormat.Format8BppIndexed        End If        ' Make a new Bitmap object to get its Palette.        bitmap = New Bitmap(1, 1, bitscolordepth)        palette = bitmap.Palette    ' Grab the palette        bitmap.Dispose()            ' cleanup the source Bitmap        Return palette              ' Send the palette back    End Function    Private Sub SaveGIFWithNewColorTable(ByVal image As Image, ByVal filename As String, ByVal nColors As Integer, ByVal fTransparent As Boolean)        ' GIF codec supports 256 colors maximum, monochrome minimum.        If (nColors > 256) Then            nColors = 256        End If        If (nColors < 2) Then            nColors = 2        End If        ' Make a new 8-BPP indexed bitmap that is the same size as the source image.        Dim Width As Integer = image.Width        Dim Height As Integer = image.Height        ' Always use PixelFormat8BppIndexed because that is the color        ' table based interface to the GIF codec.        Dim bitmap As Bitmap = New Bitmap(Width, Height, PixelFormat.Format8BppIndexed)        ' Create a color palette big enough to hold the colors you want.        Dim pal As ColorPalette = GetColorPalette(nColors)        ' Initialize a new color table with entries that are determined        ' by some optimal palette-finding algorithm; for demonstration         ' purposes, use a grayscale.        Dim i As Integer        For i = 0 To nColors - 1            Dim Alpha As Integer = 255             ' Colors are opaque            Dim Intensity As Double = CDbl(i) * 255 / (nColors - 1) ' even distribution             ' The GIF encoder makes the first entry in the palette            ' with a ZERO alpha the transparent color in the GIF.            ' Pick the first one arbitrarily, for demonstration purposes.            If (i = 0 And fTransparent) Then    ' Make this color index...                Alpha = 0                       ' Transparent            End If            ' Create a gray scale for demonstration purposes.            ' Otherwise, use your favorite color reduction algorithm             ' and an optimum palette for that algorithm generated here.            ' For example, a color histogram, or a median cut palette.            pal.Entries(i) = Color.FromArgb(Alpha, Intensity, Intensity, Intensity)        Next i        ' Set the palette into the new Bitmap object.        bitmap.Palette = pal        ' Use GetPixel below to pull out the color data of        ' image because GetPixel isn't defined on an Image; make a copy         ' in a Bitmap instead. Next, make a new Bitmap that is the same         ' size as the image that you want to export. Or, try to interpret        ' the native pixel format of the image by using a LockBits        ' call. Use PixelFormat32BppARGB so you can wrap a graphics          ' around it.        Dim BmpCopy As Bitmap = New Bitmap(Width, Height, PixelFormat.Format32BppArgb)        Dim g As Graphics        g = Graphics.FromImage(BmpCopy)        g.PageUnit = GraphicsUnit.Pixel        ' Transfer the Image to the Bitmap.        g.DrawImage(image, 0, 0, Width, Height)        ' Force g to release its resources, namely BmpCopy.        g.Dispose()        ' Lock a rectangular portion of the bitmap for writing.        Dim bitmapData As BitmapData        Dim rect As Rectangle = New Rectangle(0, 0, Width, Height)        bitmapData = bitmap.LockBits(rect, ImageLockMode.WriteOnly, PixelFormat.Format8BppIndexed)        ' Write to a temporary buffer, and then copy to the buffer that        ' LockBits provides. Copy the pixels from the source image in this        ' loop. Because you want an index, convert RGB to the appropriate        ' palette index here.        Dim pixels As IntPtr = bitmapData.Scan0        Dim bits As Byte()      ' the working buffer        ' Get the pointer to the image bits.        Dim pBits As Int32        If (bitmapData.Stride > 0) Then            pBits = pixels.ToInt32()        Else            ' If the Stide is negative, Scan0 points to the last            ' scanline in the buffer. To normalize the loop, obtain            ' a pointer to the front of the buffer that is located             ' (Height-1) scanlines previous.            pBits = pixels.ToInt32() + bitmapData.Stride * (Height - 1)        End If        Dim stride As Integer = Math.Abs(bitmapData.Stride)        ReDim bits(Height * stride) ' Allocate the working buffer.        Dim row As Integer        Dim col As Integer        For row = 0 To Height - 1            For col = 0 To Width - 1                ' Map palette indices for a gray scale.                ' Put your favorite color reduction algorithm here.                ' If you use some other technique to color convert.                Dim pixel As Color      ' The source pixel.                ' The destination pixel.                Dim i8BppPixel As Integer = row * stride + col                pixel = BmpCopy.GetPixel(col, row)                ' Use luminance/chrominance conversion to get grayscale.                ' Basically, turn the image into black and white TV.                ' Do not calculate Cr or Cb because you                 ' discard the color anyway.                ' Y = Red * 0.299 + Green * 0.587 + Blue * 0.114                ' This expression should be integer math for performance;                ' however, because GetPixel above is the slowest part of                 ' this loop, the expression is left as floating point                ' for clarity.                Dim luminance As Double = (pixel.R * 0.299) + _                                    (pixel.G * 0.587) + _                                    (pixel.B * 0.114)                ' Gray scale is an intensity map from black to white.                ' Compute the index to the grayscale entry that                ' approximates the luminance, and then round the index.                    ' Also, constrain the index choices by the number of                ' colors to do, and then set that pixel's index to the byte                ' value.                Dim colorIndex As Double = Math.Round((luminance * (nColors - 1) / 255))                bits(i8BppPixel) = CByte(colorIndex)                ' /* end loop for col */             Next col            ' /* end loop for row */         Next row        ' Put the image bits definition into the bitmap.        Win32API.CopyArrayTo(pBits, bits, Height * stride)        ' To commit the changes, unlock the portion of the bitmap.         bitmap.UnlockBits(bitmapData)        bitmap.Save(filename, ImageFormat.Gif)        ' Bitmap goes out of scope here and is also marked for        ' garbage collection.        ' Pal is referenced by bitmap and goes away.        ' BmpCopy goes out of scope here and is marked for garbage        ' collection. Force it, because it is probably quite large.        ' The same applies for bitmap.        BmpCopy.Dispose()        bitmap.Dispose()    End SubEnd Class 



[解决办法]
太多了 估计没人会帮楼主......

热点排行