Code zu Grafik in Classic Visual Basic

Umwandeln von Twips in Pixel

Visual Basic arbeitet standardmäßig mit Twips als Grafikeinheit, wohingegen das Windows-API mit Pixeln arbeitet. Daher ist es manchmal notwendig, Koordinaten usw. von Twips in Pixel zu konvertieren. Dazu stellt Visual Basic die Funktionen ScaleX und ScaleY zur Verfügung. Statt Me im folgenden Beispiel könnte auch der Name eines PictureBox-Steuerelements oder eines Printer-Objekts angegeben werden, auf dem die Umrechnung stattfinden soll:

Dim TwipsX As Single, TwipsY As Single
Dim PixelsX As Single, PixelsY As Single
TwipsX = 900
TwipsY = 1500
PixelsX = Me.ScaleX(TwipsX, vbTwips, vbPixels)
PixelsY = Me.ScaleY(TwipsY, vbTwips, vbPixels)

Ermitteln von Eigenschaften des Desktops

Folgende Prozeduren können verwendet werden, um die Farbtiefe, Größe und Pixel/Zoll eines Gerätekontexts zu ermitteln. Der Einfachheit halber werden hier nur die Daten des Desktopfensters ausgelesen:

Private Declare Function GetDesktopWindow Lib "user32.dll" ( _
) As Long

Private Declare Function GetDC Lib "user32.dll" ( _
    ByVal hWnd As Long _
) As Long

Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long _
) As Long

Private Const HORZRES As Long = 8&      ' Horizontal size in pixels.
Private Const VERTRES As Long = 10&     ' Vertical size in pixels.
Private Const BITSPIXEL As Long = 12&   ' Bits per Pixel.
Private Const LOGPIXELSX As Long = 88&  ' Pixel/inch in X.
Private Const LOGPIXELSY As Long = 90&  ' Pixel/inch in Y.

Private Sub GetVideoCaps( _
    ByRef BitsPerPixel As Long, _
    ByRef Width As Long, _
    ByRef Height As Long _
)
    Dim hdc As Long
    hdc = GetDC(GetDesktopWindow)
    BitsPerPixel = GetDeviceCaps(hdc, BITSPIXEL)
    Width = GetDeviceCaps(hdc, HORZRES)
    Height = GetDeviceCaps(hdc, VERTRES)
End Sub

Private Sub GetPixelsInch(ByRef Width As Long, ByRef Height As Long)
    Dim hdc As Long
    hdc = GetDC(GetDesktopWindow)
    Width = GetDeviceCaps(hdc, LOGPIXELSX)
    Height = GetDeviceCaps(hdc, LOGPIXELSY)
End Sub

Der Aufruf könnte dann folgendermaßen erfolgen, wobei keine Werte zurückgegeben, sondern Verweisparameter verwendet werden:

Dim d As Long, x As Long, y As Long
Call GetVideoCaps(d, x, y)
Debug.Print "Screen width:     " & CStr(x)
Debug.Print "Screen height:    " & CStr(y)
Debug.Print "Bits per pixel:   " & CStr(d)
Call GetPixelsInch(x, y)
Debug.Print "Pixel/inch in X:  " & CStr(x)
Debug.Print "Pixel/inch in Y:  " & CStr(y)

Um die tatsächliche Anzahl an darstellbaren Farben zu berechnen, könnte folgender Code benutzt werden:

Call MsgBox( _
    "Max. darstellbare Farben: " & _
    Format$(CStr(2 ^ GetDeviceCaps(Me.hDC, BITSPIXEL)), "#,###") _
)

Verwenden von AutoRedraw bei Grafikmethoden

Die GDI-Schnittstelle des Systems und Visual Basic stellen eine große Anzahl von Funktionen zur Verfügung, um Grafiken auf einen Gerätekontext zu kopieren bzw. Linien usw. zu zeichnen. Unter Visual Basic besitzen Formulare und PictureBox-Steuerelemente die AutoRedraw-Eigenschaft. Wird diese Eigenschaft auf True gesetzt, unterhält Windows für den Gerätekontext eine Bitmap im Speicher, sodaß das Fenster schneller aktualisiert werden kann, ohne zu flackern.

