|
|
|
|
|
Wie kommen Sie eigentlich zu einem echten Duplikat eines  Picture-Objekts?
Wenn Sie lediglich eine neue Objekt-Variable des Type (Std)Picture
deklarieren und dieser ein vorhandenes, etwa in einer anderen
Variablen steckendes Picture-Objekt zuweisen, verweisen
anschließend beide Variablen auf ein und dasselbe Bild.
In "reinem" Visual Basic können Sie ein unabhängiges
Duplikat mit Hilfe einer PictureBox erzeugen, deren Eigenschaften AutoSize
und AutoRedraw
auf True gesetzt sind. Sie weisen das vorhandene Picture-Objekt der Picture-Eigenschaft
der PictureBox (deren Größe daraufhin automatisch angepasst wird)
zu und können dann aus der Image-Eigenschaft
ein neues Picture-Objekt als unabhängige Kopie auslesen:
Set PictureBox.Picture = MeinPicture
Set DeinPicture = PictureBox.Image
Statt das Original der Picture-Eigenschaft der PictureBox
zuzuweisen, können Sie es auch mit der Methode PaintPicture
auf die PictureBox malen, sogar vergrößert oder verkleinert.
Allerdings muss dann die AutoResize-Eigenschaft auf False gesetzt
bleiben, und Sie müssen die Größe der PictureBox manuell
festlegen.
Dieses im Prinzip einfache Verfahren hat jedoch den Nachteil,
dass Sie dazu eben eine PictureBox brauchen, und dazu noch das Form,
auf dem die PictureBox platziert sein muss. Um eine Bildkopie so zu
sagen "freischwebend", im "luftleeren Raum" zu
produzieren, müssen Sie auf API-Techniken zurückgreifen.
Das Prinzip ist relativ einfach. Sie erzeugen mit der
API-Funktion CreateCompatibleDC
zwei so genannte Geräte-Kontexte,
die nur im Speicher existieren und keinem sichtbaren
Oberflächen-Element zugeordnet sind. Dem einen Geräte-Kontext
ordnen Sie das Handle der Bitmap des vorhandenen Picture-Objekts zu
(SelectObject).
Dann malen Sie das Bild entweder mit der Funktion BitBlt
oder skaliert mit der Funktion StretchBlt
in den zweiten Geräte-Kontext. Damit aber die Malerei stattfinden
kann, müssen Sie zuvor ein leeres Bitmap in der gewünschten
Zielgröße erzeugen (CreateCompatibleBitmap)
und dieses zuvor dem zweiten Geräte-Kontext zuordnen. Aus der neu
bemalten Bitmap können Sie nun wieder ein neues Picture-Objekt
erzeugen (siehe  "Vom
Handle zum Picture").
Die hier vorgestellte Hilfs-Funktion CopyPicture verpackt das
Ganze und ermöglicht sowohl eine Skalierung auf eine vorgegebene
Breite und Höhe, eine prozentuale Skalierung, und sogar eine
vertikale oder horizontale Spiegelung.
Zunächst einmal die notwendigen API-Deklarationen:
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) _
As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" _
Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, _
lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" _
(ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Die Konstanten der Enumeration CopyPictureModeConstants legen
fest, ob das originale Picture-Objekt zurückgegeben wird (cpNone),
oder ob ein neues Picture-Objekt das Original in eine oder beide
Richtungen gespiegelt und gegebenenfalls enthält, oder ob es ein
gegebenenfalls skaliertes ungespiegeltes Duplikat enthält (cpDuplicate).
Public Enum CopyPictureModeConstants
cpNone
cpVertical
cpHorizontal
cpBoth
cpDuplicate
End Enum
Die Konstanten der Enumeration CopyPictureStretchModeConstants
legen fest, nach welchen Regeln die Pixel beim Verkleinern reduziert
werden (SetStretchBltMode).
Public Enum CopyPictureStretchModeConstants
cspDefault
cspBlackOnWhite = 1
cspWhiteOnBlack = 2
cspColorOnColor = 3
cspHalftone = 4
End Enum
Der Funktion CopyPicture übergeben Sie das originale
Picture-Objekt und optional einen Wert aus der Enumeration
CopyPictureModeConstants (Voreinstellung ist cpDuplicate). Nun
können Sie wählen, ob Sie eine Breite und/oder eine
Höhe angeben oder alternativ eine Prozentangabe setzen. Setzen Sie
weder noch, bleibt das Duplikat unskaliert. Im letzten optionalen
Parameter StretchMode legen Sie die Methode der Pixel-Reduktion fest
(Voreinstellung ist cspDefault).
Public Function CopyPicture(Picture As StdPicture, _
Optional ByVal CopyPictureMode As CopyPictureModeConstants _
= cpDuplicate, Optional ByVal Width As Long, _
Optional ByVal Height As Long, _
Optional ByVal Percent As Single = 100, _
Optional ByVal StretchMode As CopyPictureStretchModeConstants) _
As StdPicture
Dim nDCOrigin As Long
Dim nDC1 As Long
Dim nDC2 As Long
Dim nObjOrigin As Long
Dim nObj1 As Long
Dim nObj2 As Long
Dim nBitmap As BITMAP
Dim nBmp1 As Long
Dim nBmp2 As Long
Dim nWidth As Long
Dim nHeight As Long
nDCOrigin = CreateCompatibleDC(0)
nObjOrigin = SelectObject(nDCOrigin, Picture.Handle)
GetObjectAPI Picture.Handle, Len(nBitmap), nBitmap
With nBitmap
If Percent > 0 Then
nWidth = .bmWidth * Percent / 100
nHeight = .bmHeight * Percent / 100
Else
If Width > 0 Then
nWidth = Width
Else
nWidth = .bmWidth
End If
If Height > 0 Then
nHeight = Height
Else
nHeight = .bmHeight
End If
End If
Select Case CopyPictureMode
Case cpNone
Set CopyPicture = Picture
Exit Function
Case cpVertical
nBmp1 = CreateCompatibleBitmap(nDCOrigin, nWidth, nHeight)
nDC1 = CreateCompatibleDC(0)
nObj1 = SelectObject(nDC1, nBmp1)
Select Case StretchMode
Case cspBlackOnWhite To cspHalftone
SetStretchBltMode nDC1, StretchMode
End Select
StretchBlt nDC1, 0, nHeight - 1, nWidth, -nHeight, nDCOrigin, _
0, 0, .bmWidth, .bmHeight, SRCCOPY
Case cpHorizontal
nBmp1 = CreateCompatibleBitmap(nDCOrigin, nWidth, nHeight)
nDC1 = CreateCompatibleDC(0)
nObj1 = SelectObject(nDC1, nBmp1)
Select Case StretchMode
Case cspBlackOnWhite To cspHalftone
SetStretchBltMode nDC1, StretchMode
End Select
StretchBlt nDC1, nWidth - 1, 0, -nWidth, nHeight, nDCOrigin, _
0, 0, .bmWidth, .bmHeight, SRCCOPY
Case cpBoth
nBmp2 = CreateCompatibleBitmap(nDCOrigin, .bmWidth, .bmHeight)
nDC2 = CreateCompatibleDC(0)
nObj2 = SelectObject(nDC2, nBmp2)
StretchBlt nDC2, 0, .bmHeight - 1, .bmWidth, -.bmHeight, _
nDCOrigin, 0, 0, .bmWidth, .bmHeight, SRCCOPY
nBmp1 = CreateCompatibleBitmap(nDCOrigin, nWidth, nHeight)
nDC1 = CreateCompatibleDC(0)
nObj1 = SelectObject(nDC1, nBmp1)
Select Case StretchMode
Case cspBlackOnWhite To cspHalftone
SetStretchBltMode nDC1, StretchMode
End Select
StretchBlt nDC1, nWidth - 1, 0, -nWidth, nHeight, nDC2, _
0, 0, .bmWidth, .bmHeight, SRCCOPY
Case cpDuplicate
nBmp1 = CreateCompatibleBitmap(nDCOrigin, nWidth, nHeight)
nDC1 = CreateCompatibleDC(0)
nObj1 = SelectObject(nDC1, nBmp1)
Select Case StretchMode
Case cspBlackOnWhite To cspHalftone
SetStretchBltMode nDC1, StretchMode
End Select
StretchBlt nDC1, 0, 0, nWidth, nHeight, nDCOrigin, _
0, 0, .bmWidth, .bmHeight, SRCCOPY
End Select
End With
Set CopyPicture = PictureFromHandle(nBmp1, vbPicTypeBitmap, True)
SelectObject nDC1, nObj1
DeleteDC nDC1
If nDC2 Then
SelectObject nDC2, nObj2
DeleteDC nDC2
End If
SelectObject nDCOrigin, nObjOrigin
DeleteDC nDCOrigin
End Function
|
|
|