Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Background
Message
From
17/05/2001 15:53:07
 
 
To
14/05/2001 12:13:38
General information
Forum:
Visual Basic
Category:
Pictures and Image processing in VB
Title:
Miscellaneous
Thread ID:
00506882
Message ID:
00508494
Views:
22
>Hello Guys
>
>Does anyone out there know of a way to put a tiled background on an MDI form??
>
>Thank YOu
>
>Gary

I didn't write this so you will have to experiment with this code a little:
sWnd = ?Source hwnd?
sDC = ?Source DC?
dWnd = MDIForm.hwnd
Maybe someone else might have a better idea.
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
~Joe Johnston USA

"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

Previous
Reply
Map
View

Click here to load this message in the networking platform