> 请高手将下面这段vb.net的代码翻译成vb6分数太少，但是感激不尽VBcodeImportsSy
请高手将下面这段vb.net的代码翻译成vb6分数太少，但是感激不尽VBcodeImportsSy
luoyesong & &
发布时间： & &
浏览：22 & &
回复：0 & &
悬赏：0.0希赛币
请高手将下面这段vb.net的代码翻译成vb6分数太少，但是感激不尽！　　VB code　　Imports System.Drawing Imports System.Drawing.Imaging Imports System.Runtime.InteropServices
Public 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)
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.
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
If (nColors & 16) Then
bitscolordepth = PixelFormat.Format8BppIndexed
' 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
If (nColors & 2) Then
nColors = 2
' 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- 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...
' Transparent
' 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)
' 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 I 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()
' 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)
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
' 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
Dim colorIndex As Double = Math.Round((luminance * (nColors - 1) / 255))
bits(i8BppPixel) = CByte(colorIndex)
' /* end loop for col */
' /* end loop for 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()
本问题标题：
本问题地址：
温馨提示：本问题已经关闭，不能解答。
暂无合适的专家
&&&&&&&&&&&&&&&
希赛网 版权所有 & &&介绍一个VB小的有趣的程序代码_百度知道
介绍一个VB小的有趣的程序代码
简单点的 有趣点的 谢~
为您推荐：
其他1条回答
就看你能不能把它做得有趣而已一些VB小游戏吧……例如FaceCatch,LetterTile,LuckySeven等等都差不多
您可能关注的推广
程序代码的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁谁能帮我详细解释一下这段VB代码的意思么？谢谢啦~_百度知道
谁能帮我详细解释一下这段VB代码的意思么？谢谢啦~
[d2], l&.End(xlUp), i&, d(1 To 2) As Object
With Sheets(&quot, 2) & Chr(9) & arr(i, j&;), crr(), 0) = d(t)(arr(i;f65536&quot, 1), 0)
On Error Resume Next
For i = 2 To UBound(arr)
t = WorksheetFunction, 1)
crr(i;scripting, a, brr(1 To 2).Row)
For l = 1 To 2
Set d(l) = CreateObject(&quot.Range(&quot.Range(&)
brr(1) = .Match(arr(i, t%;A65536& & .CurrentRegion
ReDim crr(2 To UBound(arr);Sheet2&quot, 20)
arr = [a1], 2)
d(l)(brr(l)(i, j)
a = Array(10, 1) & Chr(9) & (j - 1)) = brr(l)(i;).Row)
brr(2) = ;)
For i = 1 To UBound(brr(l))
For j = 2 To UBound(brr(l):i&quot.dictionary&quot.End(xlUp); & .Range(&f3.Range(&quot:D&A3, arrSub Macro1()
hiphotos.baidu.hiphotos.jpg" target="_blank" title="点击查看大图" class="ikqb_img_alink"><img class="ikqb_img" src="/zhidao/pic/item/37d12f2ebddcf7eb8535e5dde7116e63.baidu://c.jpg" esrc="http.hiphotos://c.baidu这是效果图片<a href="http://c.com/zhidao/wh%3D600%2C800/sign=/zhidao/wh%3D450%2C600/sign=250e9b9bc8fcc3ceb495c137a775fabe/37d12f2ebddcf7eb8535e5dde7116e63
提问者采纳
brr(1 To 2), 1).Row) &#39;), l&;建立字典对象
For i = 1 To UBound(brr(l))
For j = 2 To UBound(brr(l).Range(&) &#39;crr从字典中获取
[d2].Resize(i - 2) = crr
&#39; & ;选择单元格范围f3到i（f列末行的行号）给brr(2)
For l = 1 To 2
Set d(l) = CreateObject(&quot, 3)) &#39;Sheet2&quot.Range(&quot, j&;) &#39, 2) & Chr(9) & arr(i, d(1 To 2) As Object
With Sheets(&quot.dictionary&quot, t%, 0) = d(t)(arr(i;scripting,重新定义crr数组的大小
On Error Resume Next
For i = 2 To UBound(arr)
t = WorksheetF调用excell函数match
crr(i, j) &#39, 1) &#39, crr(), 1) & Chr(9) & (j - 1)) = brr(l)(i.End(xlUp);A3.Range(&quot.Match(arr(i, i&.Row) &#39;A65536&quot, 0) &#39;仅sheet2有效
brr(1) = ，这时的arr就是一个数组
ReDim crr(2 To UBound(arr);建立一个a数组并赋值
arr = [a1];a1单元格延展区域给arr.CurrentRegion &#39;选择单元格范围a3到d（a列末行的行号）给brr(1)
brr(2) = ;f3, 20) &#39;f65536&brr(1)数组稍作处理加入字典
a = Array(10, 2)
d(l)(brr(l)(i;):i&quot.Range(&quot.End(xlUp); & :D&quot, arrSub Macro1()
提问者评价
其他类似问题
为您推荐：
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁怎么在VB中求和我是想编一个简单计算器,编到求和这块不太会了,下面是我写的代码,麻烦帮我想一下Sub op()T1.Enabled = TrueT1.Visible = TrueT1.SetFocusEnd SubSub oi()T1.Enabled = FalseT1.Visible = FalseEnd SubPrivate Sub Command1_Click())ElseIf O7 ThenT5 = Tan(T3 * 3. / 180)ElseIf O8 ThenT5 = 1 / Tan(T3 * 3. / 180)ElseIf O9 ThenIf T3 < 0 ThenMsgBox "被开方数不能小于零",2 + vbExclamation,"错误"T3 = ""T3.SetFocusExit SubEnd IfT5 = Sqr(T3)ElseIf O10 ThenT5 = Abs(T3)ElseIf O11 ThenT5 = Exp(T3)ElseIf O12 ThenIf T3
达尔尼YyGh
你的问题不够具体…那么我给你一个例子,你参考下:Private Sub Form_Load()Dim a(1 To 50)ShowFor i=1 To 50a(i)=101*RNDsum=sum+a(i)Next iPrint sumEnd Sub以上希望能给你帮助,求和主要是用到循环,可以用For和Do.
为您推荐：
其他类似问题
扫描下载二维码请问VB里CDate(Timer)是什么意思啊?源代码是定义变量t,然后t=CDate(Timer)其中的Timer是加入的控件
Timer,是从本次开机以来的秒数,含有小数CDate是一个函数,用来把一个数值转变成日期时间格式（其中整数为从日起算的日数；小数表示从0:0开始的时间【12小时为0.5,以此类推】,格式为hh：mm：ss）综合起来看本意就是表达本次开机以来的时间,但可能不会正确.因为单位不对. 补充回答：timer,在这里是一个系统值,并不是你加入的控件.加入的控件默认名称是timer1、timer2之类.其一,在这里你要是将timer1改成timer会出错的.其二,控件名除了极个别场活使用外,一般不单独使用（除默认属性外）.如果要使用控件名则要使用例如：timer1.name；控件的其他属性也必须写出属性名的.
为您推荐：
其他类似问题
扫描下载二维码}