ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Formulaire dégradé   



L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pte Claire Quebec - Canada
de la société MCRG Software
Fiche personnelle


Note des membres
14,8/20
4 votes


Contributions > 20 - Trucs et Astuces

Formulaire dégradé
# 0000000048
ajouté le 05/11/2004 16:04:21 et modifié le 30/06/2005
consulté 6409 fois
Niveau initié

Version(s) Foxpro :
VFP 7.0

Description
Comment ajouter un peu de couleur au formulaires
Code source :
&& Solution #1
&& Mettre le code dans l'init du formulaire.

LOCAL lnRow

ThisForm.ScaleMode = 3
ThisForm.DrawWidth = 1

FOR lnRow = 0 TO ThisForm.Height
 ThisForm.ForeColor = RGB(0,0,255-255*lnRow/ThisForm.Height)
 ThisForm.Line(0, lnRow, ThisForm.Width, lnRow)
NEXT lnRow
______________________________________________________________________________
&& Solution #2 && Avec appels API

Public oForm
oForm = Createobject("Tform")
oForm.Visible = .T.
Define Class Tform As Form
  Width=400
  Height=350
  Caption=" Test de formulaire dégradé"
  AutoCenter=.T.
  MinButton = .F.
  MaxButton = .F.
  hWindow=0
  hDC=0
  DspWidth=401
  DspHeight=349
  hDspDC=0
  hDspBmp=0
  hBackDC=0
  hBackBmp=0
  SrcOffs=0

  Add Object tm As Timer With Interval=0
  Procedure Init
  Declare Integer GetFocus In user32
  Declare Integer GetDesktopWindow In user32
  Declare Integer CreateCompatibleDC In gdi32 Integer hdc
  Declare Integer CreateCompatibleBitmap In gdi32;
    INTEGER hdc, Integer nWidth, Integer nHeight
  Declare Integer DeleteDC In gdi32 Integer hdc
  Declare Integer DeleteObject In gdi32 Integer hObj
  Declare Integer GetWindowDC In user32 Integer HWnd
  Declare Integer ReleaseDC In user32 Integer HWndInteger hdc
  Declare Integer SelectObject In gdi32 Integer hdc, Integer hObj
  Declare Integer BitBlt In gdi32 Integer hDestDC,;
    INTEGER x, Integer Y, Integer nWidth, Integer nHeight,;
    INTEGER hSrcDC, Integer xSrc, Integer ySrc, Integer dwRop
  Declare Integer GradientFill In Msimg32;
    INTEGER hdc, String @pVertex, Long dwNumVertex,;
    STRING @pMesh, Long dwNumMesh, Long dwMode
  Procedure tm.Timer
  Thisform.CopyToTarget
  Procedure Activate
  If This.hDspDC = 0
    This.CreateSource
  Endif
  This.tm.Interval = 50
  Procedure Destroy
  This.ReleaseSource
  Procedure CreateSource
  This.hWindow = GetFocus()
  This.hDC = GetWindowDC(This.hWindow)
  Local hDsk, hDskDC, hBr, Rect
  hDsk = GetDesktopWindow()
  hDskDC = GetWindowDC(hDsk)
  This.hDspDC = CreateCompatibleDC(hDskDC)
  This.hDspBmp = CreateCompatibleBitmap(hDskDC,;
    THIS.DspWidth, This.DspHeight)
  = DeleteObject(SelectObject(This.hDspDC, This.hDspBmp))
  Procedure CopyToTarget
  #Define SRCCOPY  13369376
  #Define SRCAND   8913094
  Local hBr, Rect
  = DrawGradient(This.hDspDC, 0,0, This.DspWidth, This.DspHeight,;
    0,80,192, 250,250,255)
  = BitBlt(This.hDC, 3,30, This.DspWidth, This.DspHeight,;
    THIS.hDspDC, 0, 0, SRCCOPY)
  Procedure ReleaseSource
  = DeleteObject(This.hBackBmp)
  = DeleteDC(This.hBackDC)
  = DeleteObject(This.hDspBmp)
  = DeleteDC(This.hDspDC)
  = ReleaseDC(This.hWindow, This.hDC)
Enddefine

Procedure DrawGradient
Lparameters hDC, x1,y1, x2,y2,;
  nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2

Local lcVertex, lcMesh
lcMesh = num2dword(0) + num2dword(1)
lcVertex = num2dword(x1) + num2dword(y1) +;
  num2word(nRed1*256) +;
  num2word(nGreen1*256) +;
  num2word(nBlue1*256) +;
  num2word(0) +;
  num2dword(x2) + num2dword(y2)  +;
  num2word(nRed2*256) +;
  num2word(nGreen2*256) +;
  num2word(nBlue2*256) +;
  num2word(0)
