vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font   |   VB-Versionen: VB200827.06.08
Skalierte Werte zeichnen

Struktur für das Zeichnen skalierter Werte durch pixelbezogene Methoden: ScaleLeft, -Top, -Width, -Height

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  12.371 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11kein Beispielprojekt 

In Visual Basic steht mit dem Graphics-Objekt (im NameSpace: System.Drawing) die Möglichkeit zur Verfügung, auf eine umfangreichen Sammlung von Methoden zum Zeichen zurückzugreifen.

Die Parameter zur Angabe der Position, an der gezeichnet werden soll, erwarten Pixel-bezogene Werte.O ft möchte man aber Zeichnungen auf der Grundlage von (rohen) Daten anfertigen, die nicht als Pixel skaliert sind (sog. benutzerdefinierte Skalen).

Die Structure 'UD_Scale' bietet die Möglichkeit, je eine Skala für die x- und die y-Achse einer Bitmap-Fläche zu definieren. Die Eigenschaften 'ScaleTop' und 'ScaleLeft' definieren Skalenwerte für die linke obere Ecke der Bitmap (= Pixelposition: 0, 0). Unter Verwendung der PX- und der PY-Methode dieser Struktur können dann pixel-skalierte Rohwerte an die Parameter der verschiedenen Zeichenmethoden übergeben werden.

Als Anwendungsbeispiel dient die Routine Zeichne_PunkteWolke.
Sie erwartet als Eingabe zwei gleichlange eindimensionale Arrays des Typs 'Single', die jeweils einen Datenvektor enthalten. Unter Verwendung von 'Extensions' der Array-Klasse (Min, Max) wird der Datenraum ermittelt und unter Verwendung eines 'Erweiterungsfaktors' werden die Skalen definiert.

Die x,y-Werte können nach der Skalendefinition formatfüllend in der als Parameter übergebenen Bitmap positioniert werden (Methode 'SetPixel'). Dabei wird der Farbparameter verwendet.

Da die Struktur aus Kompatibilitätsgründen den Datentyp 'Single' benutzt, ist bei (absolut) großen Datenausprägungen Vorsicht geboten (Rundungsprobleme). Bei Bedarf kann man auf 'Decimal' oder 'Double' umstellen (globales Ersetzen).

Durch Hinzufügung und Verarbeitung weiterer Eigenschaften (z.B. 'BitmapLeft', 'BitmapTop') können auch Teilbereichen einer Bitmap Skalenwerte zugeordnet werden.

Hinweis für VB6-Umsteiger:
Wenn Sie sich jetzt wundern, liegen Sie richtig.

In VB6 kann man direkt skaliert in die 'PictureBox' zeichnen. Für eine hochentwickelte Programmiersprache ist das eine Selbstverständlichkeit. Bei den aktuellen VB-Versionen ist es empfehlenswert, in eine Instanz des Bitmap-Objekts zu zeichnen, dessen Größe bei der Deklaration an die Abmessungen der für die Anzeige verwendeten PictureBox angepasst wird.

Statt der gewohnten VB6-PictureBox-Eigenschaften 'ScaleLeft' etc. erfolgt die Skalendefinition nun durch eine Instanz von 'UD_Scale'. Die Pixel-Skalierung der Werte x,y wird durch die Methoden PX, PY vorgenommen.

Abweichend vom Verhalten der VB6-Eigenschaften können für 'ScaleWidth' und 'ScaleHeight' in 'UD_Scale' keine negativen Werte angegeben werden. Wird die dadurch bewirkte Skalen-Umkehrung benötigt, ist 'UD_Scale' entsprechend zu erweitern. Als Alternative kann nach dem Erstellen der Zeichnung die Bitmap-Methode 'RotateFlip' herangezogen werden.

Gezeichnet wird durch Verwendung der Graphics-Methoden.

Nach dem Erstellen der Zeichnung wird die Bitmap der 'Image'-Eigenschaft einer 'PictureBox' zugewiesen.

