ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 08.01.2002

Diese Seite wurde zuletzt aktualisiert am 08.01.2002
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicActiveX-Komponenten, Controls, Klassen und mehr...AddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zum ABOUT Visual Basic-Magazin, Kontakt und Impressum

Zurück...

Kacheleien

Zurück...


Anzeige

(-hg) mailto:hg_tilepicture@aboutvb.de

Ein Bild auf einem Hintergrund zu kacheln ist ein im Prinzip einfache Angelegenheit. Sie kopieren es im Paint-Ereignis eines Forms (oder einer PictureBox, eines UserControls, eines UserDocuments, einer PropertyPage) einfach so oft nebeneinander und untereinander, bis die Fläche gefüllt ist. So lange die Größe der Fläche nicht dynamisch geändert wird, ist das Verfahren auch ausreichend.

Wenn Sie aber beispielsweise die Fläche eines Forms füllen möchten, muss der beim Vergrößern des Forms entstehende Freiraum nachträglich gefüllt werden. Würden Sie hierbei auch wieder die gesamte Fläche erneut füllen, von links oben beginnend, würde es unweigerlich zu Flackereffekten kommen. Eine Optimierung für diesen Fall ist also angebracht. Dazu brauchen Sie im Resize-Ereignis lediglich festzuhalten, ob gerade eine Vergrößerung stattgefunden hat. Im nachfolgenden Paint-Ereignis entscheiden Sie dementsprechend, ob die gesamte Fläche neu gekachelt werden muss, oder ob nur die hinzugekommenen Teilbereiche ergänzt werden sollen.

Natürlich können Sie nun die Kachelei nicht einfach an den Kanten der Teilbereiche beginnen. Sie müssen vielmehr dafür sorgen, dass immer im vollständigen Kachelraster gezeichnet wird - gegebenenfalls zuvor "angebrochene" Rasterfelder müssen auch vollständig gefüllt werden. Dazu kommt, dass bei einer Vergrößerung sowohl der Breite als auch der Höhe an der rechten Seite oben und an der Unterseite links begonnen werden muss. Erfolgt die Vergrößerung nur in einer Richtung, brauchen Sie dagegen erst tatsächlich am Beginn der hinzugekommenen Fläche anzusetzen.

Denkbar ist auch eine Teilfüllung der Fläche, etwa mit einem in die Fläche hinein verschobenen Ursprung, oder mit einer verminderten Breite oder Höhe.

Die folgende Prozedur TilePicture füllt die Fläche eines VB-Objekts, das über die üblichen Eigenschaften und Methoden einer Zeichenfläche verfügt. Das Objekt wird im ersten Parameter übergeben. Die Übergabe des zu kachelnden Bildes im zweiten Parameter ist optional. Fehlt das Bild, wird versucht, das Bild der Picture-Eigenschaft des Objekts zu entnehmen. Die Start-Angaben X und Y und die maximale Breite und Höhe in den weiteren Parametern sind optional. Bei fehlenden Start-Angaben wird links bzw. oben in der Fläche begonnen. Bei fehlender Breite oder Höhe (oder Werten gleich 0) werden die kompletten Innenabmessungen (ScaleWidth bzw. ScaleHeight) angenommen. Bei negativen Werten die Start-Angaben in der entsprechenden Richtung intern aus der Fläche hinaus geschoben, so dass in dieser Richtung keine Kachelung erfolgt (dies dient zur Optimierung bei einer Größenänderung der Fläche).

Public Sub TilePicture(Obj As Object, _
 Optional Picture As StdPicture, _
 Optional ByVal X As Variant, _
 Optional ByVal Y As Variant, _
 Optional ByVal Width As Single, _
 Optional ByVal Height As Single)

  Dim nWidth As Single
  Dim nHeight As Single
  Dim nPicWidth As Single
  Dim nPicHeight As Single
  Dim nX As Single
  Dim nY As Single
  Dim nLeft As Single
  Dim nPicture As StdPicture
  
  With Obj
    If Picture Is Nothing Then
      On Error Resume Next
      Set nPicture = .Picture
      On Error GoTo 0
    Else
      Set nPicture = Picture
    End If
    If nPicture Is Nothing Then
      .Cls
      Exit Sub
    End If
    nPicWidth = .ScaleX(nPicture.Width, vbHimetric)
    nPicHeight = .ScaleY(nPicture.Height, vbHimetric)
    nLeft = .ScaleLeft
    If IsMissing(X) Then
      X = nLeft
    End If
    nY = .ScaleTop
    If IsMissing(Y) Then
      Y = nY
    End If
    Select Case Width
      Case 0
        nWidth = nLeft + .ScaleWidth
      Case Is < 0
        nWidth = nLeft + .ScaleWidth + nPicWidth
        X = nWidth
      Case Is > 0
        nWidth = X + Width
    End Select
    Select Case Height
      Case 0
        nHeight = nY + .ScaleHeight
      Case Is < 0
        nHeight = nY + .ScaleHeight + nPicHeight
        Y = nHeight
      Case Is > 0
        nHeight = Y + Height
    End Select
    Do
      nX = nLeft
      Do
        If (nX + nPicWidth >= X) Or (nY + nPicHeight >= Y) Then
          .PaintPicture nPicture, nX, nY, nPicWidth, nPicHeight
        End If
        nX = nX + nPicWidth
      Loop Until nX > nWidth
      nY = nY + nPicHeight
    Loop Until nY > nHeight
  End With
