Attribute VB_Name = "Module1"
Type POINTAPI
        X As Long
        Y As Long
End Type

Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData&)
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
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
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Any) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
Public Const SRCINVERT = &H660046  ' (DWORD) dest = source Invert dest

Public Function degtorad(ang)
   degtorad = ang * 0.0174 ' =  (ang / 180) * 3.14159265359
End Function

Public Sub DirectLoadPicture(filename As String, DC As Long, bmp As Long, w, h As Integer, frm1 As Form)

Dim olderBMP As Long
Dim pic As StdPicture
Dim TDC As Long
Dim w1, h1 As Long
Dim hdcCompatible As Long
Dim hbmScreen As Long
 
If filename <> "" Then
 'If Filename is given, load the picture,create a DC and blits it
 Set pic = LoadPicture(filename)
 TDC = CreateCompatibleDC(frm1.hDC)
 OldBMP = SelectObject(TDC, pic.Handle)
 w = frm1.ScaleX(pic.Width, vbHimetric, vbPixels)
 h = frm1.ScaleX(pic.Height, vbHimetric, vbPixels)
 w1 = w
 h1 = h
 hdcCompatible = CreateCompatibleDC(frm1.hDC)                   'Create the DC
 hbmScreen = CreateCompatibleBitmap(frm1.hDC, w1, h1)  'Temporary bitmap
 If SelectObject(hdcCompatible, hbmScreen) = vbNull Then         'If the function fails
   DC = vbNull                                              ' return null
 Else                                                            'If it succeeds
   DC = hdcCompatible                                       ' return the DC
 End If
 olderBMP = SelectObject(DC, bmp)
 BitBlt DC, 0, 0, w, h, TDC, 0, 0, SRCCOPY
 olderBMP = SelectObject(DC, olderBMP)
 OldBMP = SelectObject(TDC, OldBMP)
 ret% = DeleteDC(TDC)
 Set pic = Nothing 'Release temporary pictures
Else
 'If no Filename is given, create empty DC with width W and height h
 hdcCompatible = CreateCompatibleDC(frm1.hDC)                   'Create the DC
 hbmScreen = CreateCompatibleBitmap(frm1.hDC, w, h)   'Temporary bitmap
 If SelectObject(hdcCompatible, hbmScreen) = vbNull Then         'If the function fails
    DC = vbNull                                              ' return null
 Else                                                            'If it succeeds
    DC = hdcCompatible                                       ' return the DC
 End If
End If
End Sub