In VB6 gibt es neben der Pixelskala auch weitere vordefinierte Skalen (z.B. HiMetric, Millimeter), anzufordern durch die 'ScaleMode'-Eigenschaft. Um die 'UD_Scale'-Struktur für diese Skalen zu verwenden, setzen Sie 'ScaleTop' und 'ScaleLeft' auf 0 und 'ScaleWidth' auf Bitmap.Width * Skalierungsfaktor ('ScaleHeight' entsprechend).

Der jeweils benötigte Skalierungsfaktor kann maschinenabhängig sein.
(Verwenden Sie in VB6 zur Bestimmung 'ScaleX', 'ScaleY')

Hier meine Werte:

' Aus VB6 entnommene Umrechnungsfaktoren: 
' Pixel --> andere Skalen
Const cPixelToTwips As Single = 15.0
Const cPixelToPoints As Single = 0.75
Const cPixelToCharactersX As Single = 0.125 
Const cPixelToCharactersY As Single = 0.0625
Const cPixelToInches As Single = 0.01041667
Const cPixelToMillimeter As Single = 0.2645836
Const cPixelToCentimeter As Single = 0.02645836
Const cPixelToHimetric As Single = 26.45833
''' <summary>
''' Benutzerdefinierte Skala für Bitmap-Zeichnungen
''' </summary>
Public Structure UD_Scale
 
  ''' <summary>Skalenparameter</summary> 
  Private gScaleLeft As Single   ' Untergrenze Horizontalachse
  Private gScaleTop As Single    ' Untergrenze Vertikalachse
  Private gScaleWidth As Single  ' Skalenumfang Horizontal
  Private gScaleHeight As Single ' Skalenumfang Vertikal
 
  Private gBitmapWidth As Integer  ' Bitmapbreite in Pixel
  Private gBitmapHeight As Integer ' Bitmaphöhe in Pixel
 
  Const cEpsilon As Double = 0.00001 ' Mindestskalenbreite
 
  ''' <summary>Skalen-Untergrenze (Horizontal)</summary>
  ''' <value>Skalen-Untergrenze (Horizontal)</value> 
  Public WriteOnly Property ScaleLeft() As Single
    Set(ByVal value As Single)
      gScaleLeft = value
    End Set
  End Property
 
  ''' <summary>Skalen-Untergrenze (Vertikal)</summary>
  ''' <value>Skalen_Untergrenze (Vertikal)</value>
  Public WriteOnly Property ScaleTop() As Single
    Set(ByVal value As Single)
      gScaleTop = value
    End Set
  End Property
 
  ''' <summary>Skalen-Länge (Horizontal)</summary>
  ''' <value>Skalen-Länge (Horizontal)</value>
  Public WriteOnly Property ScaleWidth() As Single
    Set(ByVal value As Single)
      gScaleWidth = value
    End Set
  End Property
 
  ''' <summary>Skalen-Länge (Vertikal)</summary>
  ''' <value>Skalen-Länge (Vertikal)</value>
  Public WriteOnly Property ScaleHeight() As Single
    Set(ByVal value As Single)
      gScaleHeight = value
    End Set
  End Property
 
  ''' <summary>Bitmap-Breite</summary>
  ''' <value>Bitmap-Breite</value>
  Public WriteOnly Property BitmapWidth() As Integer
    Set(ByVal value As Integer)
      gBitmapWidth = value
    End Set
  End Property
 
  ''' <summary>Bitmap-Höhe</summary>
  ''' <value>Bitmap-Höhe</value>
  Public WriteOnly Property BitmapHeight() As Integer
    Set(ByVal value As Integer)
      gBitmapHeight = value
    End Set
  End Property
 
  ''' <summary>Pixelposition x (Horizontale)</summary>
  ''' <param name="x">Skalenwert</param>
  ''' <returns>Pixelposition Breite</returns>
  Public ReadOnly Property PX (ByVal x As Single) As Integer
    Get
      If Not CheckScale() Then Return -1
      If Not IsInScaleX(x) Then Return -1
      Return CInt((x - gScaleLeft) / _
        gScaleWidth * CDbl(gBitmapWidth))
    End Get
  End Property
 
  ''' <summary>Pixelposition y (Vertikale)</summary>
  ''' <param name="y">Skalenwert</param>
  ''' <returns>Pixelposition Höhe</returns>
  Public ReadOnly Property PY(ByVal y As Single) As Integer
    Get
      If Not CheckScale() Then Return -1
      If Not IsInScaleY(y) Then Return -1
      Return CInt((y - gScaleTop) / _
        gScaleHeight * CDbl(gBitmapHeight))
    End Get
  End Property
 
  Public Function CheckScale() As Boolean
    ' Skalenparameter auf Plausibilität prüfen
    Try
      If gScaleWidth < cEpsilon Then Return False
      If gScaleHeight < cEpsilon Then Return False
      If gBitmapWidth < 10 Or _
        gBitmapHeight < 10 Then Return False
      If gBitmapWidth > 2100 Or _
        gBitmapHeight > 2100 Then Return False
 
      ' Skalen Maximalwerte zulässig ??
      Dim y As Single = gScaleTop + gScaleHeight
      Dim x As Single = gScaleLeft + gScaleWidth
      Return True
    Catch
      Return False
    End Try
  End Function
 
  Private Function IsInScaleX(ByVal x As Single) As Boolean
    ' Liegt der Skalenwert im Bitmap-Bereich?
    If x < gScaleLeft Or _
      x > gScaleLeft + gScaleWidth Then
      Return False
    Else
      Return True
    End If
  End Function
 
  Private Function IsInScaleY(ByVal y As Single) As Boolean
    ' Liegt der Skalenwert im Bitmap-Bereich?
    If y < gScaleTop Or _
      y > gScaleTop + gScaleHeight Then
      Return False
    Else
      Return True
    End If
  End Function
