vbdaima.txt

简单画图板VB代码简单画 图板VB代码图板简单画图板VB代码VB代码

1 简单画图板VB代码  
 Dim gtoolbarindex As Integer 
Dim STARTX As Single 
Dim STARTY As Single 
Dim ENDX As Single 
Dim ENDY As Single 
Dim dodown As Boolean 
Dim saved As Boolean 
Dim changed As Boolean 
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long 
Private 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 Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long 
Private Type POINTAPI 
        x As Long 
        y As Long 
End Type 
Dim Points(0 To 3) As POINTAPI 
Dim idx As Integer 
Private Declare Function PolyBezier Lib "gdi32" (ByVal hdc As Long, lppt As POINTAPI, ByVal cPoints As Long) As Long 
Dim PAINT As Boolean 
Dim WENJIAN As String 

Private Sub Form_Initialize() 
     SW = Picture6.ScaleWidth 
     SH = Picture6.ScaleHeight 
End Sub 

Private Sub Form_Load() 
    Picture6.BackColor = Picture3.BackColor 
    Picture6.ForeColor = Picture2.BackColor 
    PAINT = False 
    Picture6.ScaleMode = 3 
    dodown = False 
    saved = False 
    changed = False 
End Sub 

Private Sub MNUBANGZHUZHUTI_Click() 
    CommonDialog1.HelpCommand = cdlHelpContents 
    CommonDialog1.HelpFile = "C:\WINNT\Help\mspaint" 
    CommonDialog1.HelpKey = "画直线" 
    CommonDialog1.ShowHelp 
End Sub 

Private Sub MNUCOLOR_Click() 
    If MNUCOLOR.Checked Then 
        Form1.Picture4(Index).Visible = False 
        MNUCOLOR.Checked = False 
    Else 
        Form1.Picture4(Index).Visible = True 
        MNUCOLOR.Checked = True 
    End If 
End Sub 

Private Sub MNUEDITCOLOR_Click() 
    CommonDialog1.ShowColor 
End Sub 

Private Sub MNUEXIT_Click() 
    End 
End Sub 

Private Sub MNUGUANYU_Click() 
    Form2.Show 
End Sub 

Private Sub MNUNEW_Click() 
    If saved = False Then 
        Picture6.AutoRedraw = True 
        RESPONCE = MsgBox("是否将改动保存到未命名中?", 51, 画图) 
        If RESPONCE = vbYes Then 
            CommonDialog1.InitDir = "C:\MY DOCUMENT" 
            CommonDialog1.FileName = "未命名" 
            CommonDialog1.Filter = "24位位图（*.BMP)|*.BMP|256色彩位图(*BMP}|*BMP" 
            CommonDialog1.ShowSave 
            SavePicture Form1.Picture6.Image, CommonDialog1.FileName 
            Picture6.Cls 
            Picture6.BackColor = RGB(255, 255, 255) 
        End If 
        If RESPONCE = vbNo Then 
            Picture6.Cls 
            Picture6.BackColor = RGB(255, 255, 255) 
        End If 
    End If 
    If (saved = True And changed = False) Then 
        Picture6.Cls 
        Picture6.BackColor = RGB(255, 255, 255) 
 
 
  
 作者： 城外来客  2005-10-1 23:58 　 回复此发言    
 
--------------------------------------------------------------------------------
 
2 简单画图板VB代码  
     End If 
    If (saved = True And changed = True) Then 
        Picture6.AutoRedraw = True 
        RESPONCE = MsgBox("是否将改动保存到" & CommonDialog1.FileName & "中?", 51, 画图) 
        If RESPONCE = vbYes Then 
            SavePicture Form1.Picture6.Image, CommonDialog1.FileName 
            Picture6.Cls 
            Picture6.BackColor = RGB(255, 255, 255) 
        End If 
        If RESPONCE = vbNo Then 
            Picture6.Cls 
            Picture6.BackColor = RGB(255, 255, 255) 
        End If 
    End If 
End Sub 

Private Sub MNUPRINT_Click() 
    CommonDialog1.ShowPrinter 
End Sub 

Private Sub MNUTOOL_Click() 
    If MNUTOOL.Checked Then 
        Form1.Toolbar3.Visible = False 
        MNUTOOL.Checked = False 
    Else 
        Form1.Toolbar3.Visible = True 
        MNUTOOL.Checked = True 
    End If 
End Sub 

Private Sub MNUWORD_Click() 
    CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects 
    CommonDialog1.ShowFont 
    If CommonDialog1.FontName > "" Then 
        Text1.FontName = CommonDialog1.FontName 
    End If 
    Text1.FontSize = CommonDialog1.FontSize 
    Text1.FontBold = CommonDialog1.FontBold 
    Text1.FontItalic = CommonDialog1.FontItalic 
    Text1.FontStrikethru = CommonDialog1.FontStrikethru 
    Text1.FontUnderline = CommonDialog1.FontUnderline 
    Text1.ForeColor = CommonDialog1.Color 
End Sub 

Private Sub MNUZHUANGTAI_Click() 
    If MNUZHUANGTAI.Checked Then 
        Form1.StatusBar1.Visible = False 
        MNUZHUANGTAI.Checked = False 
    Else 
        Form1.StatusBar1.Visible = True 
        MNUZHUANGTAI.Checked = True 
    End If 
