Newsgroup: it.comp.lang.vo-clipper
Titolo: Immagine sulla Shellwindow

Utilizzo la funzione StrechBitmap() per inserire immagini nelle DataWin e
normalmente non ho
nessun tipo di problema per le visualizzazioni.
Vorrei adesso inserire una immagine sulla ShellWindow principale e riesco a
visualizzarla
correttamente ma poi quando da menu' richiamo una finestra che sovrappone
l'immagine,
questa scompare (il metodo Expose non viene richiamato) fino a quando non
cambio le
dimensioni della finestra trascinandola con il mouse (il metodo Expose viene
richiamato).
In pratica nelle DataWin il metodo Expose viene sempre e correttamente
richiamato pertanto
posso ridisegnare l'immagine mentre con la ShellWin questo non succede.
Qualche soluzione ?
Grazie a tutti dell'interessamento.
Alessandro.

 normalmente non ho nessun tipo di problema per le visualizzazioni.
Attenzione che io ho riscontrato una eccessiva lentezza dell'API
StretchBlt() sotto Windows XP (e probabilmente anche sotto NT e 2000 ma
non ho provato) rispetto a 95/98/ME (una delle innumerevoli schifezze
della serie NT/2000/XP...).
EMG
--
EMAG Software Homepage:     
http://www.emagsoftware.it
The EMG's ZX-Spectrum Page: 
http://www.emagsoftware.it/spectrum
The Best of Spectrum Games: 
http://www.emagsoftware.it/tbosg

Ecco il codice per una Shell con fondo sfumato (scelta tra tre colori), o
con un bitmap al centro o affiancato.
Nient'altro ?
E buona Pasqua a tutti.
Danilo Giuliani
www.softdevo.com
in...@softdevo.com
sup...@softdevo.com
STATIC DEFINE IDI_STANDARDICON := 101
****************************************************************************
****************
CLASS StandardShellWindow INHERIT ShellWindow
//l La finestra principale di una applicazione
//x StandardShellWindow{<oOwnerApp>,<ApplicationTitle>}
//p <oOwnerApp> La Classe APP dell'applicazione
//p <ApplicationTitle> Il titolo dell'applicazione
//d Eredita dalla Classe ShellWindow, è la finestra principale
dell'applicazione
//d E' anche l'oggetto di sistema tornato dalla funzione SysObject()
 EXPORT oAPP    AS APP
 EXPORT ExecName   AS STRING
 PROTECT hBkGndBitMap  AS PTR
 PROTECT oPrinter       AS PrintingDevice
****************************************************************************
****************
FUNCTION SubClassWindow(  hWnd AS PTR, PtrProc  AS PTR  ) AS VOID
 SetWindowLong( hWnd, GWL_WNDPROC, LONGINT( _CAST, PtrProc  ) )
****************************************************************************
****************
FUNCTION GradientFill( hWnd AS PTR, hDC AS PTR) AS VOID
 LOCAL rc  IS _WINRECT
 LOCAL hNewBrush AS PTR
 LOCAL hOldBrush AS PTR
 LOCAL siHeight  AS LONGINT
 LOCAL siWidth  AS LONGINT
 LOCAL iBrushNo  AS INT
 LOCAL ik  AS INT
 LOCAL il  AS INT
 LOCAL iHeight  AS INT
 LOCAL cColore := // Recupero il colore che voglio dal registro tra
"BLUE","VIOLA","GIALLO","No" (No indica che avrò solo un BitMap)
 IF Empty(cColore)
  cColore := "BLUE"
 ENDIF
 GetClientRect( hWnd, @rc )
 siHeight := rc.bottom - rc.top
 siWidth := rc.right - rc.left
 iHeight := Integer( siHeight )
 FOR ik := 1 UPTO iHeight
  il := ik - 1
  SetRect( @rc, 0, SHORTINT( _CAST, il ), siWidth, SHORTINT(  _CAST, il )
+1 )
  iBrushNo :=  Max( (ik*255)/ iHeight, 1 )
  IF Instr("BLUE",cColore)// == "BLUE"
   hNewBrush :=  CreateSolidBrush( RGB( 0, BYTE(_CAST, 255 - iBrushNo ),
BYTE(_CAST, 255 -  iBrushNo ) ) )
  ELSEIF Instr("VIOLA",cColore)//  cColore == "VIOLA"
   hNewBrush :=  CreateSolidBrush( RGB( BYTE(_CAST, 255 - iBrushNo ),0,
BYTE(_CAST, 255 -  iBrushNo ) ) )
  ELSE
   hNewBrush :=  CreateSolidBrush( RGB( BYTE(_CAST, 255 - iBrushNo ),
BYTE(_CAST, 255 -  iBrushNo ),0 ) )
  ENDIF
  hOldBrush := SelectObject( hDC, hNewBrush )
  FillRect( hDC, @rc, hNewBrush )
  SelectObject( hDC , hOldBrush )
  DeleteObject( hNewBrush )
 NEXT
RETURN
****************************************************************************
****************
METHOD ShellWithCentredBitMap( cString, cBitMap,lModo ) CLASS
StandardShellWindow
 LOCAL hWnd AS PTR
 hWnd := SELF:Handle(4)
 // Set up the replacement WndProc for the shell
 SubClassWindow(  hWnd, @MdiClientWinProc() )
 // Load our butmap
 SELF:hBkGndBitMap := LoadImage( 0, String2Psz( cBitMap ), IMAGE_BITMAP, 0,
0, LR_LOADFROMFILE )  // DeleteObject is called in our close
 // Send the following message to set up the MdiClientWndProc
 VOSendMessage( hWnd, WM_USER + 4, 0, LONG( _CAST, SELF:hBkGndBitMap ) )
 InvalidateRect( hWnd, NULL_PTR, TRUE )
RETURN NIL
****************************************************************************
****************
METHOD ShellWithGradient( cString  ) CLASS StandardShellWindow
 LOCAL hWnd AS PTR
 IF IsNil( cString )
  cString := "TEST"
 ENDIF
 hWnd := SELF:Handle(4)
 SubClassWindow(  hWnd, @MdiClientWinProc() )
 VOSendMessage( hWnd, WM_USER + 1, 0, LONG( _CAST, String2Psz( cString ) ) )
 InvalidateRect( hWnd, NULL_PTR, TRUE )
RETURN NIL
****************************************************************************
****************
METHOD ShellWithTexturedBitmap( cString, cBitMap ) CLASS StandardShellWindow
 LOCAL hWnd AS PTR
 IF IsNil( cString )
  cString := "TEST"
 ENDIF
 hWnd := SELF:Handle(4)
 SubClassWindow(  hWnd, @MdiClientWinProc() )
 SELF:hBkGndBitMap := LoadImage( 0, String2Psz( cBitMap ), IMAGE_BITMAP, 0,
0, LR_LOADFROMFILE ) // DeleteObject is called in our close
 VOSendMessage( hWnd, WM_USER + 2, 0, LONG( _CAST, SELF:hBkGndBitMap ) )
 VOSendMessage( hWnd, WM_USER + 3, 0, LONG( _CAST, String2Psz( cString ) ) )
 InvalidateRect( hWnd, NULL_PTR, TRUE )
RETURN NIL
****************************************************************************
****************
FUNCTION MdiClientWinProc( hWnd AS PTR, uMsg AS DWORD, wParam AS DWORD,
lParam AS LONG ) AS LONG _WINCALL
 LOCAL liRetVal     AS LONG
 LOCAL hDC      AS PTR
 LOCAL ps      IS _WINPAINTSTRUCT
 LOCAL lpfnDefaultProc    AS PTR
 LOCAL STATIC hBitMap   AS PTR
 LOCAL STATIC siWhichToPaint  AS SHORTINT
 LOCAL pszText   AS PSZ
 lpfnDefaultProc :=  GetClassLong( hWnd,  GCL_WNDPROC )  // Get VO's default
window procedure
 DO CASE
 CASE uMsg == WM_USER + 1
  siWhichToPaint := 1
  RETURN( 0L )
 CASE uMsg == WM_USER + 2
  hBitMap := WORD( _CAST, lParam )
  siWhichToPaint := 2
  RETURN( 0L )
 CASE uMsg == WM_USER + 3
  siWhichToPaint := 2
  RETURN( 0L )
 CASE uMsg == WM_USER + 4
  hBitMap := WORD( _CAST, lParam )
  siWhichToPaint := 3
  RETURN( 0L )
 CASE uMsg == WM_PAINT
  hDC := BeginPaint( hWnd, @ps )
  IF siWhichToPaint = 1
   GradientFill( hWnd, hDC )
   PszText := String2Psz(SysObject():ExecName)
   IF PszLen( pszText ) > 0
    PEDrawText( hWnd, hDC, PszText  )
     ENDIF
  ELSEIF  siWhichToPaint = 2
   DrawShellBitMap( hWnd, hDC, hBitMap )
   PszText := String2Psz(SysObject():ExecName)
   IF PszLen( pszText ) > 0
    PEDrawText( hWnd, hDC, PszText  )
     ENDIF
  ELSEIF siWhichToPaint = 3
   GradientFill( hWnd, hDC ) // Could also do this if you wanted to
      CentreBitMap( hWnd, hDC, hBitMap )
  ENDIF
  EndPaint( hWnd, @ps )
  RETURN( 0L )
 CASE uMsg == WM_SIZE
  InvalidateRect( hWnd, NULL_PTR, TRUE )
  liRetVal := CallWindowProc(  lpfnDefaultProc , hWnd, uMsg, wParam,
lParam )
 CASE uMsg == WM_ERASEBKGND
  IF !( siWhichtoPaint == 3 )
   RETURN( 0L )
  ELSE
   liRetVal := CallWindowProc(  lpfnDefaultProc , hWnd, uMsg, wParam,
lParam )
  ENDIF
 OTHERWISE
  liRetVal := CallWindowProc(  lpfnDefaultProc , hWnd, uMsg, wParam,
lParam )
 ENDCASE
RETURN liRetVal
****************************************************************************
****************
FUNCTION DrawShellBitMap( hWnd AS PTR, hDC AS PTR, hBitMap AS PTR ) AS VOID
 LOCAL hMemDC   AS PTR
 LOCAL rc    IS _WINRECT
 LOCAL BitMap   IS _WINBITMAP
 LOCAL i, j     AS SHORTINT
 LOCAL siCols   AS SHORTINT
 LOCAL siRows   AS SHORTINT
 GetClientRect( hWnd, @rc )
 hMemDC := CreateCompatibleDC( hDC )
 SelectObject( hMemDC, hBitMap )
 SetMapMode( hDC, MM_TEXT )
 GetObject( hBitMap, _Sizeof( _WINBITMAP), @BitMap )
 siCols  := SHORTINT( rc.Right / BitMap.bmWidth )
 siRows  := SHORTINT( rc.Bottom / BitMap.bmHeight )
 FOR i := 0 TO siCols
  FOR j := 0 TO siRows
   BitBlt( hDC, BitMap.bmWidth * i, BitMap.bmHeight * j, BitMap.bmWidth,
BitMap.bmHeight, hMemDC, 0,0, SRCCOPY )
  NEXT
 NEXT
 DeleteDC( hMemDC )
RETURN
****************************************************************************
****************
FUNCTION CentreBitMap( hWnd AS PTR, hDC AS PTR, hBmp AS PTR ) AS VOID STRICT
 LOCAL rc    IS _WINRECT
 LOCAL hMemDC    AS PTR
 LOCAL hOldBitMap  AS PTR
 LOCAL struNewBitMap AS _WINBITMAP
 LOCAL siXOffSet  AS LONGINT
 LOCAL siyOffSet  AS LONGINT
 LOCAL lStretch   AS LOGIC
 lStretch  := FALSE
 GetClientRect( hWnd, @rc )
 struNewBitMap  := MemAlloc( _SizeOf( _WINBITMAP ) )
 hMemDC := CreateCompatibleDC( hDC )
 hOldBitMap := SelectObject( hMemDC, hBmp )
 SetMapMode( hMemDC, GetMapMode( hDC ) )
 GetObject( hBmp, _SizeOf( _WINBITMAP ), StruNewBitMap )
 IF ( rc.Right - rc.Left ) > struNewBitMap.bmWidth
  siXOffSet := (( rc.Right - rc.Left) - struNewBitMap.bmWidth)/2
 ELSE
  siXOffSet := 0
  IF ( rc.Right - rc.Left ) < struNewBitMap.bmWidth
   lStretch := TRUE
  ENDIF
 ENDIF
 IF ( rc.Bottom - rc.Top ) > struNewBitMap.bmHeight
  siYOffSet := (( rc.Bottom - rc.Top) - struNewBitMap.bmHeight) /2
 ELSE
  siYOffSet := 0
  IF rc.Bottom - rc.Top < struNewBitMap.bmHeight
   lStretch := TRUE
  ENDIF
 ENDIF
 IF lStretch
  StretchBlt( hDC, rc.Left, rc.Top, rc.Right , rc.Bottom , hMemDC, 0,0,
struNewBitMap.bmWidth, struNewBitMap.bmHeight, SRCCOPY )
 ELSE
  BitBlt( hDC, rc.Left + siXOffset, rc.Top + siYOffSet, (rc.Right -
rc.Left ), ( rc.Bottom - rc.Top), hMemDC, 0,0, SRCCOPY )
 ENDIF
 SelectObject( hMemDC, hOldBitMap )
 DeleteDC( hMemDC )
 MemFree( struNewBitMap )