Das Setzen von AutoRedraw vor Grafikoperationen ist notwendig, damit das Resultat dauerhaft angezeigt wird und nicht bei jedem Invalidieren des Fensterinhalts neu gezeichnet werden muß. Daher sollte nach folgendem Schema vorgegangen werden, wobei dies sowohl für die entsprechenden Visual-Basic-Funktionen als auch für die API-Funktionen gilt (zu beachten ist das Refresh vor deaktivieren von AutoRedraw, das notwendig ist, damit das neue Bild, das auf den Gerätekontext der AutoRedraw-Bitmap abgelegt ist, auch angezeigt wird):

Me.ScaleMode = vbPixels
Me.AutoRedraw = True    ' <--

' Beliebige Grafikmethoden.
Me.DrawWidth = 8
Me.Line (40, 40)-(100, 100), vbRed
Me.Line (100, 40)-(40, 100), vbRed
Me.ForeColor = vbGreen
Dim hBrush As Long
hBrush = CreateSolidBrush(vbBlue)
Call SelectObject(Me.hDC, hBrush)
Call Rectangle(Me.hDC, 130, 130, 190, 190)
Call DeleteObject(hBrush)

Call Me.Refresh         ' <--
Me.AutoRedraw = False   ' <--

Umwandeln von JPEG/GIF in Bitmap

Manchmal ist es notwendig, JPEGs oder GIFs in Windows-Bitmaps zu konvertieren und in eine Bitmap-Datei abzuspeichern. Dazu könnte folgende Routine verwendet werden (es werden keine Steuerelemente benötigt):

Dim Picture As IPictureDisp
Set Picture = LoadPicture("C:\bild.jpg")
Call SavePicture(Picture, "C:\bild.bmp")

Um eine Windows-Metafile-Datei in eine Bitmap zu konvertieren, muß diese zuerst in eine PictureBox geladen werden und anschließend deren Inhalt mit SavePicture als Bitmap gespeichert werden.

Schnelles Laden und Ausgeben von Bildern

Um eine Grafik direkt aus einer Datei zu laden und in einer beliebigen Größe in einer PictureBox auszugeben, kann folgender Code verwendet werden:

Call Me.Picture1.PaintPicture( _
    LoadPicture(FileName), _
    0, _
    0, _
    Me.Picture1.ScaleWidth, _
    Me.Picture1.ScaleHeight _
)

Aufspalten einer Farbe in ihre Grundfarbanteile

Die Funktion SplitToRGB kann verwendet werden, um eine z. B. als Hexadezimalcode angegebene Farbe in ihre RGB-Komponenten aufzuspalten. Die hier vorgestellte Lösung ist bei weitem nicht optimiert, durch Einsatz von RtlMoveMemory kann die Leistung noch gesteigert werden. Diese Funktion funktioniert nicht mit den Systemfarbwerten:

Private Type RGBColor
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

Private Function SplitToRGB(ByVal Color As Long) As RGBColor
    With SplitToRGB
        .Blue = (Color And 16711680) / 65536
        .Green = (Color And 65280) / 256
        .Red = Color And 255
    End With
End Function

Wie bereits vorher angegeben kann die Effizienz auch durch den Einsatz einer API-Funktion noch etwas gesteigert werden:

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    ByRef Destination As Byte, _
    ByRef Source As Long, _
    ByVal Length As Long _
)

'
' Nach dem Aufruf enthält das Element mit Index 0 den Rot-, das mit
' Index 1 den Grün- und das mit Index 2 den Blauwert.
'
Private Sub RGBsplit2(ByVal Color As Long, ByRef RGB() As Byte)
    Call CopyMemory(RGB(0), Color, 4&)
End Sub

Für den Aufruf muß in RGB ein Array mit den Indizes von 0 bis 3 übergeben werden. Das entspricht vier Elementen, obwohl nur drei erforderlich wären; allerdings ist die Funktion dadurch schneller. Außerdem ist zu beachten, daß die Deklaration von CopyMemory extra für dieses Beispiel angepaßt wurde.