= GradientFill(hDC, @lcVertex, 2, @lcMesh, 1, 1)
Return
Function  num2dword (lnValue)
#Define m0       256
#Define m1     65536
#Define m2  16777216
Local b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

Function num2word (lnValue)
Return Chr(Mod(m.lnValue,256)) + Chr(Int(m.lnValue/256))

___________________________________________________________________________________________
&&Solution #3 Appels API GDI

#DEFINE ARGB_RED  0xFFFF0000
#DEFINE ARGB_BLUE 0xFF0000FF

PUBLIC o
o=CREATEOBJECT("MyForm")
o.Show()

DEFINE CLASS MyForm AS Form
AutoCenter = .T.
Width = 240
Height = 240
cTempFile = ""
nColor1 = ARGB_RED
nColor2 = ARGB_BLUE
windowstate = 2

ADD OBJECT cntFill AS Container WITH ;
   Top = 0, Left = 0, ;
   Height = 240, Width = 240, ;
   Anchor = 15

ADD OBJECT btnOne AS COmmandButton WITH ;
   Top = 100, Left = 100, ;
   Height = 25, Width = 100, ;
   Caption = "Clickez!"

*********************************************************
FUNCTION Init()
   This.cTempFile = ADDBS(SYS(2023))+SYS(2015)+".bmp"
   This.cntFill.Resize()
ENDFUNC

*********************************************************
FUNCTION Destroy()
   DELETE FILE (This.cTempFile)
ENDFUNC

*********************************************************
FUNCTION cntFill.Resize()
   CLEAR RESOURCES (ThisForm.cTempFile)
   MakeGradientPicture(ThisForm.cTempFile, This.Height, ;
         ThisForm.nColor1, ThisForm.nColor2)
   This.Picture = ThisForm.cTempFile
ENDFUNC

*********************************************************
FUNCTION btnOne.Click()
   ThisForm.nColor1 = 0xFF000000 + RAND()*0xFFFFFF
   ThisForm.nColor2 = 0xFF000000 + RAND()*0xFFFFFF
   ThisForm.cntFill.Resize()
ENDFUNC

ENDDEFINE


*********************************************************
FUNCTION MakeGradientPicture(cFileName, nHeight, nColor1, nColor2)

DECLARE Long GdipCreateLineBrushI IN GDIPLUS ;
   String point1, String point2, ;
   Long color1, Long color2, ;
   Long wrapMode, Long @lineGradient

SET CLASSLIB TO HOME()+"ffc\_gdiplus" ADDITIVE

** Get screen Graphics context
oGfxS = CREATEOBJECT("gpGraphics")
oGfxS.CreateFromHWND(0)

** Create a bitmap
oBmp = CREATEOBJECT("gpBitmap")
oBmp.CreateFromGraphics(oGfxS,1,nHeight)

** Get a bitmab graphics object
oGfx = CREATEOBJECT("gpGraphics")
oGfx.CreateFromImage(oBmp)

** Get a gradient brush
hBrush = 0
GdipCreateLineBrushI(BINTOC(0,"4rs")+BINTOC(0,"4rs"), ;
      BINTOC(0,"4rs")+BINTOC(nHeight,"4rs"), ;
      nColor1, nColor2, 0, @hBrush)
oBrush = CREATEOBJECT("gpBrush")
oBrush.SetHandle(hBrush)

** Fill the bitmap with our gradient
oGfx.FillRectangle(oBrush,0,0,1,nHeight)
oBmp.SaveToFile(cFileName,"image/bmp")

oGfx = NULL
oBrush = NULL
oBmp = NULL
oGfxS = NULL

RETURN






Commentaires
le 15/11/2004, Ludo186 a écrit :
Super comme jeux maintenant il faire le dégradé dans le senes vertical ...
le 23/11/2004, Mike Gagnon a écrit :
Ludo

Il s'agit juste de changer les paramtres. Ceci va donner un dégradé de gauche à droite.

LOCAL lnRow
ThisForm.ScaleMode = 3
ThisForm.DrawWidth = 1
FOR lnRow = 0 TO ThisForm.width
ThisForm.ForeColor = RGB(0,0,255-255*lnRow/ThisForm.width)
ThisForm.Line(lnRow, 0,lnRow,ThisForm.height)
NEXT lnRow

le 01/12/2004, Robert Plagnard a écrit :
C'est pas super.
Créez une forme avec ce code dans l'init. Puis ajoutez un bouton. Run.
Si vous passez sur le bouton avec la souris, la forme redevient grise. C'est pas sympa. De plus si vous retaillez la forme c'est pas sympa non plus.
Bref sous Windows, ce genre de comportement se met en réponse à l'évenement Paint, pas dans l'Init.

