1.vb 部分截屏之后识别上的源码文字
2.VB 区域截图问题
3.帮我看看我的VB截屏作图程序的问题

vb 部分截屏之后识别上的文字

       主要是先要将转换为字节数组

       '存放格式为(*, *, *),从左下角开始:

       '第一维:0-蓝色分量,1-绿色分量,2-红色分量,

       '第二维:列；第三维:行

       全部步骤如下

       1、用DibGet获取数据

       2、区域用ColorToBlackAndWhite（或ColorToGray+OtsuColorToBlackAndWhite）将数据转换为黑白数据

       3、截屏用DibPut将数据恢复到一个PictureBox中

       4、源码短信轰炸网页源码截取各个数字到单独的区域PictureBox中

       5、将数字转换为数据，截屏qq竞猜 源码 下载并与标准数据（0-9）对比，源码相似度最高的区域为准（比如与1的相似度为%，与2的截屏相似度为%，则此数字为2）

       有问题Hi

       '图像输出的源码过程:

       Public Sub DIBPut(ByVal IdDestination As Long, ByRef ImageData() As Byte)

        Dim LineBytes As Long

        Dim Width As Long, Height As Long

        Width = UBound(ImageData, 2) + 1

        Height = UBound(ImageData, 3) + 1

        On Error GoTo ErrLine

        Done = False

        With biBitInfo.bmiHeader

        .biWidth = Width

        .biHeight = Height

        LineBytes = ((Width * Bits + ) And &HFFFFFFE0) \ 8

        .biSizeImage = LineBytes * Height

        End With

        SetDIBitsToDevice IdDestination, 0, 0, Width, Height, 0, 0, 0, Height, ImageData(0, 0, 0), biBitInfo, 0

        Done = True

        Exit Sub

       ErrLine:

        MsgBox Err.Description

       End Sub

       '灰度处理SrcData(0 to 2, 0 to 宽度-1, 0 to 高度-1)

       Public Sub ColorToGray(ByRef SrcData() As Byte, ByRef DestData() As Byte, _

        Optional Left As Long = -1, Optional Top As Long = -1, _

        Optional Right As Long = -1, Optional Bottom As Long = -1)

        Dim i As Long, j As Long, k As Long

        Dim red As Byte, green As Byte, blue As Byte

        Dim Color As Long, newcolor As Long

        Dim Width As Long, Height As Long

        Width = UBound(SrcData, 2) + 1

        Height = UBound(SrcData, 3) + 1

        If Left = -1 Then Left = 0

        If Top = -1 Then Top = 0

        If Right = -1 Then Right = Width - 1

        If Bottom = -1 Then Bottom = Height - 1

        For j = Left To Right

        For k = Height - Bottom - 1 To Height - Top - 1

        blue = SrcData(0, j, k)

        green = SrcData(1, j, k)

        red = SrcData(2, j, k)

        newcolor = CLng(0. * CDbl(red) + 0. * CDbl(green) + 0. * CDbl(blue)) '

        newcolor = newcolor *

        red = newcolor Mod

        green = newcolor / Mod '( * RValue + * GValue + * BValue) /

        blue = newcolor / /

        DestData(0, j, k) = blue

        DestData(1, j, k) = green

        DestData(2, j, k) = red

        Next

        Next

       End Sub

       '黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)

       '最下面两行总是无法参与变换只好将采集的区域向下多延伸2个像素

       Public Sub ColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)

        Dim i As Long, j As Long, k As Long

        Dim red As Byte, green As Byte, blue As Byte

        Dim Color As Long, newcolor As Long

        Dim Width As Long, Height As Long

        Width = UBound(SrcData, 2) + 1

        Height = UBound(SrcData, 3) + 1

        For j = 0 To Width - 1

        For k = 0 To Height - 1

        blue = SrcData(0, j, k)

        green = SrcData(1, j, k)

        red = SrcData(2, j, k)

        newcolor = CLng(0.3 * CDbl(red) + 0. * CDbl(green) + 0. * CDbl(blue))

       ' newcolor = CLng(0. * CDbl(red) + 0.5 * CDbl(green) + 0. * CDbl(blue))

        If newcolor > Then newcolor = Else newcolor = 0

        red = newcolor

        green = newcolor

        blue = newcolor

        DestData(0, j, k) = blue

        DestData(1, j, k) = green

        DestData(2, j, k) = red

        Next

        Next

       End Sub

       '黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)

       '最下面两行总是无法参与变换只好将采集的区域向下多延伸2个像素

       'OSTU算法可以说是自适应计算单阈值（用来转换灰度图像为二值图像）的简单高效方法。

       ' OTSU年提出的区域最大类间方差法以其计算简单、稳定有效，截屏一直广为使用。源码att2 源码

       Public Sub OtsuColorToBlackAndWhite(ByRef SrcData() As Byte,区域 ByRef DestData() As Byte)

       On Error Resume Next

        Dim i As Long, j As Long, k As Long

        Dim red As Byte, green As Byte, blue As Byte

        Dim Color As Long, newcolor As Long

        Dim Width As Long, Height As Long

        Dim AllSum As Long, SumSmall As Long, SumBig As Long, PartSum As Long

        Dim AllPixelNumber As Integer, PixelNumberSmall As Long, PixelNumberBig As Long

        Dim ProbabilitySmall As Double, ProbabilityBig As Double, Probability As Double, MaxValue As Double

        Dim BmpData() As Byte, Threshold As Byte

        Dim Histgram() As Integer '图像直方图，个点

        Dim PixelNumber As Integer

        Width = UBound(SrcData,截屏 2) + 1

        Height = UBound(SrcData, 3) + 1

        PixelNumber = Width * Height

        For i = 0 To Width - 1

        For j = 0 To Height - 1

        Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图

        Next

        Next

        For i = 0 To

        AllSum = AllSum + i * Histgram(i) ' 质量矩

        AllPixelNumber = AllPixelNumber + Histgram(i) ' 质量

        Next

        MaxValue = -1#

        For i = 0 To

        PixelNumberSmall = PixelNumberSmall + Histgram(i)

        PixelNumberBig = AllPixelNumber - PixelNumberSmall

        If PixelNumberBig = 0 Then Exit For

        SumSmall = SumSmall + i * Histgram(i)

        SumBig = AllSum - SumSmall

        ProbabilitySmall = CDbl(SumSmall) / PixelNumberSmall

        ProbabilityBig = CDbl(SumBig) / PixelNumberBig

       ' Probability = PixelNumberSmall * PixelNumberBig * (ProbabilityBig - ProbabilitySmall) * (ProbabilityBig - ProbabilitySmall)

        Probability = PixelNumberSmall * ProbabilitySmall * ProbabilitySmall + PixelNumberBig * ProbabilityBig * ProbabilityBig

        If Probability > MaxValue Then

        MaxValue = Probability

        Threshold = i

        End If

        Next

        For j = 0 To Width - 1

        For k = 0 To Height - 1

        If SrcData(0, j, k) <= Threshold Then

        DestData(0, j, k) = 0

        DestData(1, j, k) = 0

        DestData(2, j, k) = 0

        Else

        DestData(0, j, k) =

        DestData(1, j, k) =

        DestData(2, j, k) =

        End If

        Next

        Next

       End Sub

       '迭代法 (最佳阀值法)

       '(1)求出图象的最大灰度值和最小灰度值，分别记为Zl和Zk，擒牛博奕源码令初始阈值为：T=(Zl+Zk)/2

       '(2)根据阈值TK将图象分割为前景和背景，分别求出两者的平均灰度值Z0和ZB:

       '(3)令当前阈值Tk=(Z0+ZB)/2

       '(4)若TK=TK+1， 则所得即为阈值，今天优品 源码否则转2，迭代计算。

       Public Sub BestThresholdColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)

        Dim i As Long, j As Long, k As Long

        Dim red As Byte, green As Byte, blue As Byte

        Dim Color As Long, newcolor As Long

        Dim Width As Long, Height As Long

        Dim PixelNumber As Integer

        Dim Threshold As Integer, NewThreshold As Integer, MaxGrayValue As Integer

        Dim MinGrayValue As Integer, MeanGrayValue1 As Integer, MeanGrayValue2 As Integer

        Dim IP1 As Long, IP2 As Long, IS1 As Long, IS2 As Long

        Dim Iteration As Long, Histgram() As Integer

       Width = UBound(SrcData, 2) + 1

        Height = UBound(SrcData, 3) + 1

        PixelNumber = Width * Height

        '求出图像中的最小和最大灰度值，并 计算阈值初值为

        MaxGrayValue = 0: MinGrayValue =

        For i = 0 To Width - 1

        For j = 0 To Height - 1

        Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图

        If MinGrayValue > SrcData(0, i, j) Then MinGrayValue = SrcData(0, i, j)

        If MaxGrayValue < SrcData(0, i, j) Then MaxGrayValue = SrcData(0, i, j)

        Next

        Next

       NewThreshold = (MinGrayValue + MaxGrayValue) / 2

        While Threshold <> NewThreshold And Iteration <

        Threshold = NewThreshold

        '根据阈值将图像分割成目标和背景两部分，求出两部分的平均灰度值

        For i = MinGrayValue To Threshold

        IP1 = IP1 + Histgram(i) * i

        IS1 = IS1 + Histgram(i)

        Next

        MeanGrayValue1 = CByte(IP1 / IS1)

        For i = Threshold + 1 To MaxGrayValue

        IP2 = IP2 + Histgram(i) * i

        IS2 = IS2 + Histgram(i)

        Next

        MeanGrayValue2 = CByte(IP2 / IS2)

        '求出新的阈值：

        NewThreshold = (MinGrayValue + MaxGrayValue) / 2

        Iteration = Iteration + 1

        Wend

        For j = 0 To Width - 1

        For k = 0 To Height - 1

        If SrcData(0, j, k) <= Threshold Then

        DestData(0, j, k) = 0

        DestData(1, j, k) = 0

        DestData(2, j, k) = 0

        Else

        DestData(0, j, k) =

        DestData(1, j, k) =

        DestData(2, j, k) =

        End If

        Next

        Next

       End Sub