Drucken eines Bildes eingepaßt in die Seite

Nachstehende Funktion wird eingesetzt, um eine Grafik aus einem Picture-Objekt auf den Drucker so auszugeben, daß die Seite optimal ausgenützt wird. Dabei wird das Papierformat passend gewählt und die Grafik skaliert:

Private Sub PrintPictureToFitPage(ByVal Picture As Picture)
    Dim Width As Double, Height As Double
    Dim PictureWidth As Double, PictureHeight As Double
    Dim PictureRatio As Double
    
    ' Determine if picture should be printed in landscape or portrait
    ' and set the orientation.
    Printer.Orientation = _
        IIf( _
            Picture.Height >= Picture.Width, _
            vbPRORPortrait, _
            vbPRORLandscape _
        )
    
    ' Calculate the dimentions of the printable area in HiMetric.
    Width = Printer.ScaleX(Printer.ScaleWidth, Printer.ScaleMode, vbHimetric)
    Height = Printer.ScaleY(Printer.ScaleHeight, Printer.ScaleMode, vbHimetric)
    
    ' Calculate device independent Width-to-Height ratio for picture.
    PictureRatio = Picture.Width / Picture.Height
    
    ' Scale the output to the printable area.
    If PictureRatio >= Width / Height Then
        
        ' Scale picture to fit full width of printable area.
        PictureWidth = _
            Printer.ScaleX(Width, vbHimetric, Printer.ScaleMode)
        PictureHeight = _
            Printer.ScaleY(Width / PictureRatio, vbHimetric, Printer.ScaleMode)
    Else
        
        ' Scale picture to fit full height of printable area.
        PictureHeight = _
            Printer.ScaleY(Height, vbHimetric, Printer.ScaleMode)
        PictureWidth = _
            Printer.ScaleX(Height * PictureRatio, vbHimetric, Printer.ScaleMode)
    End If
    
    ' Print the picture using the PaintPicture method.
    Call Printer.PaintPicture(Picture, 0, 0, PictureWidth, PictureHeight)
End Sub

Spiegeln von Bildern

Oft hört man die Frage, wie Grafiken mit Visual-Basic-eigenen Mitteln gespiegelt werden können. Die folgenden Beispiele zeigen, wie es funktioniert. Dabei wird angenommen, daß picSource die Quellbitmap und picDestination das Ziel darstellen:


' Normale Kopie erstellen.
Call Me.picDestination.PaintPicture( _
    Me.picSource.Picture, _
    0, 0, _
    Me.picSource.Width, Me.picSource.Height, _
    0, 0, _
    Me.picSource.Width, Me.picSource.Height, _
    vbSrcCopy _
)

' Horizontal spiegeln.
Call Me.picDestination.PaintPicture( _
    Me.picSource.Picture, _
    0, 0, _
    Me.picSource.Width, Me.picSource.Height, _
    Me.picSource.Width, 0, _
    -Me.picSource.Width, Me.picSource.Height, _
    vbSrcCopy _
)

' Vertikal spiegeln.
Call Me.picDestination.PaintPicture( _
    Me.picSource.Picture, _
    0, 0, _
    Me.picSource.Width, Me.picSource.Height, _
    0, Me.picSource.Height, _
    Me.picSource.Width, -Me.picSource.Height, _
    vbSrcCopy _
)

' Horizontal und vertikal spiegeln.
Call Me.picDestination.PaintPicture( _
    Me.picSource.Picture, _
    0, 0, _
    Me.picSource.Width, Me.picSource.Height, _
    Me.picSource.Width, Me.picSource.Height, _
    -Me.picSource.Width, -Me.picSource.Height, _
    vbSrcCopy _
)

Mit PaintPicture ist es auch möglich, Grafiken zu vergrößern bzw. zu verkleinern. Folgender Codeausschnitt vergrößert eine Grafik auf das Dreifache der Originalgröße:

Me.picSource.AutoSize = True
Me.picDestination.Width = Me.picSource.Width * 3
Me.picDestination.Height = Me.picSource.Height * 3
Me.picDestination.AutoRedraw = True

