|
| Autor |
Nachricht |
Dideldum
Newbie
Anmeldedatum: 29.01.2011
Beiträge: 4
Wohnort: Deutschland
|
Control-Array zu Laufzeit mit MausDown-Auswertung
Verfasst am: 29.01.2011, 20:42 |
|
|
Hallo Ihr Forenmitglieder,
ich habe mich hier angemeldet, weil ich mit meiner Weisheit am Ende und im Web leider nicht fündig geworden bin und schon für das ein oder andere Problem n diesem Forum kompetente Ratschläge gelesen habe.
Ich hoffe inständig, bei meinem derzeitigen Denkknoten kann mir jemand von Euch weiterhelfen.
Mein Problem:
Ich muss gewissermasen eine GUI, öhnlich der VB6-Entwickleroberfläche entwickeln, in welcher der Benutzer zur Laufzeit Objekte wie z.B. Schaltflächen usw. mit der Maus aufziehen und erstellen kann. Das Aufziehen mit FocusRect klappt und die Laufzeitimplementierung der Schaltflächen habe ich mit folgendem Code gelöst:
| Code: |
Option Explicit
Dim WithEvents nObjekt As VB.CommandButton
Private objectCounter As Integer ' Zähler für benutzererstellte Objekte
Private Sub form_load()
objectCounter = 0
End Sub
Private Sub buildButton()
Set nObjekt = Me.Controls.Add("VB.CommandButton", "Objekt" & objectCounter)
nObjekt.Tag = objectCounter
nObjekt.Visible = True
objectCounter = objectCounter + 1
End Sub
Private Sub nObjekt_mouseDown(button As Integer, shift As Integer, X As Single, Y As Single)
if button = vbLeftButton then
select case nObjekt.tag
case = 0
' je nach Button sollen hier andere Werte in bestehende Variablen geschrieben werden
case = 1
' je nach Button sollen hier andere Werte in bestehende Variablen geschrieben werden
end select
else
if button = vbRightButton then
select case nObjekt.tag
case = 0
' je nach Button sollen hier verschiedene Popups aufpoppen
case = 1
' je nach Button sollen hier verschiedene Popups aufpoppen
end select
end if
end if
End Sub
|
Die beschriebene Sub "BuildButton" wird nach dem Aufziehen des FocusRect beim Form_MouseUp aufgerufen (die Button-Grössenanpassung an das FocusRect habe ich der Übersichtlichkeit in diesem Code weg gelassen), wenn das Werkzeug "CommandButton" benutzt wird, ansonsten soll je nach gewähltem Werkzeug (Textbox, OptionButton, Checkbox etc.) eine vergleichbare andere "BuildObjekt"-Sub aufgerufen werden.
Im derzeitigen Zustand reagiert die Sub "MouseDown" aber natürlich leider immer nur auf den zuletzt erschaffenen Button, da nObjekt nur eine Variable und kein Array ist und daher bei jedem Aufruf von "BuildButton" neu zugeordnet wird.
Ich bekomme es einfach nicht hin, das so zu coden, dass ich die pro Form erlaubten 255 Controls mit einer Sub "MouseDown" auswerten kann.
Würde mich riesig freuen, wenn mir hier einer von Euch unter die Arme greifen könnte.
Beste Grüsse
Veronika
Beste Grüsse |
|
| |
|
 |
