Private Sub Form_Load()
 
  Dim i&, j&, n&, xp&, yp&
 
  Me.ScaleMode = vbPixels
  Randomize
  n = 0
  For i = 0 To 14
    If i > 0 Then Load Line1(i)
    yp = 30 + 40 * i
    With Line1(i)
      .X1 = 10
      .Y1 = yp
      .X2 = 800
      .Y2 = .Y1
      .Visible = True
    End With
    xp = 10 + Int(50 * Rnd)
    For j = 1 To Int(Rnd * 8 + 2)
      If n > 0 Then Load Label1(n)
      With Label1(n)
        .Caption = ""
        .Move xp, yp - 15, 30, 30
        .BorderStyle = vbBSNone
        .BackColor = QBColor(Rnd * 15)
        .ToolTipText = "Uhrzeit: ..."
        .ZOrder vbBringToFront
        .Visible = True
      End With
      xp = xp + Int(Rnd * 60 + 40)
      n = n + 1
    Next j
  Next i
 
End Sub
 
Private Sub Label1_Click(Index As Integer)
 
  MsgBox "Pos:" & Str$(Index) & vbCr & "Uhrzeit: ..." & vbCr _
    & "Personen: ...", vbInformation + vbOKOnly
 
End Sub

Gruss,

Zardoz

Private Sub Form_Load()
 
  Dim i%, j%, n%, xp&, yp&, Per%
 
  Me.ScaleMode = vbPixels
  n = 0
  For i = 0 To 14 - 1 ' Anzahl Linien
    If i > 0 Then Load Line1(i)
    yp = 30 + 40 * i ' Abstand von oben und Abstand zwischen den Linien
    With Line1(i)
      .X1 = 10
      .Y1 = yp
      .X2 = 800
      .Y2 = yp
      .Visible = True
    End With
    For j = 1 To 12 ' Anzahl Abholstellen
      If n > 0 Then Load Label1(n)
      Per = aRs!AnzahlPersonen ' Anzahl Personen. Datenbank geöffnet?
      xp = 30 + 60 * (j - 1) ' Abstand von links und Abstand zwischen den 
      ' Abholstellen
      With Label1(n)
        .Alignment = 2
        .Caption = CStr(Per)
        .Move xp, yp - 15, 30, 30
        .BorderStyle = vbBSNone
        .ForeColor = vbWhite
        .BackColor = QBColor(Rnd * 14)
        .ToolTipText = "Uhrzeit: ..."
        .ZOrder vbBringToFront
        .Visible = True
      End With
      n = n + 1
    Next j
  Next i
 
End Sub

Gruss,

Zardoz

Private Sub Label1_Click(Index As Integer)
 
  MsgBox "Pos:" & Str$(Index) & vbCr & "Uhrzeit: ..." & vbCr _
    & "Personen: ..." & Linieninfo, vbInformation + vbOKOnly
End Sub

      With Label1(N)
        .Alignment = 2
        .Height = 400
        .Width = 100
        .Caption = CStr(Per)
        .Move xp, yp - 15, 30, 30
        .BorderStyle = vbBSNone
        .ForeColor = vbWhite
        .BackColor = QBColor(Rnd * 14)
        .ToolTipText = "Uhrzeit: ..."
        .ZOrder vbBringToFront
        .Visible = True
      End With

Zitat:

Ich sollte eine Möglichkeit haben gestzstellen, auf welcher Abhollinie (z.B. 1-14) ein Index liegt. So kann ich bein Click auf ein Label, die Informationen genau dieser Linie abrufen und auch anzeigen. Siehst Du dazu eine Möglichkeit?

  With Label1(n)
    .Tag = CStr(i) & "/" & CStr(j)

Private Sub Label1_Click(Index As Integer)
 
  Dim T$, LineNr%, AbholSt%
 
  T = Label1(Index).Tag
  LineNr = 1 + Val(T)
  AbholSt = Val(Mid$(T, 1 + InStr(1, T, "/")))
  MsgBox "Linie:" & Str$(LineNr) & vbCr _
    & "Abholstelle:" & Str$(AbholSt), vbInformation + vbOKOnly
 
