VB中生成如下彩色二维码有什么好的方法？

[无·法]

vb纯代码生成二维码的方法我已经找到了，下载地址：
http://download.csdn.net/detail/sysdzw/7359829

想将生成的二维码二次处理变成彩色的，比如传入参数"红绿蓝紫色"的色值，就上下左右修改为：


我想的方法是分成4块，然后以位图方式，一个个点设置颜色值，不过这样貌似会很慢很慢。请教下有什么好的办法。

[laviewpbt]

这个不就是简单的图像处理下吗，一个点以个点的处理下，10ms就能处理完的

[of123]

使用 API。 用 GetDIBits 将像素取到数组中。 进行处理。实际上不需要切块，在循环处理中判断一下数组的坐标即可。 再用 SetDIBitsToDevice 输出像素到控件。

[贝隆]

引用 2 楼 of123 的回复:

使用 API。 用 GetDIBits 将像素取到数组中。 进行处理。实际上不需要切块，在循环处理中判断一下数组的坐标即可。 再用 SetDIBitsToDevice 输出像素到控件。

+1

[laviewpbt]

PSET N man

[赵4老师]

PaintPicture 方法 用以在 Form, PictureBox 或 Printer 上绘制图形文件（.bmp、.wmf、.emf、.cur、.ico或 .dib）的内容。不支持命名参数。 语法 object.PaintPicture picture, x1, y1, width1, height1, x2, y2, width2, height2, opcode PaintPicture 方法的语法包含下列部分： 部分 描述 object 可选的。一个对象表达式，其值为“应用于”列表中的一个对象。如果省略 object，带有焦点的 Form 对象缺省为 object。 Picture 必需的。要绘制到 object 上的图形源。Form 或 PictureBox 必须是 Picture 属性。 x1, y1 必需的。均为单精度值，指定在 object 上绘制 picture 的目标坐标（x-轴和y-轴）。object 的 ScaleMode 属性决定使用的度量单位。 Width1 可选的。单精度值，指示 picture 的目标宽度。object 的 ScaleMode 属性决定使用的度量单位。如果目标宽度比源宽度 (width2) 大或小，将适当地拉伸或压缩 picture。如果该参数省略，则使用源宽度。 Height1 可选的。 单精度值，指示 picture 的目标高度。object 的 ScaleMode 属性决定使用的度量单位。如果目标高度比源高度 (height2) 大或小，将适当地拉伸或压缩 picture。如果该参数省略，则使用源高度。 x2, y2 可选的。均为单精度值，指示 picture 内剪贴区的坐标（x-轴和y-轴）。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则缺省为 0。 Width2 可选的。单精度值，指示 picture 内剪贴区的源宽度。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则使用整个源宽度。 Height2 可选的。 单精度值，指示 picture 内剪贴区的源高度。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则使用整个源高度。 Opcode 可选的。是长型值或仅由位图使用的代码。它用来定义在将 pictur 绘制到 object 上时对 picture 执行的位操作（例如， vbMergeCopy 或 vbSrcAnd 操作符）。关于位操作符常数的完整列表，请参阅 Visual Basic Help 文件中的 RasterOp Constants 主题。 在使用opcode时有一些限制。例如，如果资源是图标或图元文件，则只能使用 vbSrcCopy，而不能使用其他的opcode；并且，与图案 (或 SDK 术语中的"画笔")，如 MERGECOPY、 PATCOPY、 PATPAINT 和 PATINVERT，相交互的opcode实际上是同目标的 FillStyle 属性交互。 注意 Opcode 用于将按位操作传递到位图。当传递其他图象类型时将一个值给该参数会造成“无效过程调用或参数”错误。这是设计的原因。要避免这个错误，对于除位图外的图象，将 Opcode 参数置为空。 说明 通过使用负的目标高度值 (height1) 和 / 或目标宽度值 (width1) ，可以水平或垂直翻转位图。 可以省略任何多个可选的尾部的参数 。如果省略了一个或多个可选尾部参数，则不能在指定的最后一个参数后面使用逗号。如果想指定某个可选参数，则必须先指定语法中出现在该参数前面的全部参数。 注意，在将一个.Bmp加载入 PictureBox 控件和使用 Windows API 函数 BitBlt() 添加图片之间有一点不同。当您对一个图象使用 BitBlt() 时，PictureBox 控件不知道象您使用 LoadPicture方法那样去调整大小。将 ScaleWidth 和 ScaleHeight 属性设置为图象的大小也不起作用。如果您想在使用 BitBlt 之后用 PictureBox 调整新图片的大小，必须用代码手工做，转换单位并处理边框，下面是如何这样做的一个简单示例： Sub ResizePictureBoxToImage(pic as PictureBox, twipWd _ as Integer, twipHt as Integer) ' 该代码假设所有的单位都为缇。如果 ' 不是，必须在调用该例程之前，转换为缇。 ' 这里也假设图象显示在0,0处。 Dim BorderHt as Integer, BorderWd as Integer BorderWd = Pic.Width - Pic.ScaleWidth BorderHt = Pic.Height - Pic.ScaleHeight pic.Move pic.Left, pic.Top, twipWd + BorderWd, _ twipHt + BorderHt End Sub

