[Cemalizim]

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!

Option Explicit
Dim X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, LineOffSet As Integer
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    LineOffSet = 20
    X1 = X
    Y1 = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        DrawMode = 6
        If Option1(0) Then
            Line (X1, Y1)-(X2, Y2)
        Else
            Line (X1, Y1)-(X2, Y2), , B
        End If
        If Check1 Then
            If Option1(0) Then
                Line (X1 - LineOffSet, Y1 - LineOffSet)-(X2 - LineOffSet, Y2 - LineOffSet)
                Line (X1 - LineOffSet, Y1 - LineOffSet)-(X - LineOffSet, Y - LineOffSet)
            Else
                Line (X1 - LineOffSet, Y1 - LineOffSet)-(X2 - LineOffSet, Y2 - LineOffSet), , B
                Line (X1 - LineOffSet, Y1 - LineOffSet)-(X - LineOffSet, Y - LineOffSet), , B
            End If
        End If
        If Option1(0) Then
            Line (X1, Y1)-(X, Y)
        Else
            Line (X1, Y1)-(X, Y), , B
        End If
   End If
   X2 = X
   Y2 = Y
   Caption = "X - " & X & "   Y - " & Y
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawMode = 13
    If Option1(0) Then
        Line (X1, Y1)-(X2, Y2)
        If Check1 Then Line (X1 - LineOffSet, Y1 - LineOffSet)-(X - LineOffSet, Y - LineOffSet), &HC0C0C0
    Else
        Line (X1, Y1)-(X2, Y2), , B
        If Check1 Then Line (X1 - LineOffSet, Y1 - LineOffSet)-(X - LineOffSet, Y - LineOffSet), &HC0C0C0, B
    End If
End Sub

Private Sub mnuFileSub_Click(Index As Integer)
    Dim FileName As String
    Select Case Index
        'Print
        Case 0
            Printer.PaintPicture Board.Image, 0, 0
            Printer.EndDoc
        'Save
        Case 1
            FileName = InputBox("Name of file to save to", "Save Graphic", App.Path)
            If FileName = App.Path Then
                MsgBox "Bad File Name!", 48
                Exit Sub
            Else
                SavePicture Board.Image, FileName
            End If
        'Exit
        Case 2
            End
    End Select
End Sub 

ALıntıdır