Option Explicit
 
Private Map1 As StdPicture, P1hdc&, P1OldPic&
 
' Benötigte API-Deklarationen
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As _
  Long
 
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal _
  hObject As Long) As Long
 
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As _
  Long, ByVal Y As Long) As Long
 
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 
 
Const ANDSCANS = 1
Const ORSCANS = 2
Const DELETESCANS = 3
Const HALFTONE = 4
 
 
 
 
 
Private Sub Form_Load()
  ' Laden
  Set Map1 = LoadPicture("C:\Programme\Microsoft Visual" & _
    "Studio\VB98\Progs\X_BMP_auslesen\Prog_2\300dpi_Versuch.bmp")
  P1hdc = CreateCompatibleDC(Me.hdc)
  P1OldPic = SelectObject(P1hdc, Map1.Handle)
  Picture1.ScaleMode = vbPixels
  Picture1.AutoRedraw = True
End Sub
Private Sub Command1_Click()
 
    Zeichne 1, 1, 100, 100, Map1.Handle, 1000, 100, 100
 
End Sub
 
Private Sub Zeichne(XZiel&, YZiel&, ZielBreite&, ZielHöhe&, XQuelle&, YQuelle&, _
  QuellBreite&, QuellHöhe&)
  ' Zeichnen
  Call SetStretchBltMode(Picture1.hdc, HALFTONE) ' COLORONCOLOR
  Call StretchBlt(Picture1.hdc, XZiel, YZiel, ZielBreite, ZielHöhe, P1hdc, _
    XQuelle, YQuelle, QuellBreite, QuellHöhe, vbSrcCopy)
  Picture1.Refresh
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  ' Speicher aufräumen
  If P1hdc <> 0 Then
    Call SelectObject(P1hdc, P1OldPic)
    Call DeleteDC(P1hdc)
    Set Map1 = Nothing
  End If
End Sub

Schon macht man es richtig funktioniert es !