Load Bitmap directly in a hdc

Hmm not sure if this is what you want, but this is a control a friend and I wrote ages ago (ok, about 1 1/2 year ago...) never looked at it again since I've never needed to be able to load a picture fast (but it *was* bloody fast to show bitmaps!). Anyway, figure out the declarations yourself, this is the code in the usercontrol.. hope you camn find in it what you need.. and else, just ignore :-)

option Explicit
private strFile as string, hFile as Long, hdcMemory as Long, hOrgBitmap as Long, blnFileLoaded as Boolean, tBitmap as BITMAP
'Default property Values:
Const m_def_Picture = ""
'property Variables:
Dim m_Picture as string
Event Click()
Event DoubleClick()
' ************************************************************************************
public Function OpenFile(optional File as string) as Boolean
on error GoTo ErrHandler
If File = "@" then Exit Function
If File <> "" And LCase(right(File, 4)) = ".bmp" then
strFile = File
If LoadFileIntoMemory then OpenFile = true
else
File = DialogOpen("Open bitmap...", CurDir, "Valid picture file|*.bmp", UserControl.hWnd)
If File <> "" And LCase(right(File, 4)) = ".bmp" then
strFile = File
If LoadFileIntoMemory then OpenFile = true
End If
End If
ErrHandler:
End Function
private Function LoadFileIntoMemory() as Boolean
hFile = LoadImage(App.hInstance, strFile, IMAGE_BITMAP, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixelY, LR_LOADFROMFILE Or LR_COLOR) ' Or LR_DEFAULTSIZE)
If hFile <> 0 then
If GetObjectAPI(hFile, len(tBitmap), tBitmap) then
If PlaceIntoDc then
If DrawPicture then
LoadFileIntoMemory = true
End If
End If
End If
End If
End Function
private Function PlaceIntoDc() as Boolean
If hdcMemory <> 0 then
SelectObject hOrgBitmap, hFile
DeleteDC (hdcMemory)
End If
hdcMemory = CreateCompatibleDC(UserControl.hdc)
If hdcMemory then hOrgBitmap = SelectObject(hdcMemory, hFile)
If hOrgBitmap then PlaceIntoDc = DeleteObject(hFile)
End Function
private Function DrawPicture() as Boolean
Dim Inset as Byte
Inset = 4
DrawPicture = BitBlt(UserControl.hdc, Inset, Inset, UserControl.Width / Screen.TwipsPerPixelX - (Inset * 2), UserControl.Height / Screen.TwipsPerPixelY - (Inset * 2), hdcMemory, 0, 0, SRCCOPY)
End Function
private Function ClearPicture() as Boolean
Dim Inset as Byte
SelectObject hdcMemory, hOrgBitmap
UserControl.Refresh
End Function

private Sub UserControl_Click()
RaiseEvent Click
End Sub

private Sub UserControl_DblClick()
RaiseEvent DoubleClick
End Sub

' ************************************************************************************ User Control
private Sub UserControl_Paint()
Repaint
End Sub
private Sub Repaint()
Dim uRect as RECT
With uRect
.left = 0
.top = 0
.right = UserControl.Width / Screen.TwipsPerPixelX
.bottom = UserControl.Height / Screen.TwipsPerPixelY
End With
DrawPicture
DrawEdge UserControl.hdc, uRect, BDR_RAISEDOUTER, BF_RECT
End Sub
private Sub UserControl_Resize()
If strFile = "" then strFile = "@"
OpenFile strFile
End Sub
private Sub UserControl_Terminate()
If hdcMemory then
SelectObject hdcMemory, hOrgBitmap
DeleteDC hdcMemory
End If
End Sub
public property get Picture() as Variant
Picture = m_Picture
End property
public property let Picture(byval New_Picture as Variant)
m_Picture = New_Picture
strFile = m_Picture
If New_Picture <> "" then
OpenFile strFile
else
ClearPicture
End If
PropertyChanged "Picture"
End property
'Load property values from storage
private Sub UserControl_ReadProperties(PropBag as PropertyBag)
m_Picture = PropBag.ReadProperty("Picture", strFile)
End Sub
'Write property values to storage
private Sub UserControl_WriteProperties(PropBag as PropertyBag)
Call PropBag.WriteProperty("Picture", m_Picture, strFile)
If m_Picture <> "" then OpenFile strFile
End Sub

(and yes it's not the most beautiful code, but hey, it *did* work :-)

Crazy D :-)
"One ring rules them all"