Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

#include "Xbp.ch"
#include "Appevent.ch"
#include "DLL.ch"
#include "GRA.ch"

#define BorderPadding 6

DLLFUNCTION SetWindowRgn(hHwnd,hRgn,bRedraw) USING STDCALL FROM USER32.DLL
DLLFUNCTION CreateEllipticRgn(nLeftRect,nTopRect,nRightRect,nBottomRect)  USING STDCALL FROM GDI32.DLL
DLLFUNCTION CreateRoundRectRgn(nLeftRect,nTopRect,nRightRect,nBottomRect,nWidth,nHeight)  USING STDCALL FROM GDI32.DLL
DLLFUNCTION DeleteObject( nObject) USING STDCALL FROM GDI32.DLL

PROCEDURE AppSys
Return

PROCEDURE Main
LOCAL nEvent, oXbp, mp1, mp2
LOCAL oDlg, oDraw, oStatic, oButton, oFont
LOCAL lExit   := .F.
LOCAL aSize   := {800,600}
LOCAL aPos    := {  0,  0}
LOCAL hHwnd
LOCAL nLeftRect
LOCAL nTopRect
LOCAL nRightRect
LOCAL nBottomRect
LOCAL hRgn

   oFont := XbpFont():new():create( "24.Arial.normal" )

   oDlg  := XbpDialog():New(AppDeskTop(),,aPos,aSize,,.F.)
   oDlg:titleBar := .F.
   oDlg:tasklist := .T.
   oDlg:Create()

   oDraw := oDlg:DrawingArea
   aSize := oDraw:CurrentSize()

   oStatic := XbpStatic():new( oDraw,, {0, 0},  aSize )
   oStatic:paint := {|aRect, uNIL, oSelf | MyPaint(oSelf,aRect,oFont) }
   oStatic:create()

   oButton := XbpPushButton():new(oStatic , , {aSize[1]-60,aSize[2]-40}, {32,32} )
   oButton:caption := "X"
   oButton:create()
   oButton:activate:= {|| lExit := .T. }


   // get handle
   hHwnd := oDlg:GetHwnd()

   nLeftRect   := BorderPadding
   nTopRect    := aSize[2] - (2*BorderPadding)
   nRightRect  := aSize[1] - (2*BorderPadding)
   nBottomRect := BorderPadding

   // create Region
   hRgn := CreateRoundRectRgn(nLeftRect,nTopRect,nRightRect,nBottomRect,50,50)
   SetWindowRgn(hHwnd,hRgn,.t.)
   DeleteObject(hRgn)

   CenterControl(oDlg)
   oDlg:show()

   SetAppWindow( oDlg )
   SetAppFocus(  oDlg )

   nEvent := xbe_None
   DO WHILE !lExit
      nEvent := AppEvent ( @mp1, @mp2, @oXbp )
      DO CASE
         CASE nEvent == xbeP_Keyboard .and. mp1 == xbeK_ALT_F4
            lExit := .T.
      OTHERWISE
         oXbp:HandleEvent ( nEvent, mp1, mp2 )
      ENDCASE
   ENDDO

RETURN

PROCEDURE MyPaint(oSelf,aRect,oFont)
LOCAL oPS
LOCAL nColor1
LOCAL nColor2
LOCAL aColors
LOCAL aAttr, aBox
LOCAL cCaption := "hello world"
LOCAL nweight  := aRect[3] - aRect[1]
LOCAL nheight  := aRect[4] - aRect[2]
LOCAL aSize    := {nweight,nheight}

   oPS := oSelf:lockPS()

   nColor1  := GraMakeRGBColor( {187,255,255}  )
   nColor2  := GraMakeRGBColor( {244,255,255} )
   aColors  := { nColor1,nColor2 }
   GraGradient(oPS, {0,0}, {{nweight,aSize[2]}}, aColors ,GRA_GRADIENT_HORIZONTAL)

   GraSetFont( oPs, oFont )

   aBox := GraQueryTextBox( oPS, cCaption )
   nweight := aBox[ 3 ] [ 1 ] - aBox[ 1 ] [ 1 ]
   nheight := aBox[ 1 ] [ 2 ] - aBox[ 2 ] [ 2 ]

   aAttr := ARRAY( GRA_AS_COUNT )
   aAttr [ GRA_AS_COLOR ] := GRA_CLR_RED
   GraSetAttrString( oPs, aAttr )

   GraStringAt( oPs, {(aSize[1]-nweight)/2, aSize[2]-nheight }, cCaption )

   oSelf:unlockPS()

RETURN

Code: Alles auswählen

DLLFUNCTION SetLayeredWindowAttributes( hWnd, crKey, bAlpha, dwFlags ) USING STDCALL FROM USER32.DLL

FUNCTION SetWindowTransparency( hWnd, nPercent, nToPercent, nSpeed )
LOCAL nTransparentValue
LOCAL nIx
LOCAL nStep

   SetDefault( nPercent, 50 )
   SetDefault( nToPercent, nPercent )
   SetDefault( nSpeed, 1 )

   IIF( nToPercent < nPercent, nStep := - 1 * nSpeed, nStep := 1 * nSpeed )
   FOR nIx := nPercent TO nToPercent STEP nStep
      nTransparentValue := ( 1 - nIx / 100 ) * 255
      SetLayeredWindowAttributes( hWnd, GraMakeRGBColor( 0, 255, 0 ), nTransparentValue, LWA_ALPHA )
   NEXT nIx
   nTransparentValue := ( 1 - nToPercent / 100 ) * 255
   SetLayeredWindowAttributes( hWnd, GraMakeRGBColor( 0, 255, 0 ), nTransparentValue, LWA_ALPHA )

RETURN ( NIL )