记得十几年前写几个游戏辅助工具的时候用过这个功能，这几天想直接把图片控件的数据转换为 PNG 文件不想用存出 BMP 文件交换，直接取得图像数据操作即可，但是忘记了当初是怎么做的了，找到个 2007 年的例子好像不太对，运行直接关闭，后来找到个 2008 年的大家来找茬辅助工具后，终于运行正确了，简单优化一下，先实现由获取的数组数据保存为 BMP 文件，以此记录，省得以后又忘记了：

正确运行后应该可以保存出这张图片：

Option ExplicitDim bi24BitInfo As BITMAPINFO, bmHead As bmfh '位图文件头
Dim BMLineBytes As Long, BMpicByte As Integer, BMTrueLineBytes As LongPrivate Sub Command1_Click()Dim Col() As Byte, fp, fnWith Pic_DTWith .Font.Name = "Arial"      ' 字体名称.Size = 40           ' 字体大小.Bold = True         ' 加粗End With.CurrentX = 0.CurrentY = 0.ForeColor = vbRed ' 设置前景色为红色End WithPic_DT.Print "Hello, VB6!"Call DibGetP(Pic_DT, Col())        '----从 picbox 直接提取图像数据With bmHead                 '----构造文件头.bfType = bfTypeBM.bfSize = Len(bmHead) + bi24BitInfo.bmiHeader.biSize + bi24BitInfo.bmiHeader.biSizeImage.bfOffBits = 54End Withfp = FreeFile: Open App.Path & "\p.bmp" For Output As #fp: Close #fp    '---清除文件fp = FreeFileOpen App.Path & "\p.bmp" For Binary As #fp                              '---写入数据Put #fp, , bmHeadPut #fp, , bi24BitInfo.bmiHeaderPut #fp, , ColClose #fp
End SubPrivate Sub DibGetP(PicBox, Col() As Byte) ', XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)Dim I As LongDim W As LongDim H As LongDim Bits As LongDim InPutHei As Long '用于记录输入图像的高度Col() As ByteDim InPutWid As Long '用于记录输入图像的宽度Dim iBitmap As LongOn Error GoTo ErrLineInPutWid = PicBox.Width - 1   ' XEnd - XBeginInPutHei = PicBox.Height - 1  ' YEnd - YBeginW = InPutWid + 1H = InPutHei + 1Bits = 24I = (Bits \ 8) - 1BMLineBytes = ((W * Bits + 31) And &HFFFFFFE0) \ 8 '每一扫描行的字节数必需是4的整倍数，也就是DWORD对齐的
BMpicByte = Bits / 8
BMTrueLineBytes = W * BMpicByteWith bi24BitInfo.bmiHeader.biBitCount = Bits.biCompression = 0&.biPlanes = 1.biSize = Len(bi24BitInfo.bmiHeader).biSizeImage = BMLineBytes * H.biWidth = W.biHeight = HEnd With'BMLineBytes = ((Bmfd.bmInfo.bmiHeader.biWidth * Bmfd.bmInfo.bmiHeader.biBitCount + 31) And &HFFFFFFE0) \ 8 '每一扫描行的字节数必需是4的整倍数，也就是DWORD对齐的
'BMpicByte = Bmfd.bmInfo.bmiHeader.biBitCount / 8
'BMTrueLineBytes = Bmfd.bmInfo.bmiHeader.biWidth * BMpicByte
'ReDim Bmfd.bmDate(BMLineBytes - 1, Bmfd.bmInfo.bmiHeader.biHeight - 1) '(x,y)(列，行)iBitmap = GetCurrentObject(PicBox.hdc, 7&)'ReDim Col(I, InPutWid, InPutHei)'(RGB,x,y)(列，行)                     '--三种不同的数据数组定义方式对应不同的用法。
'GetDIBits PicBox.hdc, iBitmap, 0&, H, Col(0, 0, 0), bi24BitInfo, 0&'ReDim Col(BMLineBytes * H - 1) '(RGB)(列，行)
'GetDIBits PicBox.hdc, iBitmap, 0&, H, Col(0), bi24BitInfo, 0&ReDim Col(BMLineBytes - 1, H - 1) '(x,y)(列，行)
GetDIBits PicBox.hdc, iBitmap, 0&, H, Col(0, 0), bi24BitInfo, 0&DeleteObject iBitmapExit Sub
ErrLine:MsgBox "错误号：" & Err.Number & "：" & Err.Description
End Sub

BMP 文件相关定义见：[原]BMP位图 转换 透明 TGA图像 － 增加 alpha通道 －TGA文件格式初解_.bmp alpha通道-CSDN博客

其他 API 函数定义略。

此记。