Deklaration: Declare Function CreateBitmap Lib "gdi32" ( _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal nPlanes As Long, _ ByVal nBitCount As Long, _ lpBits As Any) As Long Beschreibung: Parameter:
Rückgabewert: Beispiel: Private Declare Function CreateCompatibleDC Lib "gdi32" ( _ ByVal hdc As Long) As Long Private Declare Function CreateBitmap Lib "gdi32" ( _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal nPlanes As Long, _ ByVal nBitCount As Long, _ lpBits As Any) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As Long Private Declare Function SetMapMode Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal nMapMode As Long) As Long Private Declare Function GetMapMode Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" ( _ ByVal hDestDC 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 dwRop As Long) As Long Private Declare Function SetBkColor Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal crColor As Long) As Long Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long) As Long ' BitBlt dwRop-Konstantem Private Const SRCCOPY = &HCC0020 Private Const NOTSRCCOPY = &H330008 Private Const SRCAND = &H8800C6 Private Const SRCPAINT = &HEE0086 ' Transparente Farbe wählen Private Sub Command2_Click() On Error GoTo Err_Dlg With Common1 .CancelError = True .ShowColor SetBkColor Picture3.hdc, .Color End With End Sub ' Transparente Farbe anhand der Koordinate ermitteln Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As _ Single, Y As Single) Picture3.BackColor = Picture1.Point(X, Y) End Sub ' Startet das Kopieren der Maske oder des Bitmaps mit einer transparenten Farbe Private Sub Command1_Click() DrawTransparent Picture1, Picture2, GetBkColor(Picture3.hdc), Option1.Value End Sub ' Transparente Bitmaps kopieren (CopyBitmap = False um nur die Maske zu kopieren) Private Function DrawTransparent(ByVal Src As PictureBox, ByVal Dest As _ PictureBox, ByVal TransColor As Long, ByVal CopyBitmap As Boolean) Dim hdcBack As Long, hdcObject As Long, hdcMem As Long, hdcSave As Long Dim bmAndBack As Long, bmAndObject As Long, bmAndMem As Long, bmSave _ As Long Dim bmBackOld As Long, bmObjectOld As Long, bmMemOld As Long, _ bmSaveOld As Long Dim OldColor As Long ' Zeilbitmap löschen Dest.Cls ' Einige Temporäre Devicekontexte erstellen hdcBack = CreateCompatibleDC(Dest.hdc) hdcObject = CreateCompatibleDC(Dest.hdc) hdcMem = CreateCompatibleDC(Dest.hdc) hdcSave = CreateCompatibleDC(Dest.hdc) ' 2 Schwarzweißbitmaps erstellen bmAndBack = CreateBitmap(Dest.ScaleWidth, Dest.ScaleHeight, 1, 1, _ ByVal 0&) bmAndObject = CreateBitmap(Dest.ScaleWidth, Dest.ScaleHeight, 1, 1, _ ByVal 0&) ' 2 Normale Bitmaps erstellen bmAndMem = CreateCompatibleBitmap(Src.hdc, Dest.ScaleWidth, Dest.ScaleHeight) bmSave = CreateCompatibleBitmap(Src.hdc, Dest.ScaleWidth, Dest.ScaleHeight) ' Die Bitmap den Devices zuweisen SelectObject hdcBack, bmAndBack SelectObject hdcObject, bmAndObject SelectObject hdcMem, bmAndMem SelectObject hdcSave, bmSave ' Mapmode des Ziels einstellen SetMapMode Src.hdc, GetMapMode(Dest.hdc) ' Sicherheitskopie des Originals anlegen BitBlt hdcSave, 0, 0, Src.ScaleWidth, Src.ScaleHeight, Src.hdc, 0, 0, SRCCOPY ' Hintergrund des Originalbitmaps mit der Transparenten Farbe füllen OldColor = SetBkColor(Src.hdc, TransColor) ' Schwarzweißkopie (Objektmaske) des Bitmaps erstellen BitBlt hdcObject, 0, 0, Src.ScaleWidth, Src.ScaleHeight, Src.hdc, 0, _ 0, SRCCOPY ' Original Hintergrundfarbe wiederherstellen SetBkColor Src.hdc, OldColor ' Schwarzweißkopie (Objektmaske) invertieren BitBlt hdcBack, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcObject, 0, _ 0, NOTSRCCOPY If CopyBitmap = False Then ' nur die Maske kopieren ' Hintergrund des Quellbildes kopieren BitBlt hdcMem, 0, 0, Src.ScaleWidth, Src.ScaleHeight, Src.hdc, 0, _ 0, SRCCOPY ' Maskieren des Bereiches, in dem das Bitmap platziert werden soll BitBlt hdcMem, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcObject, _ 0, 0, SRCAND ' Maskieren der transparenten Farbe des Ziels BitBlt Dest.hdc, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcBack, _ 0, 0, SRCAND ' XOR Operation mit dem Hintergrund des Ziels durchführen BitBlt hdcMem, 0, 0, Src.ScaleWidth, Src.ScaleHeight, Dest.hdc, _ 0, 0, SRCPAINT Else ' Bitmap Kopieren ' Hintergrund des Ziels kopieren BitBlt hdcMem, 0, 0, Dest.ScaleWidth, Dest.ScaleHeight, Dest.hdc, _ 0, 0, SRCCOPY ' Maskieren des Bereiches, in dem das Bitmap platziert werden soll BitBlt hdcMem, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcObject, _ 0, 0, SRCAND ' Maskieren der transparenten Farbe BitBlt Src.hdc, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcBack, _ 0, 0, SRCAND ' XOR Operation mit dem Hintergrund der Quelle durchführen BitBlt hdcMem, 0, 0, Src.ScaleWidth, Src.ScaleHeight, Src.hdc, 0, _ 0, SRCPAINT End If ' Kopieren des Bitmaps in das Ziel BitBlt Dest.hdc, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcMem, 0, 0, SRCCOPY ' Sicherheitskopie des Originals wiederherstellen BitBlt Src.hdc, 0, 0, Src.ScaleWidth, Src.ScaleHeight, hdcSave, 0, 0, SRCCOPY ' Temporäre Bitmaps zerstören DeleteObject SelectObject(hdcBack, bmBackOld) DeleteObject SelectObject(hdcObject, bmObjectOld) DeleteObject SelectObject(hdcMem, bmMemOld) DeleteObject SelectObject(hdcSave, bmSaveOld) ' Erstellte Devices zerstören DeleteDC hdcMem DeleteDC hdcBack DeleteDC hdcObject DeleteDC hdcSave DeleteDC hdcTemp End Function Diese Seite wurde bereits 13.392 mal aufgerufen. |
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. Buchempfehlung Tipp des Monats Januar 2025 Dieter Otter Zeilen einer MultiLine-TextBox ermitteln (VB.NET) Dieser Zipp zeigt, wie man die Zeilen einer MultiLine-TextBox exakt so ermitteln kann, wie diese auch in der TextBox dargestellt werden. sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||||||
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. |