Von |
Neptun |
Am |
27. April 2011 um 22:24:26 |
Antwort |
Hallo NW90, probier' mal dieses: Dim Breite As Long, Hoehe As Long Dim MaskCol As Long Dim OldColor As Long Dim Tmphdc As Long Dim OldHandle As Long Dim bmpMono As Long Dim Punkt(2) As PointAPI picQuelle.ScaleMode = vbPixels picQuelle.AutoRedraw = True Breite = picQuelle.ScaleWidth Hoehe = picQuelle.ScaleHeight MaskCol = RGB(255, 255, 255) ' <- Maskenfarbe hier einsetzen ' DC erstellen Tmphdc = CreateCompatibleDC(0) ' Monochrombitmap erstellen bmpMono = CreateBitmap(Breite, Hoehe, 1, 1, ByVal 0&) ' Monochrombitmap selektieren OldHandle = SelectObject(Tmphdc, bmpMono) ' Maskenfarbe setzen OldColor = SetBkColor(picQuelle.hDC, MaskCol) ' Maskenbild erstellen Call BitBlt(Tmphdc, 0, 0, Breite, Hoehe, picQuelle.hDC, 0, 0, vbSrcCopy) ' Maske invertieren (bei Bedarf) Call BitBlt(Tmphdc, 0, 0, Breite, Hoehe, 0, 0, 0, vbDstInvert) ' alte Backcolor zurück Call SetBkColor(picQuelle.hDC, OldColor) ' alter Handle zurück Call SelectObject(Tmphdc, OldHandle) ' DC löschen Call DeleteDC(Tmphdc) ' Grafik ausgeben Call PlgBlt(picZiel.hDC, Punkt(0), picQuelle.hDC, _ 0, 0, Breite, Hoehe, bmpMono, 0, 0) ' Maskenbild löschen Call DeleteObject(bmpMono) picZiel.Refresh ' Auffrischen erzwingen Du kannst auch das Monochrombild mit einem Zeichenprogramm in 1 Bit Farbtiefe speichern. Dann kommst du mit weniger Api-Funktionen aus. Siehe dazu:
[url=" http://www.activevb.de/cgi-bin/upload/download.pl?id=2533"][/url] Gruss,
Neptun |
|