Da die Access-Circle-Funktion nur in Berichten, nicht aber auf Formularen funktioniert, habe ich hierfür eine eigene Funktion entwickelt. Diese Funktion zeichnet in einem ACCESS-Formular / Berichts-Bereich einen Kreis / Kreisbogen aus Linien (Strichen) mit ACCESS-eigenen "Ur-Mitteln". Nützlich ist dies z. B. dann, wenn man den Hintergrund hinter dem Kreis variabel haben will, was mit einem Kreis-Bild nicht mehr geht. In solchen Fällen kann man sich mit der folgenden Funktion behelfen: Option Compare Database Option Explicit Public Function KreisAusLinien( _ F_BEREICH As Section, S_NAME As String, S_ZEIGEN As Boolean, _ Optional S_ORDNEN As Boolean, Optional ORD_VONOBEN = 0.5 * 567, _ Optional S_BREITE, Optional S_FARBE, Optional S_FARBE2, Optional S_LAENGE, _ Optional M_OBEN, Optional M_LINKS, Optional K_RADIUS, _ Optional A_WINKEL, Optional E_WINKEL) ' *********************************************************************************** ' Funktion zeichnet in einem ACCESS-Form./Berichts-Bereich einen Kreis/Kreisbogen ' aus Linien (Strichen) mit ACCESS-eigenen "Ur-Mitteln" ! ' (Die ACCESS-Circle-Funktion funktioniert leider nur in Berichten.) ' Wenn man z.B. den Hintergrund hinter dem Kreis variabel haben will, dann ' geht das z.B. mit einem Kreis-Bild nicht mehr. In solchen Fällen kann man sich ' mit der folgenden Funktion behelfen (wenn' s nicht zu viele Kreise sind...) ' **************************** Parameter ******************************************** ' F_BEREICH ' Formular-Bereich, in dem der Kreis gebildet werden soll. zB.: ' "Forms![For_KreisAusLinien].Section(acHeader)" ' S_NAME ' Erste Zeichen Aller Strich-Control-Linien, zB. "Str__" ' S_ZEIGEN ' True/False, NUR Alle Striche sichtbar/unsichtbar machen, nicht mehr. ' ************************* optionale Parameter ************************************* ' S_ORDNEN ' True/False ' - False positioniert alle Striche zum Kreis entspr. der anderen Optionen... ' - True positioniert (ordnet) alle Striche so ("Ordnung" reinbringen) : ' -Höhe = 0.5 cm ' -Breite= 0.2 cm ' -Stärke= 3pt ' -Oben = 0,5 cm bzw.ORD_VONOBEN , +0,6 cm... +0,6 cm....(zeilenweise) ' -Links = 0.5 cm, 0.53 cm, 0.56 cm, .... (10 Striche= 0.5 + 3cm...) ' -...-> 20 pro Zeile = 6 cm breit, bis es "knallt".... ' Diese Option ist auch gedacht, um Ordnung zu schaffen: ' Form im Entwurf öffnen, Funktion aufrufen und dann Form speichern. ' ORD_VONOBEN Oben-Mass für den ersten Strich beim Ordnen ' ' S_BREITE ' Strichbreite 0...6 ' S_FARBE ' Strich-Farbe ' S_FARBE2 ' Strich-Farbe 2 (Alternierende Strich-Farben, zB. auf Bildern...) ' S_LAENGE ' Strich-Länge ' M_OBEN ' ACCESS-Oben-Abstand des Mittelpunktes ' M_LINKS ' ACCESS-Links-Abstand des Mittelpunktes ' K_RADIUS ' Kreisradius ' A_WINKEL ' AnfangsWinkel für Kreisbogen (Eingabe in Grad !!!) ' E_WINKEL ' EndWinkel für Kreisbogen (Eingabe in Grad !!!) ' ********************************************************************* On Error GoTo ERR_01 Dim i As Long, n As Long Dim CTL_FELD ' Feld mit den Strich-Controls Dim CTL_ANZ As Long ' Anzahl der Strich-Controls ReDim PROP_FELD(10, 0) ' Properties-Feld für alle Strich-Controls ' 0-Spalte: Strich-Control (nicht der Control-Name!, Form + Form-Bereich + Control) ' 1-Spalte: Kreiswinkel für Strich-Control ' 2-Spalte: y-Koordinate (Bezug: Kreismittelpunkt-> ACCESS-Oben-Wert) ' 3-Spalte: x-Koordinate (Bezug: Kreismittelpunkt-> ACCESS-Links-Wert) ' 4-Spalte: Strich-Höhe ' 5-Spalte: Strich-Breite Dim W_DIFF ' Winkel-Differenz zwischen den Strichen Dim O_ORD ' Differenz der Oben-Werte zwischen "Zeilen" beim Ordnen der Strich-Controls O_ORD = 0.6 * 567 Dim L_ORD ' Differenz der Links-Werte zwischen "Spalten" beim Ordnen der Strich-Controls L_ORD = 0.3 * 567 Dim z As Integer, s As Integer ' Zeilen- und Spalten-Zähler beim Ordnen Dim O_ANF As Long, L_ANF As Long ' Oben- und Links- Anfangswert beim Ordnen L_ANF = 0.5 * 567 O_ANF = ORD_VONOBEN ' **** Liste mit Strich-Controls holen ************************************ CTL_FELD = ControlListeStricheInForm(F_BEREICH, S_NAME) CTL_ANZ = UBound(CTL_FELD, 1) ' **** Striche im Formularbereich F_BEREICH zeigen ? ********************** For i = 1 To CTL_ANZ CTL_FELD(i).Visible = S_ZEIGEN Next i ' **** Striche im Formularbereich F_BEREICH "ordnen" ? ******************** If IsMissing(S_ORDNEN) Then Exit Function If S_ORDNEN = True Then ' Striche im Formularbereich F_BEREICH "ordnen" ! z = 0 s = 0 For i = 1 To CTL_ANZ CTL_FELD(i).Top = O_ANF + z * O_ORD CTL_FELD(i).Left = L_ANF + s * L_ORD CTL_FELD(i).Height = 0.5 * 567 CTL_FELD(i).Width = 0.2 * 567 CTL_FELD(i).BorderWidth = 3 ' Einheitliche Strich-Stärke CTL_FELD(i).LineSlant = True ' Einheitliche ACCESS-Neigung CTL_FELD(i).BorderColor = 0 ' Einheitliche Farbe schwarz CTL_FELD(i).Visible = True ' sichtbar ! s = s + 1 If s >= 20 Then ' Zeile ist voll ! s = 0 ' Wieder Spalte 1 (in neuer Zeile) z = z + 1 ' neue Zeile ! End If Next i End If ' **** Striche-Stärke einstellen ****************************************** If Not IsMissing(S_BREITE) Then For i = 1 To CTL_ANZ CTL_FELD(i).BorderWidth = S_BREITE ' Einheitliche Strich-Stärke Next i End If ' **** Strich-Farbe einstellen ******************************************* If IsMissing(S_FARBE) Then Exit Function If IsMissing(S_FARBE2) Then S_FARBE2 = S_FARBE ' gleichfarbig End If For i = 1 To (CTL_ANZ) If i / 2 - Int(i / 2) > 0 Then CTL_FELD(i).BorderColor = S_FARBE Else CTL_FELD(i).BorderColor = S_FARBE2 End If Next i ' **** Striche-Länge da ? ****************************************** If IsMissing(S_BREITE) Then Exit Function If IsMissing(S_LAENGE) Then Exit Function If IsMissing(M_OBEN) Then Exit Function If IsMissing(M_LINKS) Then Exit Function If IsMissing(K_RADIUS) Then Exit Function If IsMissing(A_WINKEL) Then Exit Function If IsMissing(E_WINKEL) Then Exit Function ReDim PROP_FELD(10, CTL_ANZ) ' *** Strich-Controls eintragen in 0-Spalte ******************** For i = 1 To CTL_ANZ Set PROP_FELD(0, i) = CTL_FELD(i) Next i ' *** Pi berechnen ********************************************* Dim pi pi = 4 * Atn(1) ' ( tan(90 Grad = Pi/4) = 1 ) ' *** Kreis-Winkel in 1-Spalte ********************************* A_WINKEL = A_WINKEL * (pi / 180) ' Umrechnen Grad--> Rad E_WINKEL = E_WINKEL * (pi / 180) ' *** Eingegebene Winkel "logisch berücksichtigen". (alle Strich-Linien optimal platzieren) *** If (E_WINKEL - A_WINKEL) >= 1.999999999 * pi Then ' geschl. Kreis, alle Striche ausnutzen! ' (letzte Strich-Pos. = 1 Intervall vor Endwinkel!) W_DIFF = (E_WINKEL - A_WINKEL) / (CTL_ANZ) Else ' offener Kreis (letzte Strich-Pos genau auf den End-Winkel!) W_DIFF = (E_WINKEL - A_WINKEL) / (CTL_ANZ - 1) End If For i = 1 To CTL_ANZ PROP_FELD(1, i) = A_WINKEL + (i - 1) * W_DIFF ' Winkel-Einträge ! Next i ' *** Y- und X- Koordinaten (von KreisMitte) in 2-, 3- Spalte *** For i = 1 To CTL_ANZ PROP_FELD(2, i) = K_RADIUS * Sin(PROP_FELD(1, i)) ' Y (vertikal) PROP_FELD(3, i) = K_RADIUS * Cos(PROP_FELD(1, i)) ' X (horiz.) Next i ' *** Y- und X- Koordinaten für ACCESS umrechnen in Oben- Links *** For i = 1 To CTL_ANZ PROP_FELD(2, i) = -PROP_FELD(2, i) + M_OBEN ' Oben PROP_FELD(3, i) = PROP_FELD(3, i) + M_LINKS ' Links Next i ' *** Höhe+Breite der Striche in 4-, 5- Spalte **************************** For i = 1 To CTL_ANZ PROP_FELD(4, i) = Abs(S_LAENGE * Cos(PROP_FELD(1, i))) ' Y (vertikal) PROP_FELD(5, i) = Abs(S_LAENGE * Sin(PROP_FELD(1, i))) ' X (horiz.) Next i ' *** Kreis mit Strich-Controls zeichnen ********************************** For i = 1 To CTL_ANZ PROP_FELD(0, i).Height = PROP_FELD(4, i) ' errechnete abs. Höhe PROP_FELD(0, i).Width = PROP_FELD(5, i) ' errechnete abs. Breite ' ACCESS-Neigung einstellen: If Sgn(Sin(PROP_FELD(1, i)) * Cos(PROP_FELD(1, i))) > 0 Then PROP_FELD(0, i).LineSlant = False ' ACCESS-Neigung für 1. + 3 Quadrand Else PROP_FELD(0, i).LineSlant = True ' ACCESS-Neigung für 2. + 4 Quadrand End If ' Strich-Positionen aus eigener Höhe+Breite korrigieren für ACCESS (Oben+Links): PROP_FELD(0, i).Top = PROP_FELD(2, i) - (PROP_FELD(0, i).Height / 2) ' Oben PROP_FELD(0, i).Left = PROP_FELD(3, i) - (PROP_FELD(0, i).Width / 2) ' Links Next i Exit Function ERR_01: MsgBox "KreisAusLinien(...): " & Err.Number & " " & Err.Description End Function Public Function TestKreisAusLinien() Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), _ "St__", True, False, , 1, 255, , 0.15 * 567, 6 * 567, 7 * 567, 5 * 567, -90, 270) MsgBox "weiter mit Halbkreis -90 ... +90" Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), _ "St__", True, False, , 1, 255, , 0.15 * 567, 6 * 567, 7 * 567, 5 * 567, -90, 90) MsgBox "weiter mit Halbkreis 90 ... 270" Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), _ "St__", True, False, , 1, 255, , 0.15 * 567, 6 * 567, 7 * 567, 5 * 567, 90, 270) End Function Public Function TestKreisAusLinienFormularKopf(S_BREITE, S_FARBE, S_LAENGE, _ M_OBEN, M_LINKS, K_RADIUS, A_WINKEL, E_WINKEL) Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), _ "St__", True, False, 3 * 567, S_BREITE, S_FARBE, , S_LAENGE * 567, M_OBEN * 567, _ M_LINKS * 567, K_RADIUS * 567, A_WINKEL, E_WINKEL) End Function Public Function TestKreisAusLinienVonBis(A_WINKEL As Double, E_WINKEL As Double) Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), _ "St__", True, False, , 1, 255, , 0.15 * 567, 6 * 567, 7 * 567, 5 * 567, _ A_WINKEL, E_WINKEL) End Function Public Function TestKreisAusLinienOrdnen() Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), "St__", _ True, True, 5 * 567) End Function Public Function TestKreisAusLinienUnsichtbar() Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), "St__", False) End Function Public Function TestKreisAusLinienAlternierend_sw() Call KreisAusLinien(Forms![For_KreisAusLinien2].Section(acHeader), "St__", _ True, False, , , 0, RGB(255, 255, 255)) End Function Public Function ControlListeStricheInForm(F_BEREICH As Section, S_NAME As String) ' ********************************************************************* ' Liste der Strich-Controls in Formular F_NAME ermitteln ausgeben ' F_BEREICH ' Formular-Bereich!, in dem der Kreis gebildet werden soll. ' S_NAME ' Erste Zeichen Aller Strich-Control-Namen, z.B. "Str__" On Error GoTo ERR_01 Dim ctl1 As Control, i As Long Dim CTL_FELD() As Control For Each ctl1 In F_BEREICH.Controls If Left(ctl1.Name, Len(S_NAME)) = S_NAME Then i = i + 1 ReDim Preserve CTL_FELD(i) Set CTL_FELD(i) = ctl1 End If Next ctl1 ControlListeStricheInForm = CTL_FELD Exit Function ERR_01: MsgBox "ControlListeStricheInForm(...): " & Err.Number & " " & Err.des End Function Public Function TestAnzahlStricheInForm() ' zeigt alle Strich-Control-Namen im Formular-Kopf Dim CTL_FELD CTL_FELD = ControlListeStricheInForm(Forms![For_KreisAusLinien].Section(acHeader), "St__") Dim i As Long, X For i = 1 To UBound(CTL_FELD, 1) X = X & CTL_FELD(i).Name & vbNewLine Next i MsgBox X End Function Dieser Tipp wurde bereits 13.758 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |