PDA

Vollständige Version anzeigen : ach kommt schon, versucht es mal!


hmilker
14.05.2001, 12:05
Hey, ich hab da ein problem. ich "schneide" per maus click und zieh aus einem bild 1 ein bild 2 aus, nun will ich das bild 2 weiterverwenden bzw. in den speicher schreiben. Kennt sich da jemand aus?
2. frage wie kann ich das bild 2 in eine andere Form befördern?

schaut´es euch bitte mal an!, DANKE!

.....................
Option Explicit
Dim Mode, X0&, Y0&, X1&, Y1&, X2&, Y2&, Zoom%
Dim l&, t&, h&, w&, Marked As Boolean
Dim nPic As New StdPicture, iPic As IPicture

Private Sub Form_Load()
Picture1.Picture = LoadPicture(App.Path & "\Bild.jpg")
Zoom = 1
Mode = 1
Picture1.DrawMode = vbNotXorPen
Picture1.DrawStyle = vbDash
End Sub

Private Sub Command1_Click()
Printer.PaintPicture Picture2.Image, 0, 0, , , , , _
Picture2.Width, Picture2.Height
Printer.EndDoc
End Sub

Private Sub Check1_Click()
Command1.Enabled = IIf(Check1.Value = vbChecked, True, False)
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift _
As Integer, X As Single, _
Y As Single)
If Marked Then Call Markers

If Mode = 1 Then
X2 = X0
Y2 = Y0
Picture1.Line (X1, Y1)-(X2, Y2), , B

X1 = X
Y1 = Y

X2 = X
Y2 = Y
Picture1.Line (X1, Y1)-(X2, Y2), , B

X0 = X1
Y0 = Y1
Mode = 2
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift _
As Integer, X As Single, _
Y As Single)
If Mode = 2 Then
X2 = X0
Y2 = Y0
Picture1.Line (X1, Y1)-(X2, Y2), , B

X2 = X
Y2 = Y
Picture1.Line (X1, Y1)-(X2, Y2), , B

X0 = X2
Y0 = Y2
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
Mode = 1
If X2 < X1 Then
l = X2
Else
l = X1
End If

If Y2 < Y1 Then
t = Y2
Else
t = Y1
End If

w = Abs(X2 - X1)
h = Abs(Y2 - Y1)

If l < 0 Then l = 0
If t < 0 Then t = 0

If w = 0 Then w = 15
If h = 0 Then h = 15

If l + w > Picture1.Width Then w = Picture1.Width - l
If t + h > Picture1.Height Then h = Picture1.Height - t

Picture2.Width = w * Zoom
Picture2.Height = h * Zoom
Picture2.Refresh

If Check1.Value = vbChecked Then Picture2.AutoRedraw = True

Picture2.PaintPicture Picture1.Image, 0, 0, w * Zoom, _
h * Zoom, l, t, w, h

If Check1.Value = vbChecked Then Picture2.AutoRedraw = False
Call Markers


Set nPic = Picture2.Picture
Set iPic = nPic
Debug.Print iPic.Attributes

End Sub

Private Sub HScroll1_Change()
Label1.Caption = HScroll1.Value
Zoom = HScroll1.Value
End Sub

Private Sub Markers()
Picture1.DrawStyle = 0
Picture1.Line (l - 90, t - 90)-(l - 30, t - 30), 0, BF
Picture1.Line (l - 90, t + h + 30)- _
(l - 30, t + h + 90), 0, BF
Picture1.Line (l + w + 30, t - 90)- _
(l + w + 90, t - 30), 0, BF
Picture1.Line (l + w + 30, t + h + 30)- _
(l + w + 90, t + h + 90), 0, BF
Picture1.DrawStyle = 1
Marked = True
End Sub


Private Sub Command5_Click()
Picture2.Picture = LoadPicture("")
End Sub

Private Sub Command6_Click()
Set Picture2 = iPic
End Sub

Stefan Kulpa
14.05.2001, 14:04
Hallo,

vielleicht findest Du hierbei etwas passendes:
http://www.planet-source-code.com/xq/ASP/txtCodeId.11323/lngWId.1/qx/vb/scripts/ShowCode.htm
http://www.planet-source-code.com/xq/ASP/txtCodeId.23119/lngWId.1/qx/vb/scripts/ShowCode.htm
http://www.planet-source-code.com/xq/ASP/txtCodeId.8357/lngWId.1/qx/vb/scripts/ShowCode.htm


Gruß