将Picture的图像转成一数组(RGB888,RGB565)

Question

将Picture的图像转成一数组(RGB888,RGB565)

Answer 1

http://www.mentalis.org/apilist/AF7BEA96A353CD96C37F664EF9905EE1.html

Answer 2

RGB888能不能转成RGB565,不是简单的去低位?

Answer 3

一般RGB888转RGB565好像都是去低位，但我做试验用WINDOWS得出的16位数据不是简单的去低位，WINDOWS转出来的数据打在屏幕上比[去低位]的更平滑。我想知道WINDOWS是如何转的？

Answer 4

以下代码放在模块里
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Const SRCCOPY = &HCC0020
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0&
Private Const LR_LOADFROMFILE = &H10
Private Const IMAGE_BITMAP = 0&Private iDATA() As Byte            '保留位图信息
Private bDATA() As Byte            '备份位图信息
Private cdata() As Byte
Private edata() As Byte
Private PicInfo As BITMAP         '定义位图信息结构
Private DIBInfo As BITMAPINFO     'Device Ind. Bitmap info structure
Private mProgress As Long         '% 操作进程
Private Speed(0 To 765) As Long   '处理参数
Private dred(0 To 255), dgreen(0 To 255), dblue(0 To 255), dgray(0 To 255) As Long
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End TypeType BITMAPINFOHEADER              '40 bytes
   biSize As Long                  'BITMAPINFOHEADER结构的大小
   biWidth As Long
   biHeight As Long
   biPlanes As Integer             '设备的为平面数，现在都是1
   biBitCount As Integer           '图像的颜色位图
   biCompression As Long           '压缩方式
   biSizeImage As Long             '实际的位图数据所占字节
   biXPelsPerMeter As Long         '目标设备的水平分辨率
   biYPelsPerMeter As Long         '目标设备的垂直分辨率
   biClrUsed As Long               '使用的颜色数
   biClrImportant As Long          '重要的颜色数。如果该项为0，表示所有颜色都是重要的
End Type
  
Type RGBQUAD                        ' 只有bibitcount为1，2，4时才有调色板
   rgbBlue As Byte                  '蓝色分量
   rgbGreen As Byte                 '绿色分量
   rgbRed As Byte                   '红色分量
   rgbReserved As Byte              '保留值
End TypeType BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type
Public Enum iFilterG '自定义的枚举常量
igray=1   '彩色转灰度
iaddnoise=2  '添加噪音
idiaoke=3    '雕刻效果    等等
End Enum
Public Sub FilterG(ByVal Filtro As iFilterG, ByVal pic As Long, ByVal factor As Long, ByRef pprogress As Long)
  Dim hdcNew As Long
  Dim oldhand As Long
  Dim ret As Long
  Dim BytesPerScanLine As Long    '一个扫描行的长度
  Dim PadBytesPerScanLine As Long
  If WorkFilterG = True Then Exit Sub
  WorkFilterG = True
  On Error GoTo FilterError:
'get data buffer
  Call GetObject(pic, Len(PicInfo), PicInfo)         '取得对指定对象进行说明的一个结构，hobject为位图，刷子等的句柄，
                                                      'count欲取回的字节数。通常是由lpObject定义的那个结构的长度
  hdcNew = CreateCompatibleDC(0&)                    '创建一个与屏幕兼容的设备场景
  oldhand = SelectObject(hdcNew, pic)
  With DIBInfo.bmiHeader
    .biSize = 40                                       'bmp3.0
    .biWidth = PicInfo.bmWidth
    .biHeight = -PicInfo.bmHeight     '从下往上扫描
    .biPlanes = 1
    .biBitCount = 32                 '32位位图，默认情况下Windows不会处理最高8位，可以将它作为自己的Alpha通道
    .biCompression = BI_RGB          '无压缩
    BytesPerScanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)  '一个扫描行的长度，是4的倍数。
    PadBytesPerScanLine = _
    BytesPerScanLine - (((.biWidth * .biBitCount) + 7) \ 8)
    .biSizeImage = BytesPerScanLine * Abs(.biHeight)
  End With  'redimension  (BGR+pad,x,y)
  ReDim iDATA(1 To 4, 1 To PicInfo.bmWidth, 1 To PicInfo.bmHeight) As Byte
  ReDim bDATA(1 To 4, 1 To PicInfo.bmWidth, 1 To PicInfo.bmHeight) As Byte  'get bytes
  ret = GetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, iDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
               '将来自一幅位图的二进制位复制到一幅与设备无关的位图里
              ' 该函数利用申请到的内存，由GDI位图得到DIB位图数据，可以对DIB的格式进行控制，通过该函数，
                '可以制定颜色的位数，而且可以指定是否进行压缩。如果采用了压缩方式，则必须调用该函数两次，
                '一次为了得到所需内存，另外一次为了得到位图数据
                '定义了与设备有关位图hBitmap的配置信息的一个设备场景的句柄
                'hbmp 源位图的句柄
                'uStartScan为欲复制到dib中的第一条扫描线的位置
                'cScanLines欲复制的扫描先的数量
                'ipvbits 指向一个缓冲区的指针
                '指向BITMAPINF，对DIB的格式及颜色进行说明的一个结构。
                '颜色表包含了RGB颜色
                'idata(1,x,y)表示b的颜色
                
  ret = GetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, bDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)Select Case Filtro
case igray:    call gray(pprogress)
case iaddnoise:  call smooth(pprogress,factor)
case idiaoke:  call diaoke(pprogress)
End Select
  '将数组传递给设备