End Sub 

Private Sub NUMASAVE_Click() 
    Picture6.AutoRedraw = True 
    CommonDialog1.InitDir = "C:\MY DOCUMENT" 
    'CommonDialog1.FileName = "未命名" 
    CommonDialog1.Filter = "24位位图（*.BMP)|*.BMP|256色彩位图(*BMP}|*BMP" 
    CommonDialog1.ShowSave 
    SavePicture Form1.Picture6.Image, CommonDialog1.FileName 
    saved = True 
End Sub 

Private Sub NUMOPEN_Click() 
    CommonDialog1.InitDir = "C:WINDOWS" 
    CommonDialog1.Filter = "24位位图（*.BMP)|*.BMP|256色彩位图(*BMP}|*BMP" 
    CommonDialog1.ShowOpen 
    WENJIAN = CommonDialog1.FileName 
    Picture6 = LoadPicture(WENJIAN) 
End Sub 

Private Sub NUMSAVE_Click() 
    Picture6.AutoRedraw = True 
    CommonDialog1.InitDir = "C:\MY DOCUMENT" 
    'CommonDialog1.FileName = "未命名" 
    CommonDialog1.Filter = "24位位图（*.BMP)|*.BMP|256色彩位图(*BMP}|*BMP" 
    CommonDialog1.ShowSave 
    SavePicture Form1.Picture6.Image, CommonDialog1.FileName 
    saved = True 
End Sub 

Private Sub Picture2_Click() 
    Picture2.BackColor = CommonDialog1.Color 
End Sub 

Private Sub Picture3_Click() 
    Picture3.BackColor = CommonDialog1.Color 
End Sub 

Private Sub Picture4_Click(Index As Integer) 
    Select Case gtoolbarindex 
        Case 5 
        Picture6.ForeColor = Picture4(Index).BackColor 
   End Select 
End Sub 

Private Sub Picture4_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) 
    If Button = 1 Then 
        Picture2.BackColor = Picture4(Index).BackColor 
 
 
  
 作者： 城外来客  2005-10-1 23:58 　 回复此发言    
 
--------------------------------------------------------------------------------
 
3 简单画图板VB代码  
         Picture6.ForeColor = Picture2.BackColor 
    End If 
    If Button = 2 Then 
        Picture3.BackColor = Picture4(Index).BackColor 
        Picture6.BackColor = Picture3.BackColor 
    End If 
End Sub 



Private Sub Picture6_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 
    Picture6.MousePointer = 99 
    Select Case gtoolbarindex 
       Case 3 
            Picture6.MouseIcon = LoadPicture(App.Path + "\rubber.cur") 
       Case 4 
            Picture6.MouseIcon = LoadPicture(App.Path + "\fill.cur") 
       Case 5 
           Picture6.MouseIcon = LoadPicture(App.Path + "\strawer.cur") 
       Case 6 
            Picture6.MouseIcon = LoadPicture(App.Path + "\ZOOM.cur") 
       Case 7 
            Picture6.MouseIcon = LoadPicture(App.Path + "\pencil.cur") 
       Case 8 
            Picture6.MouseIcon = LoadPicture(App.Path + "\CROSS.CUR") 
       Case 9 
            Picture6.MouseIcon = LoadPicture(App.Path + "\jet.cur") 
       Case 2, 1, 10 To 16 
            Picture6.MousePointer = 2 
    End Select 
    Select Case gtoolbarindex 
        Case 2 
            Picture1.Line (X1, Y1)-(X2, Y2), , B 
            STARTX = x: STARTY = y: ENDX = x: ENDY = y 
            Picture6.DrawStyle = 4 
            Picture6.DrawMode = 7 
            PAINT = True 
          
        Case 3, 7, 8, 11, 13 
            STARTX = x: STARTY = y: ENDX = x: ENDY = y 
            PAINT = True 
        Case 4 
            Picture6.FillColor = Picture6.ForeColor 
            Picture6.FillStyle = 0 
            ExtFloodFill Picture6.hdc, x, y, Picture6.Point(x, y), 1 
        Case 5 
            Picture6.ForeColor = Picture6.Point(x, y) 
        Case 6 
            Picture6.AutoRedraw = False 
            Dim newWidth As Integer 
            Dim newHeight As Integer 
            newWidth = 2 * 416 
            newHeight = 2 * 320 
            Picture6.Width = newWidth * 15 
            Picture6.Height = newHeight * 15 
            StretchBlt Picture6.hdc, 0, 0, newWidth, newHeight, Picture6.hdc, 0, 0, 416, 320, vbSrcCopy 
        Case 9 
            Dim i As Integer 
            For i = 1 To 20 
                STARTX = x + Int(Rnd * 10 - 5) 
                STARTY = y + Int(Rnd * 10 - 5) 
                Picture6.PSet (STARTX, STARTY) 
            Next i 
            ENDX = x 
            ENDY = y 
            Timer1.Enabled = True 
            PAINT = True 
            Picture6.ForeColor = Picture2.BackColor 
        Case 10 
            Text1.Enabled = True 
            Text1.Visible = True 
            Text1.SetFocus 
            MNUWORD.Enabled = True