Call Me.picDestination.PaintPicture( _
    Me.picSource.Picture, _
    0, 0, _
    Me.picDestination.ScaleWidth, Me.picDestination.ScaleHeight, _
    0, 0, _
    Me.picSource.ScaleWidth, Me.picSource.ScaleHeight _
)

Wiederverwenden des Desktophintergrundbildes

Die API-Funktion PaintDesktop füllt den entsprechenden Bereich des angegebenen Gerätekontexts mit dem Hintergrundbild oder dem Hintergrundmuster. Die Funktion wird hauptsächlich für Shell-Desktops zur Verfügung gestellt:

Private Declare Function PaintDesktop Lib "user32.dll" ( _
    ByVal hdc As Long _
) As Long

Private Sub Form_Paint()
    Call PaintDesktop(Me.hDC)
End Sub

Ermitteln der Maße eines Bildes

Der nachstehende Code ermittelt mit reinen Visual-Basic-Mitteln die Maße einer Grafikdatei:

Private Sub Main()
    Dim Picture As StdPicture
    Set Picture = LoadPicture(App.Path & "\wellen.bmp")
    Dim Height As Long, Width As Long
    Call GetPictureDimensions(Picture, Height, Width)
    Call MsgBox( _
        "Die angegebene Bitmap ist" & vbNewLine & _
        CStr(Height) & " Pixel hoch und" & vbNewLine & _
        CStr(Width) & " Pixel breit." _
    )
End Sub

Private Sub GetPictureDimensions( _
    ByVal Picture As StdPicture, _
    ByRef Height As Long, _
    ByRef Width As Long _
)
    Width = CLng(Me.ScaleX(Picture.Width, vbHimetric, vbPixels))
    Height = CLng(Me.ScaleY(Picture.Height, vbHimetric, vbPixels))
End Sub

Drucken einfacher Namensetiketten

Es sollen Namensetiketten ausgedruckt werden, wobei der Name und die dazugehörige Adresse in einer Zeichenfolge abgelegt sind. Diese Zeichenfolge ist durch Zeilenumbrüche formatiert. Folgender Code druckt eine Seite angegebener Größe mit einer Beispieladresse in ein PictureBox-Steuerelement. Im Parameter Out kann man auch ein Printer-Objekt angeben, damit die Ausgabe auf den Drucker erfolgt:

Private Sub cmdPreview_Click()
    Call PrintStickers( _
        "Maximilian M. Mustermann" & vbNewLine & _
        "Musterstrasse 22" & vbNewLine & _
        "23923 Musterstadt", _
        Me.picPreview _
    )
End Sub

Private Sub PrintStickers(ByVal Text As String, ByVal Out As Object)
    On Error Resume Next
    Dim Height As Long, Width As Long
    Height = Out.TextHeight(Text) + 400
    Width = Out.TextWidth(Text) + 400
    Dim Rows As Long, Columns As Long
    Rows = Out.ScaleHeight \ Height
    Columns = Out.ScaleWidth \ Width
    Dim BaseLeft As Long, BaseTop As Long
    BaseLeft = (Out.ScaleWidth - Width * Columns) * 0.5
    BaseTop = (Out.ScaleHeight - Height * Rows) * 0.5
    Dim i As Long, j As Long
    For j = 0 To Rows - 1
        For i = 0 To Columns - 1
            Out.CurrentY = BaseTop + Height * j + 200
            Dim Lines As String
            Lines = Split(Text, vbNewLine)
            Dim k As Long
            For k = LBound(Lines) To UBound(Lines)
                Out.CurrentX = BaseLeft + Width * i + 200
                Out.Print Lines(k)
            Next k
        Next i
    Next j
    If TypeOf Out Is Printer Then
        Call Out.EndDoc
    End If
End Sub

Es wird dabei automatisch berechnet, wie viele Elemente auf dem zu bedruckenden Objekt Platz finden und der Ausgaberaster wird anschließend dementsprechend zentriert. Das Beispiel wurde für einen Programmieranfänger geschrieben und zeigt die Verwendung von Schleifen sowie das Drucken von einfachem Text.