Új hozzászólás Aktív témák

• salmiakki tag

  #2595

  #2594 Delila_1

  2015-02-26 16:43:19

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  salmiakki

  tag

  #2594 Delila_1

  #2594 Delila_1

  Próbáld meg abban a táblázatban kiszűrni az átfedéseket. Ott valószínűleg egyszerűbben megteheted, mint a beszúrt objektumoknál.

  Igen, ez volt az alap koncepció, de valahogy sehogy sem akart sikerülni. Egy for ciklusban lefuttattam az összes táblázatban szereplő adatot, minden alkalommal, amikor az adott objektum mozgatása véget ért, de nem sikerült megoldani a problémát.

• salmiakki tag

  #2593

  #2592 Delila_1

  2015-02-26 16:17:36

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  salmiakki

  tag

  #2592 Delila_1

  #2592 Delila_1

  Azt írd le, hogy kerülnek a lapra az objektumok. Hátha akkor könnyebb ellenőrizni a helyzetüket, illetve eleve jó helyre lehetne tenni.
  A már meglévő ábráknál nagyon sok, egymást ütő feltételt kell vizsgálni.

  Egy táblázatban le vannak mentve az adatai, onnantól egyszerűen Dim btn As New Button, megadom az adatait és Me.Controls.Add(btn)

• salmiakki tag

  #2591

  #2590 Delila_1

  2015-02-25 17:42:55

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  salmiakki

  tag

  #2590 Delila_1

  #2590 Delila_1

  Igaz, hogy Control-t kérdeztél, de ez a makró az eddig felvitt legalsó és jobb szélső elemek bármilyen objektum alá-, és tőle jobbra 5 ponttal helyezi az új objektumot.

  Sub UjElem()
  Dim Bal As Single, Lent As Single, i As Long
  
  For i = 1 To ActiveSheet.Shapes.Count
  With ActiveSheet.Shapes(i)
  If .Left + .Width > Bal Then Bal = .Left + .Width + 5
  If .Top + .Height > Lent Then Lent = .Top + .Height + 5
  End With
  Next
  
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select
  End Sub

  Az

  ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select

  sorban kell meghatároznod az új elem típusát. A két utolsó érték helyére írd be a kívánt szélességet, és magasságot. Ez most egy téglalapot tesz be, de ha a sor helyett ezt írod:

  ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
  DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=102.75, Height:=25.5).Select

  akkor egy beviteli mezőt tesz a megfelelő helyre.

  Ez meg szépen egymás alá teszi a beviteli mezőket:

  Sub mm()
  Dim Bal As Single, Lent As Single, i As Long
  
  For i = 1 To ActiveSheet.Shapes.Count
  With ActiveSheet.Shapes(i)
  If .Left > Bal Then Bal = .Left
  If .Top + .Height > Lent Then Lent = .Top + .Height + 3
  End With
  Next
  
  ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
  DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=69.75, Height:=24).Select
  End Sub

  Az alábbi képen látszik maga a program. Mint írtam, az objektumoknak csak a Left, Top, Width és Height adatai vannak meg, mellesleg végtelen objectről lehet szó, szóval amit az 1. válaszban írtál, hogy csak a legutóbbi objectet nézni, nem hinném, hogy jó lesz.
  Továbbá csak hogy egyértelmű legyen, az A esetben jelölt fedést szeretném csak ellenőrizni, ha 2 object érintkezik (B eset), azt nem feltétlen.

  

• salmiakki tag

  #2587 2015-02-24 21:43:22

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  salmiakki

  tag

  Sziasztok!

  Adott egy olyan helyzet, amikor egy új Control kerül a programba, és szeretném megnézni, hogy az takarásban van-e azon többi Control-al, melyek Top, Left, Height és Width adatai állnak rendelkezésemre.
  Hogyan tudnám ezt a lehető legegyszerűbben kivitelezni?

  Jelenlegi kód:
  Dim Collision As Boolean = False
  
  Dim _top As Integer = MovingObject.top
  Dim _left As Integer = MovingObject.left
  Dim _width As Integer = MovingObject.width
  Dim _height As Integer = MovingObject.height
  
  For i As Integer = 0 To Objects.Rows.Count - 1
  Dim oTop As Integer = Objects.Rows(i).Cells("top").Value
  Dim oLeft As Integer = Objects.Rows(i).Cells("top").Value
  Dim oWidth As Integer = Objects.Rows(i).Cells("width").Value
  Dim oHeight As Integer = Objects.Rows(i).Cells("height").Value
  Next
  
  If Collision = True Then
  MovingObject.BackColor = Color.Red
  Else
  MovingObject.BackColor = Color.ForestGreen
  End If

  '_ 'előtaggal jelölt változók az újonnan programba kerülő Control adatai.
  'o' előtaggal jelöl változók a meglévő Control-ok adatai.

  Segítségeteket előre is köszönöm!

Új hozzászólás Aktív témák