VB中怎样画图并保存在文件中

Question

Picture1.AutoRedraw=True
Picture1.ScaleMode=3
Picture1.Line (0,0)-(100,100)
Picture1.Refresh
Call SavePicture(Picture1.Image,"c:\test.bmp")

Answer 1

SavePicture 语句示例
本例使用 SavePicture 语句保存画在 Form 对象的 Picture 属性中的图形。要试用此例，可将以下代码粘贴到 Form 对象的声明部分，然后运行此例，单击 Form 对象。Private Sub Form_Click ()
   ' 声明变量。
   Dim CX, CY, Limit, Radius   as Integer, Msg as String
   ScaleMode = vbPixels   ' 设置比例模型为像素。
   AutoRedraw = True ' 打开 AutoRedraw。
   Width = Height   ' 改变宽度以便和高度匹配。
   CX = ScaleWidth / 2   ' 设置 X 位置。
   CY = ScaleHeight / 2   ' 设置 Y 位置。
   Limit = CX   ' 圆的尺寸限制。
   For Radius = 0 To Limit   ' 设置半径。
      Circle (CX, CY), Radius, RGB(Rnd * 255, Rnd * 255, Rnd * 255)
      DoEvents   ' 转移到其它操作。
   Next Radius
   Msg = "Choose OK to save the graphics from this form "
   Msg = Msg & "to a bitmap file."
   MsgBox Msg
   SavePicture Image, "TEST.BMP"   ' 将图片保存到文件。
End Sub

Answer 2

'====================================================
'把以下内容贴到记事本,再另存为Form1.frm
'====================================================
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "MyCAD"
   ClientHeight    =   4995
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   7050
   DrawMode        =   6  'Mask Pen Not
   LinkTopic       =   "Form1"
   MouseIcon       =   "Form1.frx":0000
   ScaleHeight     =   4995
   ScaleWidth      =   7050
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00000000&
      DrawMode        =   7  'Invert
      Height          =   1272
      Left            =   0
      MouseIcon       =   "Form1.frx":030A
      MousePointer    =   99  'Custom
      ScaleHeight     =   1215
      ScaleWidth      =   2565
      TabIndex        =   0
      Top             =   10
      Width           =   2628
      Begin VB.Line Line2 
         BorderColor     =   &H00FFFFFF&
         X1              =   960
         X2              =   960
         Y1              =   120
         Y2              =   960
      End
      Begin VB.Line Line1 
         BorderColor     =   &H00FFFFFF&
         X1              =   600
         X2              =   1395
         Y1              =   525
         Y2              =   525
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuSave 
         Caption         =   "保存"
      End
      Begin VB.Menu mnuQuit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Dim command As String
Dim candraw As Boolean
Dim lx, ly
Dim lx1, ly1Private Sub Form_Load()
    candraw = False
    command = "line"
    Picture1.AutoRedraw = True
End SubPrivate Sub Form_Resize()
    Picture1.Width = Me.ScaleWidth
    Picture1.Height = Me.ScaleHeight
End SubPrivate Sub mnuSave_Click()
    SavePicture Picture1.Image, "c:\test.bmp"
End SubPrivate Sub mnuQuit_Click()
    Unload Me
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        lx = X
        ly = Y
        lx1 = X
        ly1 = Y
            
        Select Case command
            Case "line"
                candraw = True
            Case "circle"
                'do nothing
            Case "ellipse"
                'do nothing
        End Select
    End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If X > 0 And X < Picture1.Width And Y > 0 And Y < Picture1.Height Then
        If candraw = True Then
        Picture1.Line (lx, ly)-(lx1, ly1), RGB(255, 255, 255)
        lx1 = X
        ly1 = Y
        Picture1.Line (lx, ly)-(lx1, ly1), RGB(255, 255, 255)
        End If
        '在PICTURE范围内，十字光标变为可见
        Line1.Visible = True
        Line2.Visible = True
        '十字光标移动，显示座标
        Line1.X1 = X - 400
        Line1.X2 = X + 400
        Line1.Y1 = Y
        Line1.Y2 = Y
        Line2.Y1 = Y - 400
        Line2.Y2 = Y + 400
        Line2.X1 = X
        Line2.X2 = X
        SetCapture (Picture1.hwnd)     '设置光标捕获
    Else
        '超出PICTURE范围，十字光标不可见
        Line1.Visible = False
        Line2.Visible = False
        ReleaseCapture
    End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    candraw = False
End Sub