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.793 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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
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. |