End Sub

Die oben beschriebene Steuerung der Kachelung bei Größenänderungen erfolgt über die Paint- und Resize-Ereignisse der Objekte - beispielsweise bei einem Form:

Private mResizePaint As Boolean
Private mLastScaleWidth As Single
Private mLastScaleHeight As Single

Private Enum TileResizeConstants
  trNone
  trWidth
  trHeight
  trBoth
End Enum

Private Sub Form_Paint()
  Select Case mResizePaint
    Case trNone
      TilePicture Me
    Case trWidth
      TilePicture Me, , mLastScaleWidth, , , -1
    Case trHeight
      TilePicture Me, , , mLastScaleHeight, -1
    Case trBoth
      TilePicture Me, , mLastScaleWidth, mLastScaleHeight
  End Select
  With Me
    mLastScaleWidth = .ScaleWidth
    mLastScaleHeight = .ScaleHeight
  End With
  mResizePaint = trNone
End Sub

Public Sub Resize()
  mResizePaint = trNone
  With Me
    If .WindowState <> vbMinimized Then
      If .ScaleWidth > mLastScaleWidth Then
        mResizePaint = trWidth
      End If
      If .ScaleHeight > mLastScaleHeight Then
        mResizePaint = mResizePaint Or trHeight
      End If
    End If
  End With
End Sub

Damit Sie bei mehreren Flächen-Objekten in einem Modul die Verwaltung der letzten Abmessungen (mLastScaleWidth/Height) und der Änderungsangabe (mResizePaint) mit den Ereignissen Paint und Resize nicht jeweils separat anlegen müssen, können Sie alles zusammen in eine Klasse (clsTilePicture) packen.

Das Flächen-Objekt und das Bild können Sie in einem einzigen Aufruf der Init-Methode übergeben. Sie können aber auch beides separat über die Eigenschaften Object und Picture setzen. Auch hier wird bei fehlender Angabe eines Bildes versicht, dieses der Picture-Eigenschaft des Objekts zu entnehmen. Schließlich können Sie das Bild auch alternativ beim Aufruf der Paint-Methode übergeben, die Sie aus dem Paint-Ereignis des betreffenden Objekts heraus aufrufen müssen. Die Resize-Methode ist dementsprechend aus dem Resize-Ereignis des Objekts aufzurufen. Der Code der Klasse clsTilePicture:

Private Enum TileResizeConstants
  trNone
  trWidth
  trHeight
  trBoth
End Enum

Private mResizePaint As TileResizeConstants
Private mLastScaleWidth As Single
Private mLastScaleHeight As Single

Private pObject As Object
Private pPicture As StdPicture

Public Property Get Object() As Object
  Set Object = pObject
End Property

Public Property Let Object(New_Object As Object)
  zSetObject New_Object
End Property

Public Property Set Object(New_Object As Object)
  zSetObject New_Object
End Property

Private Sub zSetObject(New_Object As Object)
  Select Case True
    Case New_Object Is Nothing
    Case TypeOf New_Object Is MDIForm
      Err.Raise 380
    Case TypeOf New_Object Is Form
    Case TypeOf New_Object Is PictureBox
    Case TypeOf New_Object Is UserControl
    Case TypeOf New_Object Is UserDocument
    Case TypeOf New_Object Is PropertyPage
    Case Else
      Err.Raise 380
  End Select
  Set pObject = New_Object
End Sub

Public Property Get Picture() As StdPicture
  Set Picture = pPicture
End Property

Public Property Let Picture(New_Picture As StdPicture)
  zSetPicture New_Picture
End Property

Public Property Set Picture(New_Picture As StdPicture)
  zSetPicture New_Picture
