利用vb实现基本图形绘制，包括像素设置与提取，直线绘制，水平直线，垂直直线绘制 矩形，圆的边框绘制及填充，欢迎交流

类模块代码
Option Explicit
Private wp As Long
Private hp As Long
Private nColor As Long
Private wb As Long
Private hLine As Long
Private infoPtr As Long
Private bytePtr As Long
Private bi() As Long
Private byteBmp() As Byte

Private Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, ByVal lpBits As Long, ByVal lpBitsInfo As Long, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs

Private Const DIB_PAL_COLORS = 1 '  color table in palette indices
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Sub createBmp8Bit(w As Long, h As Long, nCorlor As Long)

 If nCorlor = 0 Or nCorlor > 1024 Then nCorlor = 1024
 
 ReDim bi(10 + nCorlor - 1)
 bi(0) = 40
 wp = w
 bi(1) = w
 hp = h
 bi(2) = h
 
 
bi(3) = 8& * 2 ^ 16 + 1&
 
 bi(8) = nCorlor
 bi(9) = nCorlor

bi(10) = 255 * 2 ^ 16 + 255 * 2 ^ 8 + 255
 bi(11) = 255 * 2 ^ 16 + 255 * 2 ^ 8
 bi(12) = 255 * 2 ^ 8 + 255
 bi(13) = 255 * 2 ^ 16 + 255
 bi(14) = 255 * 2 ^ 16
 bi(15) = 255 * 2 ^ 8
 bi(16) = 255
 bi(17) = 0
 wb = ((w + 3) \ 4) * 4
 If h > 0 Then
    hLine = h
    ElseIf h < 0 Then
    hLine = -h
    Else
    hLine = 1
    End If
 ReDim byteBmp(wb * hLine - 1)
 infoPtr = VarPtr(bi(0))
 bytePtr = VarPtr(byteBmp(0))

 
End Sub

Public Sub setpixel(x As Long, y As Long, color As Long)


If x >= 0 And x < wp And y >= 0 And y < hLine Then byteBmp(y * wb + x) = color
  
  
End Sub
Public Function getpixel(x As Long, y As Long) As Long


If x >= 0 And x < wp And y >= 0 And y < hLine Then
 getpixel = byteBmp(y * wb + x)
 Else
 getpixel = -1
 End If
 
End Function

Private Sub setpixel_(x As Long, y As Long, color As Long)

 byteBmp(y * wb + x) = color
End Sub
Private Function getpixel_(x As Long, y As Long) As Long
getpixel_ = byteBmp(y * wb + x)
End Function
Public Sub myLine(x1 As Long, y1 As Long, x2 As Long, y2 As Long, color As Long)
  Dim x As Long, y As Long
 Dim k As Long
 
 
 Dim dx As Long, dy As Long

 
 '''''''''' cut
 
 If x1 < 0 And x2 < 0 Or x1 >= wp And x2 >= wp _
    Or y1 < 0 And y2 < 0 Or y1 >= wp And y2 >= wp Then Exit Sub
 
  ''''''''''''cut
  
 '''''''''  1
 
  If x1 = x2 Then
   
   
    For y = IIf(y1 <= y2, y1, y2) To IIf(y1 > y2, y1, y2)
   
     
      setpixel x1, y, color
    Next
    Exit Sub
   End If
   
'''''''''  2
 
  If y1 = y2 Then
   
   
    For x = IIf(x1 <= x2, x1, x2) To IIf(x1 > x2, x1, x2)
   
     
      setpixel x, y1, color
    Next
    Exit Sub
   End If
   
   '''''''''
   If x1 > x2 Then
     x = x1
     x1 = x2
     x2 = x
     
     y = y1
     y1 = y2
     y2 = y
     End If
     If y1 > y2 Then
        y1 = -y1
        y2 = -y2
        k = -1
      Else
        k = 1
      End If
      
  '''''''''''''''''''
  dx = x2 - x1
  dy = y2 - y1
  
 '''''''''  3
   If dx = dy Then
   
     y = y1
         
       For x = x1 To x2
           setpixel x, y * k, color
         
           y = y + 1
         
       Next
   
    Exit Sub
   
   End If
   
   ''''''''''''''''''''
   
   Dim c1 As Long, c2 As Long, f As Long
   
   ''''''''''''''''''''''''''4
   If dx > dy Then
     
     c1 = dy + dy
     c2 = c1 - dx - dx
     f = c1 - dx
     x = x1
     y = y1
     setpixel x, y * k, color
    Do While x < x2
   
       x = x + 1
       If f < 0 Then
          f = f + c1
       Else
          f = f + c2
          y = y + 1
       End If
      
    setpixel x, y * k, color
   
    Loop
   
     Exit Sub
    End If
   
   
   '''''''''''''''''''''''''''''''''  5
   
   c1 = dx + dx
     c2 = c1 - dy - dy
     f = c1 - dy
     x = x1
     y = y1
     setpixel x, y * k, color
    Do While y < y2
   
       y = y + 1
       If f < 0 Then
          f = f + c1
       Else
          f = f + c2
          x = x + 1
       End If
      
    setpixel x, y * k, color
   
    Loop
   
End Sub

Public Sub vLine(x1 As Long, x2 As Long, y As Long, color As Long)
  If x1 < 0 And x2 < 0 Or x1 >= wp And x2 >= wp Or y < 0 Or y >= hLine Then Exit Sub
  If x1 < 0 Then x1 = 0
  If x2 < 0 Then x2 = 0
  If x1 >= wb Then x1 = wb - 1
  If x2 >= wb Then x2 = wb - 1
  Dim yb As Long, x As Long, k As Long
  yb = y * wb
  k = IIf(x1 < x2, 1, -1)
   
  For x = x1 To x2 Step k
    byteBmp(yb + x) = color
  Next
  
  
End Sub



Private Sub vLine_(x1 As Long, x2 As Long, y As Long, color As Long)
Dim yb As Long, x As Long, k As Long
  yb = y * wb
  k = IIf(x1 < x2, 1, -1)
   
  For x = x1 To x2 Step k
    byteBmp(yb + x) = color
  Next
End Sub

Public Sub hhLine(x As Long, y1 As Long, y2 As Long, color As Long)
  If x < 0 Or x >= wp _
   Or y1 < 0 And y2 < 0 Or y1 >= hLine And y2 >= hLine Then Exit Sub
  
  If y1 < 0 Then y1 = 0
  If y2 < 0 Then y2 = 0
  
  If y1 >= hLine Then y1 = hLine - 1
  If y2 >= hLine Then y2 = hLine - 1
  Dim y As Long, yb As Long, k As Long
  
  k = IIf(y1 < y2, 1, -1)
  yb = y1 * wb + x
  
  For y = y1 To y2 Step k
    byteBmp(yb) = color
    yb = yb + wb * k
  Next
  
  
End Sub



Private Sub hLine_(x As Long, y1 As Long, y2 As Long, color As Long)
Dim y As Long, yb As Long, k As Long
  
  k = IIf(y1 < y2, 1, -1)
  yb = y1 * wb + x
  
  For y = y1 To y2 Step k
    byteBmp(yb) = color
    yb = yb + wb * k
  Next
End Sub

Public Sub rectangle(x1 As Long, y1 As Long, x2 As Long, y2 As Long, color As Long)
  
  If x1 < 0 And x2 < 0 Or x1 >= wp And x2 >= wp _
   Or y1 < 0 And y2 < 0 Or y1 >= hLine And y2 >= hLine Then Exit Sub
  If x1 < 0 Then x1 = 0
  If x2 < 0 Then x2 = 0
  If y1 < 0 Then y1 = 0
  If y2 < 0 Then y2 = 0
  If x1 >= wb Then x1 = wb - 1
  If x2 >= wb Then x2 = wb - 1
  If y1 >= hLine Then y1 = hLine - 1
  If y2 >= hLine Then y2 = hLine - 1
  
  vLine_ x1, x2, y1, color
  vLine_ x1, x2, y2, color
  hLine_ x1, y1, y2, color
  hLine_ x2, y1, y2, color
  
End Sub




Public Sub fillRectangle(x1 As Long, y1 As Long, x2 As Long, y2 As Long, color As Long)
If x1 < 0 And x2 < 0 Or x1 >= wp And x2 >= wp _
   Or y1 < 0 And y2 < 0 Or y1 >= hLine And y2 >= hLine Then Exit Sub
  If x1 < 0 Then x1 = 0
  If x2 < 0 Then x2 = 0
  If y1 < 0 Then y1 = 0
  If y2 < 0 Then y2 = 0
  If x1 >= wb Then x1 = wb - 1
  If x2 >= wb Then x2 = wb - 1
  If y1 >= hLine Then y1 = hLine - 1
  If y2 >= hLine Then y2 = hLine - 1
  
  Dim x As Long, y As Long, ob As Long, kx As Long, ky As Long
  
  kx = IIf(x1 < x2, 1, -1)
  ky = IIf(y1 < y2, 1, -1)
  ob = y1 * wb + x1
  For y = y1 To y2 Step ky
    For x = x1 To x2 Step kx
       byteBmp(ob + x) = color
    Next
    ob = ob + wb * ky
   Next
   
End Sub

Public Sub cre(x As Long, y As Long, r As Long, color As Long)
   Dim xx As Long, yy As Long, f As Long
   xx = 0
   yy = r
   setpixel x + xx, y + yy, color
    setpixel x + xx, y - yy, color
    setpixel x + yy, y + xx, color
    setpixel x - yy, y + xx, color
   
    f = 3 - r + r
    Do While 1
   
       If f < 0 Then
          f = f + xx * 4 + 6
        Else
          f = f + (xx - yy) * 4 + 10
          yy = yy - 1
        End If
        xx = xx + 1
        
        If xx = yy Then
            setpixel x + xx, y + yy, color
            setpixel x - xx, y - yy, color
             setpixel x + xx, y - yy, color
            setpixel x - xx, y + yy, color
            Exit Do
        ElseIf xx < yy Then
        
           setpixel x + xx, y + yy, color
           setpixel x + xx, y - yy, color
           setpixel x - xx, y + yy, color
           setpixel x - xx, y - yy, color
           setpixel x + yy, y + xx, color
           setpixel x + yy, y - xx, color
           setpixel x - yy, y + xx, color
           setpixel x - yy, y - xx, color
        Else
           Exit Do
        End If
           
   
    Loop
   