End Sub

Zitat:

ich möchte auf jeder Abholzeile vor der 1. Abholstelle die Bezeichnung der Abhollinie (z.B. Linie Rathaus) ausgeben. Besteht dazu die Möglichkeit?

Zitat:

Kannst Du mir bitte noch mitteilen, wie (über welche Einstellungen) ich die Grösse der angezeigten Boxen verändern Kann?

  Dim Breite&, Hoehe&
  Breite = 30 ' Pixel
  Hoehe = 30 ' Pixel
 
  With Label1(n)
    ' ...
    .Move xp, yp - Hoehe / 2, Breite, Hoehe

Gruss,

Zardoz

Beitrag wurde zuletzt am 03.12.19 um 14:38:27 editiert.

Private Sub Fahrplan()
  Dim i%, j%, N%, xp&, yp&, Per%
  Dim Breite&, Hoehe&
 
  nAnzahl_Lines = 5
  AnzZustiege = 20
  Breite = 15                               ' Pixel
  Hoehe = 25                                ' Pixel
 
  Me.ScaleMode = vbPixels
  N = 0
  For i = 0 To (nAnzahl_Lines - 1)          ' Anzahl Linien
    If i > 0 Then Load Line1(i)
    yp = 30 + 40 * i                        ' Abstand von oben und Abstand 
    ' zwischen den Linien
    With Line1(i)
      .X1 = 10
      .Y1 = yp
      .X2 = 800
      .Y2 = yp
      .Visible = True
    End With
 
    If i > 0 Then
       Load Label2(i)
    End If
 
    With Label2(i)
      .left = 30
      .Alignment = 2
      .Caption = "Linienname"
      .BorderStyle = vbBSNone
      .ForeColor = QBColor(0)
      .BackColor = QBColor(14)
      .ZOrder vbBringToFront
      .Visible = True
    End With
 
    X1 = i
    Init_Linie
 
    For j = 1 To AnzZustiege                ' Anzahl Abholstellen
      If N > 0 Then Load Label1(N)
      Per = AnzPersonen                     ' Anzahl Personen. Datenbank 
      ' geöffnet?
      ' xp = 30 + 40 * (j - 1)                ' Abstand von links und Abstand _
        zwischen den
      xp = 120 + 40 * (j - 1)                ' Abstand von links und Abstand 
      ' zwischen den
 
      With Label1(N)
        .Alignment = 2
        .Caption = CStr(Per)
        .Move xp, yp - Hoehe / 2, Breite, Hoehe
        .BorderStyle = vbBSNone
        .ForeColor = QBColor(ForegroundColor)
        .BackColor = QBColor(BackgroundColor)
        .ToolTipText = "Uhrzeit: ..."
        .Tag = CStr(i) & "/" & CStr(j)
        .ZOrder vbBringToFront
        .Visible = True
      End With
      N = N + 1
    Next j
    AnzZustiege = 5
  Next i
End Sub

  With Label2(i)
    '.left = 30
    .Left = 20 ' Abstand von links
    .Top = yp - Hoehe / 2 ' Abstand von oben
    .Height = Hoehe ' Labelhöhe
  ' ...

Gruss,

Zardoz

Zitat:

das war es, jetzt sieht es gut aus. Ich möchte mich nochmals für Deine Unterstützung und Geduld bedanken. Du hast mir sehr geholfen.

Gruss,

Zardoz

Private flg1 As Boolean
Private PicLst() As StdPicture
 
Private Sub Form_Load()
 
  Me.MousePointer = vbHourglass
  Me.ScaleMode = vbPixels
  Me.KeyPreview = True
  Randomize
  flg1 = False
 
End Sub
 
Private Sub Form_Activate()
 
  If flg1 = True Then Exit Sub
  flg1 = True
  DoEvents
  Call FillGrid
  Me.MousePointer = vbDefault
 
End Sub
 
