?? form1.frm

?? visual basic課程設計案例精編
?? FRM
?? 第 1 頁 / 共 2 頁
字號:
上一頁 12
    Toolbar1.Buttons("Delete").Enabled = False
End Sub

Private Sub Form_Load()
    Set mObject = New DrawObject
End Sub

Private Sub Form_Resize()
    Picture1.Left = ScaleLeft
    Picture1.Top = Toolbar1.Height
    Picture1.Width = ScaleWidth
    If ScaleHeight - StatusBar1.Height > Toolbar1.Height Then
    'Height 屬性不能小于“0”
        Picture1.Height = ScaleHeight - Toolbar1.Height - StatusBar1.Height
    End If
End Sub

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

Private Sub Green_Click()
    ChangeColor vbGreen
    Toolbar2.Buttons("Black").Value = tbrUnpressed
    Toolbar2.Buttons("Red").Value = tbrUnpressed
    Toolbar2.Buttons("Green").Value = tbrPressed
    Toolbar2.Buttons("Blue").Value = tbrUnpressed
    Toolbar2.Buttons("Yellow").Value = tbrUnpressed
End Sub

Private Sub Line_Click()
    CurrentSel = 1
    Picture1.MousePointer = 2 '設置鼠標光標
    Toolbar1.Buttons("Delete").Enabled = False
End Sub

Private Sub New_Click()
    '初始化數據
    If mObject.Count > 0 Then
        Response = MsgBox("保存工作嗎？", vbYesNoCancel)
        If Response = vbYes Then
            Save_Click
        ElseIf Response = vbNo Then
            CurrentSel = 0
            CurrentColor = 0
            MoveMode = 0
            Moving = False
            CurrentIndex = 0
            Set CurrentObject = Nothing
            FileName = ""
            Set mObject = New DrawObject
            '初始化工具條
            Toolbar1.Buttons("Delete").Enabled = False
            Toolbar1.Buttons("Select").Value = tbrPressed
            Toolbar2.Buttons("Black").Value = tbrPressed
            '初始化繪圖區
            Picture1.Cls
            Picture1.MousePointer = 0
        End If
    End If
End Sub