End Property

Private Sub zSetPicture(New_Picture As StdPicture)
  Set pPicture = New_Picture
End Sub

Public Sub Init(Optional Object As Object, _
 Optional Picture As StdPicture)

  Set Me.Object = Object
  Set pPicture = Picture
End Sub

Public Sub Paint(Optional Picture As StdPicture)
  Dim nPicture As StdPicture
  
  If Not (pObject Is Nothing) Then
    If Picture Is Nothing Then
      Set nPicture = pPicture
    End If
    With pObject
      If nPicture Is Nothing Then
        On Error Resume Next
        Set nPicture = .Picture
        On Error GoTo 0
      End If
      If nPicture Is Nothing Then
        .Cls
      Else
        Select Case mResizePaint
          Case trNone
            mTilePicture pObject, nPicture
          Case trWidth
            mTilePicture pObject, nPicture, mLastScaleWidth, , , -1
          Case trHeight
            mTilePicture pObject, nPicture, , mLastScaleHeight, -1
          Case trBoth
            mTilePicture pObject, nPicture, mLastScaleWidth, _
             mLastScaleHeight
        End Select
      End If
      mLastScaleWidth = .ScaleWidth
      mLastScaleHeight = .ScaleHeight
    End With
  End If
  mResizePaint = trNone
End Sub

Public Sub Resize()
  mResizePaint = trNone
  If Not (pObject Is Nothing) Then
    With pObject
      If TypeOf pObject Is Form Then
        If .WindowState = vbMinimized Then
          Exit Sub
        End If
      End If
      If .ScaleWidth > mLastScaleWidth Then
        mResizePaint = trWidth
      End If
      If .ScaleHeight > mLastScaleHeight Then
        mResizePaint = mResizePaint Or trHeight
      End If
    End With
  End If
End Sub

Private Sub mTilePicture(Obj As Object, _
 Optional Picture As StdPicture, _
 Optional ByVal X As Variant, _
 Optional ByVal Y As Variant, _
 Optional ByVal Width As Single, _
 Optional ByVal Height As Single)

  Dim nWidth As Single
  Dim nHeight As Single
  Dim nPicWidth As Single
  Dim nPicHeight As Single
  Dim nX As Single
  Dim nY As Single
  Dim nLeft As Single
  Dim nPicture As StdPicture
  
  With Obj
    If Picture Is Nothing Then
      On Error Resume Next
      Set nPicture = .Picture
      On Error GoTo 0
    Else
      Set nPicture = Picture
    End If
    If nPicture Is Nothing Then
      .Cls
      Exit Sub
    End If
    nPicWidth = .ScaleX(nPicture.Width, vbHimetric)
    nPicHeight = .ScaleY(nPicture.Height, vbHimetric)
    nLeft = .ScaleLeft
    If IsMissing(X) Then
      X = nLeft
    End If
    nY = .ScaleTop
    If IsMissing(Y) Then
      Y = nY
    End If
    Select Case Width
      Case 0
        nWidth = nLeft + .ScaleWidth
      Case Is < 0
        nWidth = nLeft + .ScaleWidth + nPicWidth
        X = nWidth
      Case Is > 0
        nWidth = X + Width
    End Select
    Select Case Height
      Case 0
        nHeight = nY + .ScaleHeight
      Case Is < 0
        nHeight = nY + .ScaleHeight + nPicHeight
        Y = nHeight
      Case Is > 0
        nHeight = Y + Height
    End Select
    Do
      nX = nLeft
      Do
        If (nX + nPicWidth >= X) Or (nY + nPicHeight >= Y) Then
          .PaintPicture nPicture, nX, nY, nPicWidth, nPicHeight
        End If
        nX = nX + nPicWidth
      Loop Until nX > nWidth
      nY = nY + nPicHeight
    Loop Until nY > nHeight
  End With
End Sub

Modul, Klasse und Beispiel-Projekt (tilepicture.zip - ca. 7,3 KB)


Artikel
Zum Download-Bereich dieses Artikel
Mail an den Autor dieses Artikels

KnowHow
Zur KnowHow-Übersicht

KnowHow-Themen
Themen - Allgemeines
Themen - Entwicklungsumgebung (VB-IDE)
Themen - Forms
Themen - Steuerelemente (Controls)
Themen - Grafik
Themen - Dateien
Themen - UserControls
Themen - Einsteiger-Tipps
Themen - Wussten Sie...?

Übersicht nach Titeln in alphabetischer Reihenfolge
Übersicht nach Erscheinungsdatum

Schnellsuche




Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer