Newsgroup: it.comp.lang.visual-basic
Titolo: Immagini in background su di una MDI

Ciao.
Sfruttando un codice che dipingeva di un colore diverso
la client area di una MDIForm ne ho fatto un'altro
che fa il tiling di una picture. E funziona egregiamente,
con un difetto pero'. Se nella form ci metto una toolbar,
non si traccia piu' l'immagine.
Sono andato a vedere cosa c'era che non andava ed ho
scoperto che la toolbar viene trattata come una child
window e quando la funzione GetWindow cerca la client
area (perche' e' una child window) non la trova piu'
(perche' trova quella della toolbar). Con chiamate
successive di GetNextWindow comunque non la trovo
e se trovo qualcosa ha dimensione zero per zero.
QUalcuno puoi aiutarmi?
CiaO!
--
 |\-/|                    Con Affetto e Rispetto,
 \\ //                        Andrea De Togni
  | |                          ICQ#28636782
   -
FantaCalcio? FC Manager: 
http://www.fantacalcio.it/fantamanager

 wrote in message
38528...@news.dada.it...

  -----------== Posted via Newsfeeds.Com, Uncensored Usenet News ==----------
 
http://www.newsfeeds.com
       The Largest Usenet Servers in the World!
------== Over 73,000 Newsgroups - Including  Dedicated  Binaries Servers ==-----

> Mi puoi dare questo codice?
Eccolo:
La prima parte e' la dichiarazione delle
API necessarie: io raccolgo le dichiarazioni
in un solo modulo, quindi qui ci sono quelle
che servono e quelle che servono in altri punti,
vedi tu di spulciarle.
La funzione mdiPaintBackground funziona in base
alla variabile IsBitmap: se e' false allora
traccia lo sfondo di colore diverso, se e' true
invece fa il tiling della bitmap che carica
dal file RES.DLL come risorsa "FCMEMBOSS".
Se ti serve il file DLL te lo posso anche mandare:
in alternativa puoi lavorare sul codice per ottenere
l'handle del bitmap partendo dall'hDC di una PictureBox.
Non so esattamente come si faccia ma *credo* che
la proprieta' Picture e' proprio hBitmap.
Prima o poi servira' anche a me e se ci arrivi da
solo poi me lo fai sapere?
Unico inconveniente che non sono riuscito a risolvere:
se piazzi una toolbar non si traccia piu' il bitmap.
Se usi invece le toolbar commerciali invece funziona.
Se metti una picturebox e dentro ci metti la toolbar
funziona, ma a quel punto la gestione automatica della
dimensione della toolbar salta.
Option Explicit
Public Type Rectangle
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd
As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC
As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal
hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal
hwnd As Long, ByVal wFlag As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As
Long
Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal
nWidth As Long, ByVal crColor As Long) As Long
Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal
hInstance As Long, ByVal lpBitmapName As String) As Long
Declare Function IsChild Lib "user32" (ByVal hWndParent As Long, ByVal
hwnd As Long) As Long
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
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 LoadModule Lib "kernel32" (ByVal lpModuleName As
String, lpParameterBlock As Any) As Long
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal
lpLibFileName As String) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As
Long
Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject
As Long, ByVal nCount As Long, lpObject As Any) As Long
Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long)
As Long
Declare Function GetPrivateProfileInt Lib "kernel32" Alias
"GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal
lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String)
As Long
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect
As Rectangle) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect
As Rectangle) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal
bRevert As Long) As Long
Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal
nPosition As Long, ByVal wFlags As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As
Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As
Long
'Input:
'   hParent    - handle to parent MDI window
'   lColor     - RGB color to paint MDI window background
'   nPenStyle  - pen style to paint with (Solid, Dashed, etc...)
'
'Output:
'   none
'
'
Sub mdiPaintBackground(ByVal IsBitmap As Boolean, ByVal hParent As Long,
ByVal lColor As Long, ByVal nPenStyle As Long)
Dim hClient As Long      'handle to child Window
Dim hClientDC As Long    'handle to child Device Context
'GDI objects
Dim hNewBrush As Long   'handle to new brush
Dim hOldBrush As Long    'handle to old brush
Dim hNewPen As Long      'handle to new pen
Dim hOldPen As Long      'handle to old pen
Dim memdc As Long
'Temporary variables
Dim nReturn As Long      'return value
Dim nRectangle As Rectangle 'rectangle structure
Dim hBitmap As Long
Dim hModule As Long
Dim bitinfo As BITMAP
Dim i As Long
Dim j As Long
Dim LastE As Long
If IsBitmap = False Then
    'Traccia un colore
    lColor = RGB(120, 1, 1)
    'Retrieve the handle to the MDI background client area, the first
'child window
    hClient = GetWindow(hParent, GW_CHILD)
    'Retrieve the handle to Device Context area of child window from
'the Windows cache
    hClientDC = GetDC(hClient)
    'Create a solid color brush; return handle
    hNewBrush = CreateSolidBrush(lColor)
    'Select the handle to the current brush in the Device Context
    'Hold the existing brush and replace with the new brush for
'painting
    hOldBrush = SelectObject(hClientDC, hNewBrush)
    'Create a pen with specified style, width, and color; return 'handle
    hNewPen = CreatePen(nPenStyle, 1, lColor)
    'Select the handle to the current pen in the Device Context
    'Hold the existing pen and replace it with the new pen for 'painting
    hOldPen = SelectObject(hClientDC, hNewPen)
    'Retrieve the rectangle size that describes the client area of the
'window
    nReturn = GetClientRect(hClient, nRectangle)
    'Draw a rectangle with the new pen and fill it with the new brush
    nReturn = Rectangle(hClientDC, nRectangle.Left, nRectangle.Top,
nRectangle.Right, nRectangle.Bottom)
    'Replace new brush with old brush
    nReturn = SelectObject(hClientDC, hOldBrush)
    'Delete brush
    nReturn = DeleteObject(hNewBrush)
    'Replace new pen with old pen
    nReturn = SelectObject(hClientDC, hOldPen)
    'Delete pen
    nReturn = DeleteObject(hNewPen)
    'Release the Device Context handle to the Windows cache
    nReturn = ReleaseDC(hClient, hClientDC)
Else
    'load library
    hModule = LoadLibrary("res.dll")
    'load bitmap
    hBitmap = LoadBitmap(hModule, "FCMEMBOSS")
    'ottieni l'handle della client area
    hClient = GetWindow(hParent, GW_CHILD)
    'ottieni il dc della client area
    hClientDC = GetDC(hClient)
    'get dc image
    memdc = CreateCompatibleDC(hClientDC)
    'select object
    nReturn = SelectObject(memdc, hBitmap)
    'Fare tanti bitblt in modo che riempia lo sfondo:
    'Determinare la dimensione del bitmap
    nReturn = GetObject(hBitmap, 24, bitinfo)
    '-> bitinfo.bmWidth
    'Determinare la dimensione orizzontale e verticale del DC
    nReturn = GetClientRect(hClient, nRectangle)
    '->nRectangle.Left,Right,Top,Bottom
    j = 0
    While j < nRectangle.Bottom
        i = 0
        While i < nRectangle.Right
            nReturn = BitBlt(hClientDC, i, j, bitinfo.bmWidth,
bitinfo.bmHeight, memdc, 0, 0, SRCCOPY)
            i = i + bitinfo.bmWidth
        Wend
        j = j + bitinfo.bmHeight
    Wend
    'cancella il dc dell'immagine originale
    nReturn = DeleteDC(memdc)
    'rilascia il dc della client area.
    nReturn = ReleaseDC(hClient, hClientDC)
    'SCARICA LA LIBRARY
    nReturn = FreeLibrary(hModule)
End If
End Sub