[无·法]

是我想的复杂了，用pset试了下速度还可以。 不知道做成dll供asp调用速度会怎样。

[me4405801]

使用 API。 用 GetDIBits得到图像数据的在内存中的指针，然后直接操作内存。

[舉杯邀明月]

做个标记。

如果在VB6的IDE中速度还可以，做成DLL也不会慢吧。
只是用Pset方法，处理小图片还行，
图片大了，耗时就太多了。

[熊孩子开学喽]

最简单快速的方法就是: 先作一个四色方块图:

然后将二维码图片bitblt到四色方块图上去, 光栅用SRCPAINT (&HEE0086)
+ =

[bcrun]

引用 4 楼 sysdzw 的回复:

是我想的复杂了，用pset试了下速度还可以。 不知道做成dll供asp调用速度会怎样。

楼主啊，人家通过GetDIBits 中转后直接处理数组数据，每秒能达到处理上百兆个像素的速度，你用PSet处理，速度好像只有每秒百K级吧，整整相差数百倍啊。当然，如果你只要这个速度就够了，那不妨用用。

[horizon_zpy]

支持楼主。代码值得一学。

[Tiger_Zhao]

你的二维码 300x300，我剪了 308*308 的黑白图作为 Mono.jpg。

VERSION 5.00
Begin VB.Form frmQRCode 
   Caption         =   "QRCode"
   ClientHeight    =   5520
   ClientLeft      =   60
   ClientTop       =   510
   ClientWidth     =   9675
   BeginProperty Font 
      Name            =   "Fixedsys"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   368
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   645
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdColor 
      Caption         =   "Color"
      Height          =   495
      Left            =   4200
      TabIndex        =   2
      Top             =   4920
      Width           =   1215
   End
   Begin VB.PictureBox picColor 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   4620
      Left            =   4920
      ScaleHeight     =   4620
      ScaleWidth      =   4620
      TabIndex        =   1
      Top             =   120
      Width           =   4620
   End
   Begin VB.PictureBox picMono 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   4620
      Left            =   120
      ScaleHeight     =   4620
      ScaleWidth      =   4620
      TabIndex        =   0
      Top             =   120
      Width           =   4620
   End
End
Attribute VB_Name = "frmQRCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdColor_Click()
    picColor.Cls
    picColor.Line (4, 4)-(154, 154), vbRed, BF
    picColor.Line (154, 4)-(304, 154), vbGreen, BF
    picColor.Line (4, 154)-(154, 304), vbBlue, BF
    picColor.Line (154, 154)-(304, 304), vbMagenta, BF
    picColor.PaintPicture picMono.Image, 0, 0, , , , , , , vbSrcPaint
End Sub

Private Sub Form_Load()
    Dim pic As StdPicture
    Set pic = LoadPicture(App.Path & "\Mono.jpg")
    
    picMono.AutoRedraw = True
    picMono.PaintPicture pic, 0, 0
    
    picColor.AutoRedraw = True
    picColor.ScaleMode = vbPixels
End Sub

[xzcw2000]

怎么处理转换，麻烦发一个参考代码，[e-mail],谢谢！