&&Ecrire dans toutes les directions sur un form avec API Windows...sous VFP6.0..
oform=createobject("ywrite_form")
oform.show
read events
return
DEFINE CLASS ywrite_form AS form
Height = 600
Width = 800
ShowWindow = 2
Borderstyle=2
DoCreate = .T.
ShowTips = .T.
AutoCenter = .T.
Caption = "Ecrire dans toutes les directions...sous VFP6.0....."
TitleBar = 1
Name = "Form1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 365, ;
Left = 483, ;
Height = 27, ;
Width = 60, ;
Caption = "Write", ;
Name = "Command1"
ADD OBJECT text1 AS textbox WITH ;
Height = 25, ;
InputMask = "XXXXXXXXXXXXXXXXXXXXXXXXX", ;
Left = 151, ;
ToolTipText = "25 Caractères max !", ;
Top = 369, ;
Width = 301, ;
Name = "Text1"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 363, ;
Left = 615, ;
Height = 27, ;
Width = 24, ;
Caption = "X", ;
Name = "Command3"
PROCEDURE _print
lparameters lcText, lnColor, lnAngle,x,y,xsize
#DEFINE ANSI_CHARSET 0
#DEFINE OUT_DEFAULT_PRECIS 0
#DEFINE OUT_DEVICE_PRECIS 5
#DEFINE OUT_OUTLINE_PRECIS 8
#DEFINE CLIP_DEFAULT_PRECIS 0
#DEFINE CLIP_STROKE_PRECIS 2
#DEFINE DEFAULT_QUALITY 0
#DEFINE PROOF_QUALITY 2
#DEFINE DEFAULT_PITCH 0
#DEFINE FW_BOLD 700
#DEFINE TRANSPARENT 1
#DEFINE OPAQUE 2
hFont = CreateFont (;
xsize,0, lnAngle,lnAngle, FW_BOLD, 0,0,0, ANSI_CHARSET,;
OUT_OUTLINE_PRECIS, CLIP_STROKE_PRECIS,;
PROOF_QUALITY, DEFAULT_PITCH, "Monotype Corsiva")
hwnd = GetActiveWindow()
hdc = GetWindowDC (hwnd)
* select new font into the device context
* and delete the old one
= DeleteObject (SelectObject (hdc, hFont))
* set text color on a transparent background
= SetTextColor (hdc, lnColor)
= SetBkMode (hdc, TRANSPARENT)
* the printing
= TextOut (hdc, x, y, lcText, Len(lcText))
* release system resources
= DeleteObject (hFont)
= ReleaseDC (hwnd, hdc)
ENDPROC
PROCEDURE Resize
this.text1.top=this.height-30
this.command1.top=this.text1.top
this.command3.top=this.text1.top
this.text1.width=this.width/3
THIS.TEXT1.left=this.width/2-this.text1.width
this.command1.left=this.text1.left+this.text1.width+2
this.command3.left=this.command1.left+this.command1.width+2
if tour=1
thisform.command1.click
endi
ENDPROC
PROCEDURE Init
THISFORM.TITLEBAR=0
publi tour
tour=0
DECLARE INTEGER GetActiveWindow IN user32
DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
DECLARE INTEGER ReleaseDC IN user32;
INTEGER hwnd, INTEGER hdc
DECLARE INTEGER SetTextColor IN gdi32;
INTEGER hdc, INTEGER crColor
DECLARE INTEGER SelectObject IN gdi32;
INTEGER hdc, INTEGER hObject
DECLARE INTEGER TextOut IN gdi32;
INTEGER hdc, INTEGER x, INTEGER y,;
STRING lpString, INTEGER nCount
DECLARE INTEGER SetBkMode IN gdi32;
INTEGER hdc, INTEGER iBkMode
DECLARE INTEGER CreateFont IN gdi32;
INTEGER nHeight, INTEGER nWidth,;
INTEGER nEscapement, INTEGER nOrientation,;
INTEGER fnWeight, INTEGER fdwItalic,;
INTEGER fdwUnderline, INTEGER fdwStrikeOut,;
INTEGER fdwCharSet,;
INTEGER fdwOutputPrecision,;
INTEGER fdwClipPrecision,;
INTEGER fdwQuality,;
INTEGER fdwPitchAndFamily,;
STRING lpszFace
this.resize()
THISFORM.TEXT1.SETFOCUS()
ENDPROC
PROCEDURE MOUSEDOWN
LPARAMETERS nButton, nShift, nXCoord, nYCoord
DECLARE INTEGER GetFocus IN WIN32API
lnHandle = GetFocus()
param1 = 274
param2 = 0xF012
DECLARE INTEGER ReleaseCapture IN WIN32API
DECLARE INTEGER SendMessage IN WIN32API INTEGER, INTEGER, INTEGER, INTEGER
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
ENDPROC
PROCEDURE Destroy
CLEA DLLS
clea events
ENDPROC
PROCEDURE command1.Click
tour=1
THISFORM.CLS
IF EMPTY(THISFORM.TEXT1.VALUE)
lcText = "Yousfi Benameur"
else
lcText =thisFORM.text1.value
endi
x=120
y=320+70
xsize=36
thisform._print (lcText, Rgb(164,0,0), 0,x,y,xsize)
x=100
y=320+70
xsize=36
thisform._print (lcText, Rgb(164,210,155), 900,x,y,xsize)
x=120
y=300+70
thisform._print (lcText, Rgb(164,10,100), 450,x,y,xsize)
x=440
y=170+70
xsize=16
FOR ii=3600 TO 1 STEP-100
lnColor = Rgb(Max(0,255-ii), Max(0,128-ii*5), Min(255,128+ii*10))
thisform._print (lcText, lnColor, -ii,x,y,xsize)
ii = ii -120
thisform._print (lcText, Rgb(80,80,80),-ii,x,y,xsize)
ENDFOR
lcText1="VFP6.0"
x=440
y=315+70
xsize=48
thisform._print (lcText1, Rgb(184,5,150), 0,x,y,xsize)
ENDPROC
PROCEDURE command3.Click
CLEA
THISFORM.RELEASE
ENDPROC
ENDDEFINE
*
*-- EndDefine: ywrite_form
**************************************************
|
Retour à la liste
Algérie
Fiche personnelle
Note des membres