ret = SetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, iDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
               '将来自与设备无关位图的二进制位复制到一幅与设备有关的位图里SelectObject hdcNew, oldhand
  DeleteDC hdcNew
  ReDim iDATA(1 To 4, 1 To 2, 1 To 2) As Byte
  ReDim bDATA(1 To 4, 1 To 2, 1 To 2) As Byte
  WorkFilterG = False
  Exit Sub
FilterError:
  MsgBox "Filter Error"
  WorkFilterG = False
End Sub

Answer 5

还是模块中的内容Private Sub gray(ByRef pprogress As Long)
  Dim x As Long, y As Long
  mProgress = 0
  For y = 1 To PicInfo.bmHeight
    For x = 1 To PicInfo.bmWidth
      B = iDATA(1, x, y)
      G = iDATA(2, x, y)
      R = iDATA(3, x, y)
      rgb1 = (R + G + B) / 3
      iDATA(1, x, y) = rgb1
      iDATA(2, x, y) = rgb1
      iDATA(3, x, y) = rgb1
     Next x
    mProgress = (y * 100) \ PicInfo.bmHeight
    pprogress = mProgress
    DoEvents
  Next y
  pprogress = 100
  DoEvents
End SubPrivate Sub addnoise(ByRef pprogress As Long, ByVal factor As Long)
  Dim x As Long, y As Long
  Dim R As Long, G As Long, B As Long
  Dim V As Long
    
  mProgress = 0
  For y = 1 To PicInfo.bmHeight
    For x = 1 To PicInfo.bmWidth
      B = CLng(bDATA(1, x, y)) + ((factor * 2 + 1) * Rnd - factor)
      G = CLng(bDATA(2, x, y)) + ((factor * 2 + 1) * Rnd - factor)
      R = CLng(bDATA(3, x, y)) + ((factor * 2 + 1) * Rnd - factor)
      If R > 255 Then R = 255
      If R < 0 Then R = 0
      If G > 255 Then G = 255
      If G < 0 Then G = 0
      If B > 255 Then B = 255
      If B < 0 Then B = 0
      iDATA(1, x, y) = B
      iDATA(2, x, y) = G
      iDATA(3, x, y) = R
    Next x
    mProgress = (y * 100) \ PicInfo.bmHeight
    pprogress = mProgress
    DoEvents
  Next y
  pprogress = 100
  DoEvents
End SubPrivate Sub diaoke(ByRef pprogress As Long)
  Dim x As Long, y As Long
  Dim R As Long, G As Long, B As Long
  mProgress = 0
  For y = 2 To PicInfo.bmHeight - 1
    For x = 2 To PicInfo.bmWidth - 1
      B = 2 * CLng(bDATA(1, x - 1, y - 1)) + CLng(bDATA(1, x - 1, y)) + _
          CLng(bDATA(1, x, y - 1)) - CLng(bDATA(1, x, y + 1)) - _
          CLng(bDATA(1, x + 1, y)) - 2 * CLng(bDATA(1, x + 1, y + 1))
      G = 2 * CLng(bDATA(2, x - 1, y - 1)) + CLng(bDATA(2, x - 1, y)) + _
          CLng(bDATA(2, x, y - 1)) - CLng(bDATA(2, x, y + 1)) - _
          CLng(bDATA(2, x + 1, y)) - 2 * CLng(bDATA(2, x + 1, y + 1))
      R = 2 * CLng(bDATA(3, x - 1, y - 1)) + CLng(bDATA(3, x - 1, y)) + _
          CLng(bDATA(3, x, y - 1)) - CLng(bDATA(3, x, y + 1)) - _
          CLng(bDATA(3, x + 1, y)) - 2 * CLng(bDATA(3, x + 1, y + 1))
      B = (CLng(bDATA(1, x, y)) + B) \ 2 + 50
      G = (CLng(bDATA(2, x, y)) + G) \ 2 + 50
      R = (CLng(bDATA(3, x, y)) + R) \ 2 + 50
      If R > 255 Then R = 255
      If R < 0 Then R = 0
      If G > 255 Then G = 255
      If G < 0 Then G = 0
      If B > 255 Then B = 255
      If B < 0 Then B = 0
      iDATA(1, x, y) = B
      iDATA(2, x, y) = G
      iDATA(3, x, y) = R
    Next x
    mProgress = (y * 100) \ PicInfo.bmHeight
    pprogress = mProgress
    DoEvents
  Next y
  pprogress = 100
  DoEvents
End Sub

Answer 6

窗体中：  一个picture控件，一个定时
Private Sub gray_Click()
Screen.MousePointer = 11
Timer1.Enabled = True
  Call FilterG(igray, Picture1.Image, 0, mProgress)
  Picture1.Refresh
  Screen.MousePointer = 1End SubPrivate Sub addnoise_Click()
  On Error Resume Next
  Screen.MousePointer = 11
 Timer1.Enabled = True  Call FilterG(iaddnoise, Picture1.Image, InputBox("请输入噪音系数", "噪音系数", 50), mProgress)
Picture1.Refresh
 Screen.MousePointer = 1
End Sub

Answer 7

关于获得图像像素颜色的方法，可以参考此贴;
http://community.csdn.net/Expert/topic/3252/3252001.xml?temp=.8577387关于888转565的方法：
一般是用去低位的方法比较快速，如果要考虑到前后的颜色转换失真小，则因该对每个颜色分量进行统计降序排列，取排序在前的。
比如：红色由256级（888）转换到32级（565），则应该将该图片中所有点的红色统计下来，得到一个统计值，取最多的32种红色，其他的取和前面得到的32种红色最相近的代替。
其他颜色也是如此。这样就可以得到和原来相差很小的图像了。