请高手将下面这段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
[解决办法]
太多了 估计没人会帮楼主......