RETURN
****************************************************************************
****************
FUNCTION PEDrawText(  hWnd AS PTR, hDC AS PTR, pszText AS PSZ ) AS VOID
 LOCAL rc   IS _WINRECT
 LOCAL rectShadow IS _WINRECT
 LOCAL hOldfont  AS PTR
 LOCAL hFont   AS PTR
 LOCAL siHeight  AS LONGINT
 LOCAL siLen   AS LONGINT
 LOCAL oColor   AS DWORD
 oColor := RGB(255,255,255 )
 siLen := LONGINT(  _CAST, PszLen( pszText ) )
 // legge la canvasarea della finestra
 GetClientRect( hWnd, @rc )
 // Crea una copia per il rettangolo dell'ombreggiatura
 CopyRect( @rectShadow, @rc )
 // Legge l'altezza del font
 siHeight := - Integer(( GetDeviceCaps( hDC, LOGPIXELSY ) * 40) / 72)
 hFont := CreateFont( siHeight, 0, 0, 0,  ;
         FW_BOLD, 1,0,0,  ; // Bold, Italic
         0,0,0,0,0,   ;
         PSZ( "Times New Roman") )
 // Seleziona il nuovo font
 hOldFont := SelectObject( hDC, hFont )
 // Setta il background mode a trasparente
 SetBkMode( hDC, TRANSPARENT )
 // Muove il rettangolo dell'ombra in basso a destra
 OffsetRect( @rectShadow, 6, 6 )
 // Setta il colore dell'ombra a nero
 SetTextColor( hDC, RGB(0,0,0))
 // Disegna il testo in nero
 DrawText( hDC, pszText, siLen, @rectShadow, DT_SINGLELINE + DT_CENTER +
DT_VCENTER  )
 // Resetta il coloe a bianco
 SetTextColor( hDC, oColor)
 // Disegna il testo in bianco
 DrawText( hDC, pszText,  siLen , @rc,  DT_SINGLELINE + DT_CENTER +
DT_VCENTER )
 // Riseleziona il font originale
 SelectObject( hDC, hOldFont )
 // Cancella il font corrente
 DeleteObject( hFont )
RETURN
****************************************************************************
****************
METHOD Init( oOwnerApp,ApplicationTitle) CLASS StandardShellWindow
LOCAL oSB AS OBJECT
LOCAL cColore := // recupero il colore dal registro
LOCAL cBitMap := // recupero il bitmap dal registro (se c'è)
IF Empty(cColore)
 cColore := "BLUE"
ENDIF
 SELF:PreInit( oOwnerApp,ApplicationTitle)
 SUPER: Init( oOwnerApp )
 SELF:oAPP := oOwnerApp
 IF IsMethod(SELF,#EnableDragDropClient)
  SELF: EnableDragDropClient()
 ENDIF
 oSB := SELF:EnableStatusBar()
 SELF:StatusBar:DisplayKeyboard()
 oSB:DisplayTime()
 oSB:DisplayMemory()
 SELF:Icon := Icon{ResourceID{IDI_STANDARDICON}}
 SELF:Caption := // quello che voglio //
 SELF:ExecName := ApplicationTitle
 // Redirige i messaggi alla funzione OTClientWinProc
IF (cColore == "VIOLA" .OR. cColore == "GIALLO" .OR. cColore == "BLUE")
.AND. Empty(cBitMap)
 SELF:ShellWithGradient( ApplicationTitle )
ELSEIF (cColore == "VIOLA" .OR. cColore == "GIALLO" .OR. cColore == "BLUE")
.AND. !Empty(cBitMap)
 SELF:ShellWithCentredBitMap( ApplicationTitle, cBitMap )
ELSEIF cColore == "NO" .AND. !Empty(cBitMap)
 SELF:ShellWithTexturedBitmap( ApplicationTitle, cBitMap )
ENDIF
    SELF:oPrinter := PrintingDevice{}
RETURN SELF
****************************************************************************
****************

 ha scritto nel
messaggio news:AIsna.25604$LB6.6...@news1.tin.it...


GRAZIE A TUTTI.
Ciao e buona Pasqua Alessandro