Private Sub Open_Click()
    Dim File As Integer
    
    If mObject.Count > 0 Then
        Response = MsgBox("保存工作嗎？", vbYesNoCancel)
        If Response = vbYes Then
            Save_Click
        ElseIf Response = vbNo Then
            CurrentSel = 0
            CurrentColor = 0
            MoveMode = 0
            Moving = False
            CurrentIndex = 0
            Set CurrentObject = Nothing
            FileName = ""
            Set mObject = New DrawObject
            '初始化工具條
            Toolbar1.Buttons("Delete").Enabled = False
            Toolbar1.Buttons("Select").Value = tbrPressed
            Toolbar2.Buttons("Black").Value = tbrPressed
            '初始化繪圖區
            Picture1.Cls
            Picture1.MousePointer = 0
            CommonDialog1.InitDir = App.Path '設置初始路徑
            CommonDialog1.FileName = "" '清除文件名
            CommonDialog1.ShowOpen '顯示“打開”對話框
            FileName = CommonDialog1.FileName '保存文件名
            If Len(CommonDialog1.FileName) > 0 Then
                File = FreeFile() '獲得可用文件號
                Open FileName For Input As File '打開文件
                mObject.Load File '讀文件
                Close File '關閉文件
                mObject.Draw Picture1 '顯示圖形
            End If
        End If
    Else
            CommonDialog1.InitDir = App.Path '設置初始路徑
            CommonDialog1.FileName = "" '清除文件名
            CommonDialog1.ShowOpen '顯示“打開”對話框
            FileName = CommonDialog1.FileName '保存文件名
            If Len(CommonDialog1.FileName) > 0 Then
                File = FreeFile() '獲得可用文件號
                Open FileName For Input As File '打開文件
                mObject.Load File '讀文件
                Close File '關閉文件
                mObject.Draw Picture1 '顯示圖形
            End If
    End If
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button <> 1 Then Exit Sub '如果未按左鍵則退出
    
    Select Case CurrentSel
        Case 0
            CurrentIndex = mObject.IsObject(Int(x), Int(y), CurrentObject, MoveMode)
            If CurrentIndex > 0 Then
                Call CurrentObject.SetOldPoint(Int(x), Int(y))
                Toolbar1.Buttons("Delete").Enabled = True
                Moving = True
                ChangeObject
            Else
                Toolbar1.Buttons("Delete").Enabled = False
            End If
        Case 1
            Set CurrentObject = New DrawLine
            Call CurrentObject.SetPoint(1, Int(x), Int(y))
            Call CurrentObject.SetPoint(2, Int(x), Int(y))
            Call CurrentObject.SetOldPoint(Int(x), Int(y))
            CurrentObject.Color = CurrentColor
            MoveMode = 2
            Moving = True
        Case 2
            Set CurrentObject = New DrawRec
            Call CurrentObject.SetPoint(1, Int(x), Int(y))
            Call CurrentObject.SetPoint(2, Int(x), Int(y))
            Call CurrentObject.SetOldPoint(Int(x), Int(y))
            CurrentObject.Color = CurrentColor
            MoveMode = 2
            Moving = True
        Case 3
            Set CurrentObject = New DrawCircle
            Call CurrentObject.SetPoint(1, Int(x), Int(y))
            Call CurrentObject.SetPoint(2, Int(x), Int(y))
            Call CurrentObject.SetOldPoint(Int(x), Int(y))
            CurrentObject.Color = CurrentColor
            MoveMode = 2
            Moving = True
    End Select
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not Moving Then Exit Sub '如果無移動動作退出
    
    Call CurrentObject.Move(Picture1, Int(x), Int(y), MoveMode)
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not Moving Then Exit Sub '如果無移動動作退出
    Moving = False '取消移動標志
    
    Select Case CurrentSel
        Case 0 '完成移動圖元操作
        '重繪全部圖元
            mObject.Draw Picture1
        Case 1 '完成增加線段操作
        '增加線段圖元
            Call CurrentObject.Draw(Picture1) '重繪當前圖元
            mObject.Add CurrentObject '將當前圖元加入集合
        Case 2 '完成增加矩形操作
        '增加矩形圖元
            Call CurrentObject.Draw(Picture1)
            mObject.Add CurrentObject '將當前圖元加入集合
        Case 3 '完成增加圓形操作
        '增加矩形圖元
            Call CurrentObject.Draw(Picture1)
            mObject.Add CurrentObject '將當前圖元加入集合
    End Select
End Sub

Private Sub Picture1_Paint()
    Call mObject.Draw(Picture1) '重繪所有圖元
End Sub

Private Sub Print_Click()
    If mObject.Count > 0 And Printers.Count > 0 Then
    '集合中有圖元
        mObject.PrintObject Printer  '在輸出設備中繪制圖元
        Printer.EndDoc '完成繪圖，開始打印
    ElseIf mObject.Count = 0 Then
    '集合中無圖元
        MsgBox "無可打印的圖元數據 ！", , "提示"
    Else
    '無打印機
        MsgBox "系統尚未安裝打印機 ！", , "提示"
    End If
End Sub

Private Sub Rec_Click()
    CurrentSel = 2
    Picture1.MousePointer = 2 '設置鼠標光標
    Toolbar1.Buttons("Delete").Enabled = False

End Sub

Private Sub Red_Click()
    ChangeColor vbRed
    Toolbar2.Buttons("Black").Value = tbrUnpressed
    Toolbar2.Buttons("Red").Value = tbrPressed
    Toolbar2.Buttons("Green").Value = tbrUnpressed
    Toolbar2.Buttons("Blue").Value = tbrUnpressed
    Toolbar2.Buttons("Yellow").Value = tbrUnpressed
End Sub

Private Sub Save_Click()
    Dim File As Integer
    
    If Len(FileName) = 0 Then
        CommonDialog1.InitDir = App.Path '設置初始路徑
        CommonDialog1.FileName = "" '初始化文件名
        CommonDialog1.ShowSave
        FileName = CommonDialog1.FileName
    End If
    
    If Len(FileName) > 0 Then
    '正確輸入（選擇）文件名
        File = FreeFile()
        Open FileName For Output As File '打開文件
        mObject.Save File '保存數據
        Close File '關閉文件
    End If
End Sub

Private Sub SaveAs_Click()
    Dim File As Integer
    
    CommonDialog1.InitDir = App.Path '設置初始路徑
    CommonDialog1.FileName = "" '初始化文件名
    CommonDialog1.ShowSave
    FileName = CommonDialog1.FileName
    
    If Len(FileName) > 0 Then
    '正確輸入（選擇）文件名
        File = FreeFile()
        Open FileName For Output As File '打開文件
        mObject.Save File '保存數據
        Close File '關閉文件
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "New" '單擊工具條按鈕1（新文件）
            New_Click
        Case "Open" '單擊工具條按鈕2（打開）
            Open_Click
        Case "Save" '單擊工具條按鈕3（保存）
            Save_Click
        Case "Select" '單擊工具條按鈕4（箭頭）
            CurrentSel = 0
            Picture1.MousePointer = 0 '恢復鼠標光標
            Toolbar1.Buttons("Delete").Enabled = False
            CurrentIndex = 0
            Set CurrentObject = Nothing
        Case "Line" '單擊工具條按鈕5（直線）
            CurrentSel = 1
            Picture1.MousePointer = 2 '設置鼠標光標
            Toolbar1.Buttons("Delete").Enabled = False
        Case "Reg" '單擊工具條按鈕6（矩形）
            CurrentSel = 2
            Picture1.MousePointer = 2 '設置鼠標光標
            Toolbar1.Buttons("Delete").Enabled = False
        Case "Circle" '單擊工具條按鈕6（圓形）
            CurrentSel = 3
            Picture1.MousePointer = 2 '設置鼠標光標
            Toolbar1.Buttons("Delete").Enabled = False
        Case "Delete" '單擊工具條按鈕7（刪除）
            DeleteObject
    End Select
End Sub

Private Sub DeleteObject()
    Toolbar1.Buttons("Delete").Enabled = False
    mObject.Remove CurrentIndex
    Set CurrentObject = Nothing
    mObject.Draw Picture1
End Sub

Private Sub ChangeColor(Colour As Long)
'修改當前對象顏色
    CurrentColor = Colour
    If CurrentSel = 0 And CurrentIndex > 0 Then
        CurrentObject.Color = Colour
        CurrentObject.Draw Picture1
    End If
End Sub

Private Sub ChangeObject()
'設置工具條顏色按鈕
    Select Case CurrentObject.Color
        Case vbRed
            Toolbar2.Buttons("Red").Value = tbrPressed
        Case vbGreen
            Toolbar2.Buttons("Green").Value = tbrPressed
        Case vbBlue
            Toolbar2.Buttons("Blue").Value = tbrPressed
        Case vbYellow
            Toolbar2.Buttons("Yellow").Value = tbrPressed
        Case vbBlack
            Toolbar2.Buttons("Black").Value = tbrPressed
    End Select
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "Red" '單擊工具條按鈕2（紅色）
            ChangeColor vbRed
        Case "Green" '單擊工具條按鈕3（綠色）
            ChangeColor vbGreen
        Case "Blue" '單擊工具條按鈕4（藍色）
            ChangeColor vbBlue
        Case "Yellow" '單擊工具條按鈕5（黃色）
            ChangeColor vbYellow
        Case "Black" '單擊工具條按鈕1（黑色）
            ChangeColor vbBlack
    End Select
End Sub

Private Sub Yellow_Click()
    ChangeColor vbYellow
    Toolbar2.Buttons("Black").Value = tbrUnpressed
    Toolbar2.Buttons("Red").Value = tbrUnpressed
    Toolbar2.Buttons("Green").Value = tbrUnpressed
    Toolbar2.Buttons("Blue").Value = tbrUnpressed
    Toolbar2.Buttons("Yellow").Value = tbrPressed
End Sub
上一頁 12
?? 文件大小 2422 K
?? 上傳用戶 xufengping716
?? 所屬分類系統設計方案
??? 相關標簽

#visual #basic #案例 #精編
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? form1.frm

?? 快捷鍵說明