VB 区域截图问题

       窗体的Image区域尺寸默认就是屏幕的整个区域。你可以改用PictureBox：

       Me.ScaleMode = 3

       Picture1.AutoRedraw = True

       Picture1.BorderStyle = 0

       Picture1.Width =

       Picture1.Height =

       BitBlt Picture1.hDC, 0, 0, , , GetDC(0), 0, 0, vbSrcCopy

       SavePicture Picture1.Image, "c:\temp\1.bmp"

帮我看看我的VB截屏作图程序的问题

       没有问题制造问题也要回答,下边是一个截屏并保存为的代码,你参考一下吧

       Begin VB.Form Form1

        Caption = "Form1"

        ClientHeight =

        ClientLeft =

        ClientTop =

        ClientWidth =

        LinkTopic = "Form1"

        ScaleHeight =

        ScaleWidth =

        StartUpPosition = 3 '窗口缺省

        Begin VB.PictureBox Picture1

        Height =

        Left =

        ScaleHeight =

        ScaleWidth =

        TabIndex = 1

        Top =

        Width =

        End

        Begin VB.CommandButton Command1

        Caption = "Command1"

        Height =

        Left =

        TabIndex = 0

        Top = 0

        Width =

        End

       End

       Attribute VB_Name = "Form1"

       Attribute VB_GlobalNameSpace = False

       Attribute VB_Creatable = False

       Attribute VB_PredeclaredId = True

       Attribute VB_Exposed = False

       Private Declare Sub keybd_event Lib "user" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

       Const theScreen = 0

       Const theForm = 1

       Private Sub Form_Load()

       Me.Visible = False

       App.TaskVisible = False

       Call keybd_event(vbKeySnapshot, theScreen, 0, 0)

       DoEvents

       Picture1.Picture = Clipboard.GetData(vbCFBitmap)

       DoEvents

       VB.SavePicture Picture1.Picture, "c:\1.jpg"

       End

       End Sub