le 01/12/2004, Mike Gagnon a écrit :
>>Créez une forme avec ce code dans l'init. Puis ajoutez un bouton. Run.

Le titre indique bien "le formulaire" et non le controles.

>>De plus si vous retaillez la forme c'est pas sympa non plus.

En tant que programmeur, il s'agit d'écrire une fonction qui s'occupe du resize.
--------------------------------------------------------------------------------

le 01/12/2004, Robert Plagnard a écrit :
Malheureusement, dans le Paint des formes FoxPro, on ne fait pas ce que l'on veut, on n'a pas accès aux couches basses de windows qui permettraient de peindre la fenêtre avec une brush sur le DC (Device contexte). J'ai peur qu'il n'y ai pas de solution dans FoxPro. C'est pas sympa du tout.
le 01/12/2004, Mike Gagnon a écrit :
>>> on n'a pas accès aux couches basses de windows qui permettraient de peindre la fenêtre avec une brush sur le DC (Device contexte). <<<

Voila un commentaire surprennant venant de vous! D'apres votre profile, vous utiliser Foxpro depuis 'le début'. Que fait-on des appels API pour aller chercher le DC d'un formulaire?

DECLARE INTEGER GetActiveWindow IN user32
DECLARE INTEGER GetWindowDC IN user32 INTEGER hWnd
LOCAL hWindow, hDC
hWindow = GetActiveWindow()
hDC = GetWindowDC(hWindow)


le 02/12/2004, Robert Plagnard a écrit :
Oui c'est vrai, on a bien accès aux couches basses. GetActiveWindow() ne donne pas vraiment ce que l'on cherche, mais depuis quelques versions les forms exposent la propriété HWnd, qui est justement ce qu'il nous faut pour obtenir le DC. On arrive bien a dessiner dans la forme mais les controles ne sont pas clippés, contrairement à ce qui se passe en C# ou en Delphi. J'ai testé le Paint d'une forme FoxPro, d'une forme C# et d'une forme Delphi :
Ces paints dessinent une grosse diagonale rouge. Mettez un bouton et un texte sur la diagonale.
Dans le paint d'une forme VFP :
declare integer GetDC in win32api Integer hWnd
declare integer ReleaseDC in win32api Integer hWnd, integer hDC
declare integer CreatePen in win32api Integer fnPenStyle, integer nWidth, integer crColor
declare integer SelectObject in win32api integer HDC, integer hGDIObj
declare integer DeleteObject in win32api Integer handle
declare integer LineTo in win32api integer hDC, integer iX, integer iY
declare integer MoveToEx in win32api integer hDC, integer iX, integer iY, string @lpPoint
#define PS_SOLID 0
local hWnd, hDC, hPen, hBrush
local sPoint as string
sPoint = Replicate(Chr(0),8)
hWnd = Thisform.HWnd
hDC = GetDC( hWnd )
hPen = CreatePen( PS_SOLID, 10, Rgb(255,0,0) )
SelectObject( hDC, hPen )
MoveToEx( hDC, 0, 0, @sPoint )
LineTo( hDC, 1000,1000 )
DeleteObject( hPen )
ReleaseDC( hWnd, hDC )

Dans le paint d'une forme Delphi
procedure TForm1.FormPaint(Sender: TObject);
begin
with Canvas do begin
Pen.Width := 10;
Pen.Color := rgb(255,0,0);
MoveTo(0,0);
LineTo(1000,1000);
end;
end;

Dans le paint d'une forme C#
private void Form1_Paint(object sender, System.Windows.Forms.PaintEventArgs e)
{
Graphics Canvas = e.Graphics;
System.Drawing.Pen pen = new Pen( System.Drawing.Color.Red ,10);
Canvas.DrawLine( pen, 0,0, 1000, 1000 );
}

Ca marche bien en C# et en Delphi, ca ne marche pas en VFP (bien que ClipControls soit .T.) ou alors c'est vraiment compliqué, il faudrait jouer avec les clipping regions et sauter les controles.
Bref, pour obtenir un effet graphique de ce genre je préfere dessiner dans word un rectangle avec un gradient de couleur, le capturer avec PaintShop, le sauver en jpeg et le mettre dans la forme avec une image en arrière plan. Ca marche bien, les controles sont respectés, il n'y a pas de code, mais c'est moins riche, on ne peut pas tout avoir!

le 02/12/2004, Mike Gagnon a écrit :
>>On arrive bien a dessiner dans la forme mais les controles ne sont pas clippés,<<

Le problème vient du fait que les formes et controles de VFP sont des 'représentations' plutot que de objects Windows. Je ne crois pas que cela change bientot.


Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2019.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3