Private Sub FillGrid()
 
  Dim SW&, SH&, i&, j&, Farben&
 
  Farben = 32
  ReDim PicLst(Farben - 1)
  SW = 68
  SH = 40
 
  With Picture1
    .Visible = False
    .BorderStyle = vbBSNone
    .Move 0, 0, 68, 40
    .ScaleMode = vbPixels
    .BackColor = vbButtonFace
    .AutoRedraw = True
    .FillStyle = vbFSSolid
    For i = 0 To Farben - 1
      .Cls
      Picture1.Line (0, SH / 2)-Step(SW, 0), vbRed
      .FillColor = Rnd * &HFFFFFF
      Picture1.Circle (SW / 2, SH / 2), 19, vbBlack
      Set PicLst(i) = .Image
    Next i
    .Cls
  End With
 
  With MSFlexGrid1
    .Redraw = False
    .Move 0, 0, 1100, 650
    .ScrollTrack = True
    .WordWrap = True
    '.GridLines = flexGridNone ' Gitter ja/nein
    .FixedRows = 1
    .FixedCols = 1
    .BackColor = Picture1.BackColor
    .ForeColor = vbWhite
    .Cols = 35
    .Rows = 20
    .ScrollBars = flexScrollBarBoth
    .RowHeight(-1) = 44 * Screen.TwipsPerPixelY
    .ColWidth(-1) = 70 * Screen.TwipsPerPixelX
    .TextArray(0) = "Plan"
 
    For i = 1 To .Cols - 1
      .TextArray(i) = "Station " & CStr(i)
    Next i
 
    For i = 1 To .Rows - 1
      .TextMatrix(i, 0) = "Linie " & CStr(i) & vbCr & _
        Choose(1 + (i Mod 4), "Bahnhof", "Rathaus", "Museum", "Stadion")
    Next i
 
    For i = 1 To .Rows - 1
      .Row = i
      For j = 1 To .Cols - 1
        .Col = j
        .Text = CStr(Int(Rnd * 16)) & " P."
        .CellAlignment = flexAlignCenterCenter
        .CellPictureAlignment = flexAlignCenterCenter
        Set .CellPicture = PicLst(Int(Rnd * Farben))
      Next j
    Next i
    .Row = .FixedRows
    .Col = .FixedCols
    .Redraw = True
  End With
  Screen.MousePointer = vbDefault
 
End Sub
 
Private Sub MSFlexGrid1_Click()
 
  Dim r&, c&, N&
 
  With MSFlexGrid1
    r = .Row
    c = .Col
    N = Val(.TextMatrix(r, c))
  End With
  MsgBox "Linie: " & CStr(r) & vbCr & "Station: " & CStr(c) & vbCr & _
    "Personen: " & CStr(N), vbInformation + vbOKOnly, App.Title
 
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
  Select Case KeyCode
    Case vbKeyReturn
      Call MSFlexGrid1_Click
    Case vbKeyEscape
      Unload Me
  End Select
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
  MSFlexGrid1.Clear
  Erase PicLst
 
End Sub

Gruss,

Zardoz

' ---------------------------------------------------------------------
' Abholstellen: Abstand von links und Abstand zwischen den Abholstellen
' ---------------------------------------------------------------------
 
If i = 0 Then                         ' = 0   --> 1. Reihe
   xp = 600 + 40 * (j - 1)            ' Abstand von links und Abstand zwischen 
   ' den Abholstellen
End If
 
If i = 1 Then                         ' = 1   --> 2. Reihe
   If j = 1 Then
      xp = 300 + 40 * (j - 1)
   Else
      If j = 2 Then
         xp = 300 + 200 * (j - 1)
      Else
         If j = 3 Then
            xp = 300 + 100 * (j - 1)     ' Abstand von links und Abstand 
            ' zwischen den Abholstellen
         Else
            If j = 4 Then
               xp = 300 + 350 * (j - 1)
            Else
               If j = 5 Then
                  xp = 300 + 450 * (j - 1)
               End If
            End If
         End If
      End If
   End If
End If