End Sub

Public Sub fillCre(x As Long, y As Long, r As Long, color As Long)
 Dim xx As Long, yy As Long, f As Long
   xx = 0
   yy = r
   setpixel x + xx, y + yy, color
    setpixel x + xx, y - yy, color
    vLine x + yy, x - yy, y + xx, color
   
    f = 3 - r + r
    Do While 1
   
       If f < 0 Then
          f = f + xx * 4 + 6
        Else
          f = f + (xx - yy) * 4 + 10
          yy = yy - 1
        End If
        xx = xx + 1
        If xx = yy Then
            vLine x + xx, x - xx, y + yy, color
           vLine x + xx, x - xx, y - yy, color
           Exit Do
           
        ElseIf xx < yy Then
        
           vLine x + xx, x - xx, y + yy, color
           vLine x + xx, x - xx, y - yy, color
           
           vLine x + yy, x - yy, y + xx, color
           vLine x + yy, x - yy, y - xx, color
         Else
            Exit Do
         End If
           
   
    Loop
   
End Sub

Public Sub clsBmp8()
Dim i As Long
For i = 0 To wb * hLine - 1
  byteBmp(i) = 0
 Next
  
End Sub

Public Sub transmitBmp8(hDC As Long, x As Long, y As Long)

 StretchDIBits hDC, x, y, wp, hp, 0, 0, wp, hp, bytePtr, infoPtr, DIB_RGB_COLORS, SRCCOPY
End Sub



Private Sub Class_Terminate()
  Erase byteBmp
  Erase bi
End Sub

测试代码及效果图

Option Explicit

Dim clsBm As New clsBmp8

Private Sub cmdOK_Click()
 clsBm.clsBmp8
 clsBm.rectangle 505, 300, 50, 100, 4

clsBm.rectangle 159, 300, 59, 20, 2
 clsBm.fillRectangle 50, 1300, 250, 20, 1

clsBm.fillRectangle 50, 520, 450, 120, 3
 clsBm.transmitBmp8 Me.Picture1.hDC, 0, 0
Me.Picture1.Refresh
End Sub

Private Sub Command2_Click()
clsBm.myLine 505, 300, 50, 100, 4

clsBm.myLine 159, 300, 59, 20, 2
clsBm.myLine 50, 1300, 50, 20, 1

clsBm.myLine 50, 520, 450, 120, 3
clsBm.myLine 505, 300, 150, 100, 4
clsBm.fillCre 159, 300, 59, 1
clsBm.cre 319, 200, 159, 2

clsBm.transmitBmp8 Me.Picture1.hDC, 0, 0
Me.Picture1.Refresh
End Sub

Private Sub Form_Load()
  
  
  clsBm.createBmp8Bit 600, 400, 8
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set clsBm = Nothing
End Sub

画个图形，还要用API，简单的问题复杂化处理了。

我是能不用API，就不用API的。因为代码较多较复杂。

Private byteBmp() As Byte '定义，字节类型

  For x = x1 To x2 Step k         '循环步进 1 或 -1
byteBmp(ob + x) = color   ‘使用，color 是 long 类型，占4字节，这样不报错吗？？？

像素颜色使用1个byte(8位)的使用的BMP是256色 ，bi 应该是颜色表吧！问题是你的 bi 的下标到了 1024 去了。这不超范围了吗？

--------------
我这个贴子里的代码包含内存绘图，你可以参考一下，纯 VB6 代码，未使用 API，只实现了画空心圆、实心圆，画点。要求系统设置为真彩（无检测）。
https://bbs.bccn.net/thread-481230-1-1.html

Private byteBmp() As Byte '定义，字节类型

  For x = x1 To x2 Step k         '循环步进 1 或 -1
byteBmp(ob + x) = color   ‘使用，color 是 long 类型，占4字节，这样不报错吗？？？

像素颜色使用1个byte(8位)的使用的BMP是256色 ，bi 应该是颜色表吧！问题是你的 bi 的下标到了 1024 去了。这不超范围了吗？

。。。。。。。。。。。。。。。。。。。。。。。。。。。

这是一个图形绘制的基本练习，目的是实现一个练习图形算法的基础环境，其中有些不完善的地方，关于颜色处理，没有实现颜色值与颜色表序号相互转换函数，代码中只是用颜色表序号直接代替，这样不影响算法实现。
 byteBmp()数组是存储像素阵列的缓冲区，基于颜色表的位图一般都是定义为字节型的，你可以做不同的解释。

BMP是256色，颜色表最大1024项，但是可以定制，程序中保留8项，使用8项，使用数也是可以变化的

bi是位图信息表，里面包括颜色表，bi里面填写了一些必要信息，这样能够利用gdi函数把内存缓冲区数据发送给显示环境