christopher.g
Überflieger
Anmeldedatum: 03.05.2008
Beiträge: 565
|
Verfasst am: 31.01.2011, 10:02 |
|
|
hi veronika
ich bin vor paar wochen genau vor dem gleichen Problem gestanden..
habs nicht hinbekommen
ich denke dass da auch alte vb6 gurus zum schwitzen anfangen...
weil du ja eingentlich ein steuerelement aufrufen möchtest das es gar nicht gibt
dein funktionsaufruf (Private Sub nObjekt_mouseDown)
wird ja gar nicht aufgerufen weil es das steuerelement "nObjekt" nicht gibt
wenn du jedoch schon vorher alle funktionen für die buttons schreiben würdes
würde es gehen (es ist bescheuert ich weis)
Private Sub Objekt1_mouseDown
dann würde der button drauf reagieren
wie gesagt ich stehe vor dem gleichen problem und komme auch nicht weiter
aber ich wünsche dir viel erfolg beim lösen des problems
lg |
|
| |
|
|
Dideldum
Newbie
Anmeldedatum: 29.01.2011
Beiträge: 4
Wohnort: Deutschland
|
Verfasst am: 02.02.2011, 00:18 |
|
|
Hallo,
habe es inzwischen mit etwas Hilfe hinbekommen:
Vielleicht hilft es Dir
Mit:
aktivesWerkzeug = 2 können Buttons angelegt werden
aktivesWerkzeug = 1 können bestehende Buttons resized und verschoben werden
Habe diese Zuordnung in einer Toolbar im MDI-Mainwindow, in welches die Form "WorkSpace" liegt
Benötigt:
1 Form "WorkSpace", in dieser
1 Button "nButton" mit Index = 0, also Button-Gruppe
1 Picturebox "Picture1" mit Index = 0, also PictureBox-Gruppe
1 Timer "Timer1" mit Intervall 1
| Code: |
Option Explicit
Private XD!, YD!, TwX!, TwY!
' MausPosition
Private mXPos As Integer
Private mYPos As Integer
' FocusRect
Private fZeichnen As Boolean
Private NR As RECT
Dim bNr As RECT
Dim OldNR As RECT
' Diverse
Public aktivesWerkzeug As Integer ' 1 = Pfeil, 2 = Button-Werkzeug
Private buttonCounter As Integer ' Zähler für erstellte Schaltflächen, 1.Button = 0
Private aktButton As Integer ' derzeitig gewählter Button
Private Sub Form_Load()
buttonCounter = 0
nButton(buttonCounter).Visible = False
'
' Resize initialisieren
'
Dim i%, Anf As Object
Me.ScaleMode = vbPixels
TwX = Screen.TwipsPerPixelX
TwY = Screen.TwipsPerPixelY
' 8 kleine Pictureboxen als gezeichnete Vierecke in den Ecken des Buttons
'
' 0 = oben
' 1 = links
' 2 = rechts
' 3 = unten
' 4 = LO
' 5 = RO
' 6 = LU
' 7 = RU
For i = 0 To 7
Set Anf = Picture1(i)
If i > 0 Then Load Anf
With Anf
.ScaleMode = vbPixels
.BorderStyle = vbBSNone
.Move 0, 0, 7, 7
.BackColor = vbRed
.AutoRedraw = True
Select Case i
Case Is = 0, 3
.MousePointer = vbSizeNS 'ObenUnten
Case Is = 1, 2
.MousePointer = vbSizeWE 'LinksRechts
Case Is = 4, 7
.MousePointer = vbSizeNWSE 'LinksOben RechtsUnten
Case Is = 5, 6
.MousePointer = vbSizeNESW 'RechtsOben LinksUnten
End Select
End With
Anf.Line (0, 0)-(6, 6), vbWhite, B
Next i
Call SetzeAnf(False)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then ' Schliessen unterbinden
Cancel = 1
End If
End Sub
'
' Focusrechteck zeichnen oder löschen, wenn bereits vorhanden
'
Private Sub FlipFocusRect()
Dim OldSetting As Boolean
With Workspace
OldSetting = .AutoRedraw
.AutoRedraw = True
DrawFocusRect .hDC, OldNR
DrawFocusRect .hDC, NR
OldNR = NR
.AutoRedraw = OldSetting
.Refresh
End With
End Sub
'
' BuildButton
'
Private Sub buildButton(Index As Integer)
If buttonCounter > 0 Then
Load nButton(buttonCounter)
End If
nButton(buttonCounter).Left = bNr.Left
nButton(buttonCounter).Top = bNr.Top
nButton(buttonCounter).Width = Abs(bNr.Right - bNr.Left)
nButton(buttonCounter).Height = Abs(bNr.Bottom - bNr.Top)
nButton(buttonCounter).Visible = True
nButton(buttonCounter).DragMode = 0
nButton(buttonCounter).Caption = "Schaltfläche" & buttonCounter
buttonCounter = buttonCounter + 1
WorkspaceAktivesWerkzeug = 1
Mainwindow.Werkzeugleiste.Buttons(1).Value = tbrPressed
End Sub
Private Sub Timer1_Timer()
Dim tmpStr As String
If fZeichnen = True Then
tmpStr = "(" & Str(NR.Left) & " ," & Str(NR.Top) & ") -> (" & Str(NR.Right) & " ," & Str(NR.Bottom) & ") = (" & Str(Abs(NR.Right - NR.Left)) & " x" & Str(Abs(NR.Bottom - NR.Top)) & ")"
Mainwindow.Statusleiste.Panels(1).Text = tmpStr
Call FlipFocusRect
Else
tmpStr = "(" & Str(mXPos) & " ," & Str(mYPos) & ")"
Mainwindow.Statusleiste.Panels(1).Text = tmpStr
End If
End Sub
'
' Mausauswertung
'
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Mainwindow.isMinimized = 0 Then
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
Case Is = 2
If Button = vbLeftButton Then
Me.MousePointer = 2
fZeichnen = True
NR.Left = x
NR.Right = x
NR.Top = y
NR.Bottom = y
End If
End Select
Else
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.MousePointer = 0
If Mainwindow.isMinimized = 0 Then
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
Case Is = 2
If Button = vbLeftButton Then
If fZeichnen = True Then
If NR.Left < x Then
NR.Right = x
Else
NR.Left = x
End If
If NR.Top < y Then
NR.Bottom = y
Else
NR.Top = y
End If
End If
End If
End Select
mXPos = x
mYPos = y
Else
End If
' Call Mainwindow.MDIForm_MouseMove(Button, Shift, X, Y)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim tmpInt As Integer
If Mainwindow.isMinimized = 0 Then
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
If aktButton - 1 Then
Call SetzeAnf(False)
aktButton = -1
End If
Case Is = 2
If fZeichnen = True Then
fZeichnen = False
bNr = NR
Me.MousePointer = 0
NR.Left = 0
NR.Top = 0
NR.Right = 0
NR.Bottom = 0
Call FlipFocusRect
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
Case Is = 2
buildButton (buttonCounter)
End Select
End If
End Select
Else
End If
End Sub
'
' Button Mouse
'
Private Sub nButton_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim richtung As Integer
If Mainwindow.isMinimized = 0 Then
Select Case Button
Case Is = vbLeftButton
aktButton = Index
With nButton(Index)
.Move .Left + (x - XD) / TwX, .Top + (y - YD) / TwY
End With
End Select
Else
End If
End Sub
Private Sub nButton_mouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim ret As String
If Mainwindow.isMinimized = 0 Then
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
If Button = vbLeftButton Then
Dim i%
XD = x
YD = y
For i = 0 To 7
Picture1(i).Visible = False
Next i
nButton(Index).ZOrder vbBringToFront
End If
Case Is = 2
End Select
End If
End Sub
Private Sub nButton_mouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim ret As String
If Mainwindow.isMinimized = 0 Then
Select Case WorkspaceAktivesWerkzeug
Case Is = 1
If Button = vbLeftButton Then
Call SetzeAnf(True)
End If
If Button = vbRightButton Then
Workspace.PopupMenu Workspace.mnu_Popupmenu
End If
Case Is = 2
End Select
End If
Debug.Print "ButtonUp" & Index & " - " & Button & " " & nButton(Index).DragMode
End Sub
'
'
'
Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As _
Integer, x As Single, y As Single)
Dim i%
XD = x
YD = y
For i = 0 To 7
Picture1(i).Visible = False
Next i
Picture1(Index).ZOrder vbBringToFront
End Sub
Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As _
Integer, x As Single, y As Single)
Dim K1!, K2!, K3!, K4!, XP!, YP!
If aktButton > -1 Then
If Button = vbLeftButton Then
With nButton(aktButton)
K1 = .Left
K2 = .Top
K3 = .Width
K4 = .Height
XP = K1
YP = K2
With Picture1(Index)
.Move .Left - XD + x, .Top - YD + y
Select Case Index
Case 0 ' oben
K2 = .Top + .Height
K4 = YP - K2 + K4
Case 1 ' links
K1 = .Left + .Width
K3 = XP - K1 + K3
Case 2 ' rechts
K3 = .Left - K1
Case 3 ' unten
K4 = .Top - K2
Case 4 ' LO
K1 = .Left + .Width
K2 = .Top + .Height
K3 = XP - K1 + K3
K4 = YP - K2 + K4
Case Is = 5 ' RO
K2 = .Top + .Height
K3 = .Left - K1
K4 = YP - K2 + K4
Case Is = 6 ' LU
K1 = .Left + .Width
K3 = XP - K1 + K3
K4 = .Top - K2
Case Is = 7 ' RU
K3 = .Left - K1
K4 = .Top - K2
End Select
End With
.Move K1, K2, IIf(K3 < 1, 1, K3), IIf(K4 < 1, 1, K4)
End With
End If
End If
End Sub
Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As _
Integer, x As Single, y As Single)
Call SetzeAnf(True)
End Sub
'
' Zeige oder verberge die Greif-Vierecke
'
Private Sub SetzeAnf(sichtbar As Boolean)
Dim i%, XP!, YP!, K1!, K2!, K3!, K4!
If aktButton > -1 Then
With nButton(aktButton)
K1 = .Left
K2 = .Top
K3 = .Width
K4 = .Height
.ZOrder vbBringToFront
End With
For i = 0 To 7
With Picture1(i)
Select Case i
Case 0 ' oben
XP = (K3 - .Width) \ 2
YP = -.Height
Case 1 ' links
XP = -.Width
YP = (K4 - .Height) \ 2
Case 2 ' rechts
XP = K3
YP = (K4 - .Height) \ 2
Case 3 ' unten
XP = (K3 - .Width) \ 2
YP = K4
Case Is = 4 'ol
XP = -.Width
YP = -.Height
Case Is = 5 'or
XP = K3
YP = -.Height
Case Is = 6 ' ul
XP = -.Width
YP = K4
Case Is = 7 'ur
XP = K3
YP = K4
End Select
.Move K1 + XP, K2 + YP
.ZOrder vbBringToFront
.Visible = sichtbar
End With
Next i
End If
End Sub
|
LG
Vroni
Beste Grüsse |
|
| |
|
|
|
|
Registrieren
Login