End Structure
Public Function Zeichne_PunkteWolke(ByVal bmp As Drawing.Bitmap, _
  ByVal col As Drawing.Color, _
  ByVal x() As Single, _
  ByVal y() As Single) As Boolean
 
  If UBound(x) <> UBound(y) Then Return False
 
  Dim sc As New UD_Scale
  ' Skala für Bitmap und Daten definieren 
  ' in jede Richtung 5% gegenüber Datenraum erweitert 
  Dim fak As Single = CDec(0.05)
  Dim w As Single = (x.Max - x.Min) * (1 + fak * 2)
  Dim h As Single = (y.Max - y.Min) * (1 + fak * 2)
  With sc
    .ScaleLeft = x.Min - fak * (x.Max - x.Min)
    .ScaleTop = y.Min - fak * (y.Max - y.Min)
    .ScaleWidth = w
    .ScaleHeight = h
    .BitmapHeight = bmp.Height
    .BitmapWidth = bmp.Width
    If Not .CheckScale Then Return False
  End With
 
  ' Punkte zeichnen unter Verwendung der 
  ' daten- und bitmap-bezogenen Skala
  For i As Integer = 0 To UBound(x)
    Zeichne_Kreuz(bmp, sc.PX(x(i)), sc.PY(y(i)), col)
  Next i
  Return True
End Function
Private Sub Zeichne_Kreuz(ByRef bmp As Drawing.Bitmap, _
  ByVal px As Integer, ByVal py As Integer, _
  ByVal col As Drawing.Color, _
  Optional ByVal Size As Integer = 2)
 
  ' In eine Bitmap ein kleines Datenkreuz 
  ' an der Position px, py eintragen
  On Error Resume Next
  For i As Integer = px - Size To px + Size
    bmp.SetPixel(i, py, col)
  Next i
  For i As Integer = py - Size To py + Size
    bmp.SetPixel(px, i, col)
  Next i
End Sub

Dieser Tipp wurde bereits 12.371 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

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.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel