Private Type POINTAPI
X As Integer
Y As Integer
End Type
Private Poly() As POINTAPI
Dim DblClick
Sub Form_Load()
Lft = Picture1.Left
Picture1.Top = Lft
Text1.Top = Lft
Text1.Left = Lft
Text1.FontBold = False
Picture1.DrawWidth = 5
Picture1.BackColor = QBColor(15)
Text1.Visible = False
End Sub
Sub form_resize()
On Error Resume Next
Lft = Picture1.Left
Command1.Top = ScaleHeight - Lft - Command1.Height
Command1.Left = (ScaleWidth - Command1.Width) / 2
Text1.Width = ScaleWidth - 2 * Lft
Picture1.Width = Text1.Width
Text1.Height = Command1.Top - 2 * Lft
Picture1.Height = Text1.Height
End Sub
Sub form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 112 Then
Text1.Visible = Not Text1.Visible
Picture1.Visible = Not Text1.Visible
End If
End Sub
Private Sub Open_Click()
CommonDialog1.InitDir = "D:\"
CommonDialog1.CancelError = True
On Error Resume Next
CommonDialog1.ShowOpen
If Err Then Exit Sub
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
End Sub
Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static FarbNr
If DblClick Then
Exit Sub
End If
FarbNr = FarbNr + 1
If FarbNr = 1 Then FarbNr = 7
If FarbNr > 15 Then FarbNr = 0
If Picture1.BackColor = QBColor(FarbNr) Then FarbNr = FarbNr + 1
If FarbNr > 15 Then FarbNr = 0
If Picture1.BackColor = QBColor(FarbNr) Then FarbNr = FarbNr + 1
Picture1.ForeColor = QBColor(FarbNr)
ReDim Poly(0)
Poly(0).X = X
Poly(0).Y = Y
End Sub
Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DblClick Then Exit Sub
If Button > 0 Then
CreatePolyLine Picture1, X, Y
End If
End Sub
Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DblClick Then
DblClick = False
Exit Sub
End If
Select Case Button
Case 1
polylinezeichnen Picture1
Case 2
PolyGonZeichnen Picture1
End Select
End Sub
Sub Picture1_DblClick()
DblClick = True
Picture1.Cls
End Sub
Sub CreatePolyLine(Obj As PictureBox, X, Y)
UB = UBound(Poly)
ReDim Preserve Poly(UB + 1)
UB = UBound(Poly)
Poly(UB).X = X
Poly(UB).Y = Y
Obj.PSet (X, Y)
End Sub
Private Sub PolyGonZeichnen(Obj As PictureBox)
polylinezeichnen Picture1
Obj.Line -(Poly(0).X, Poly(0).Y)
End Sub
Private Sub polylinezeichnen(Obj As PictureBox)
Obj.PSet (Poly(0).X, Poly(0).Y)
For m = 1 To UBound(Poly)
Obj.Line -(Poly(m).X, Poly(m).Y)
Next
End Sub
Private Sub Command1_Clik()
PrintPicture Printer, Picture1.image
End Sub
Private Sub Picture9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x0 = X
y0 = Y
If Button = 2 Then PopupMenu edit
End Sub
Private Sub new_Click()
Picture1.Cls
End Sub
Private Sub Save_Click()
CommonDialog1.InitDir = "D:\"
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.bmp|*.bmp"
On Error Resume Next
CommonDialog1.ShowSave
If Err Then Exit Sub
If CommonDialog1.FileName <> "" Then
SavePicture Picture1.image, CommonDialog1.FileName
End If
End Sub
Private Sub size_Click()
Form2.Text1.Text = Picture1.Width
Form2.Text2.Text = Picture1.Height
Form2.Show vbModal
End Sub