Option Explicit Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type POINTAPI X As Long Y As Long End Type Public Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type Public Type LOGPEN lopnStyle As Long lopnWidth As POINTAPI lopnColor As Long End Type Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Sub InflateRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) Public 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 Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Public Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long Public Declare Function FillRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long ' Windows messages watched for by MsgHook Public Const WM_ERASEBKGND = &H14 Public Const WM_PAINT = &HF Public Const WM_QUERYDRAGICON = &H37 Public Const WM_WINDOWPOSCHANGED = &H47 ' Constant used with GetWindow() to obtain handle ' to MDIForm's client space Public Const GW_CHILD = 5 ' Raster-op for Blt's Public Const SRCCOPY = &HCC0020 ' Pen Style constant Public Const PS_SOLID = 0 Public Sub mdiBitBltTiled(sWnd As Long, sDC As Long, dWnd As Long) Dim nRet As Long Dim cDC As Long Dim cWnd As Long Dim dX As Long Dim dY As Long Dim Rows As Integer Dim Cols As Integer Dim i As Integer Dim j As Integer Dim sR As RECT Dim dR As RECT ' Get DC to client space (assumes we're Blt'ing onto an MDI client space) cWnd = GetWindow(dWnd, GW_CHILD) cDC = GetDC(cWnd) ' Get source and destination rectangles Call GetClientRect(sWnd, sR) Call GetClientRect(cWnd, dR) ' Calc parameters Rows = dR.Right \ sR.Right Cols = dR.Bottom \ sR.Bottom ' Spray out across destination For i = 0 To Rows dX = i * sR.Right For j = 0 To Cols dY = j * sR.Bottom nRet = BitBlt(cDC, dX, dY, sR.Right, sR.Bottom, sDC, 0, 0, SRCCOPY) Next j Next i ' house cleaning nRet = ReleaseDC(cWnd, cDC) End Sub
"If ye love wealth better than liberty, the tranquility of servitude better than the animated contest of freedom, go home from us in peace. We ask not your counsel or arms. Crouch down and lick the hands which feed you. May your chains set lightly upon you, and may posterity forget that ye were our countrymen."
~Samuel Adams