Private Sub Form_Load()
Dim mem_dc As Long
Dim mem_bm As Long
Dim orig_bm As Long
Dim wid As Long
Dim hgt As Long
Dim old_font As Long
Dim new_font As Long
Dim old_bk_mode As Long
Picture1.ScaleMode = vbPixels
wid = Picture1.ScaleWidth
hgt = Picture1.ScaleHeight
' Create the device context.
mem_dc = CreateCompatibleDC(hdc)
' Create the bitmap.
mem_bm = CreateCompatibleBitmap(mem_dc, wid, hgt)
' Make the device context use the bitmap.
orig_bm = SelectObject(mem_dc, mem_bm)
' Give the device context a white background.
SelectObject mem_dc, GetStockObject(WHITE_BRUSH)
Rectangle mem_dc, 0, 0, wid, hgt
SelectObject mem_dc, GetStockObject(NULL_BRUSH)
' Draw the on the device context.
SelectObject mem_dc, GetStockObject(BLACK_PEN)
MoveToEx mem_dc, 0, 0, ByVal 0&
LineTo mem_dc, wid, hgt
MoveToEx mem_dc, 0, hgt, ByVal 0&
LineTo mem_dc, wid, 0
' Do not fill the background.
old_bk_mode = GetBkMode(mem_dc)
SetBkMode mem_dc, TRANSPARENT
' Give the DC a font.
new_font = CreateFont(40, 0, 0, 0, _
700, 0, 0, 0, ANSI_CHARSET, _
0, 0, 0, 0, "Times New Roman")
old_font = SelectObject(mem_dc, new_font)
' Draw some text.
TextOut mem_dc, 20, 20, "Hello", Len("Hello")
' Destroy the new font.
SelectObject mem_dc, old_font
DeleteObject new_font
' Restore the original background fill mode.
SetBkMode mem_dc, old_bk_mode
' Copy the device context into the PictureBox.
Picture1.AutoRedraw = True
BitBlt Picture1.hdc, 0, 0, wid, hgt, _
mem_dc, 0, 0, SRCCOPY
Picture1.Picture = Picture1.Image
' Delete the bitmap and dc.
SelectObject mem_dc, orig_bm
DeleteObject mem_bm
DeleteDC mem_dc
End Sub
|