Code : Tout sélectionner
;// Traduction d'un code écrit en C par CGi
;// Origine: http://chgi.developpez.com/windows/clipping/
;// Je n'ai pas cherché à simplifier en utilisant des fonctions de Pure Basic.
Procedure WindowCallback(window , message, wParam, lParam)
res=#PB_ProcessPureBasicEvents
Select message
Case #WM_paint
lf.LOGFONT
ps.PAINTSTRUCT
hFont.l
hFontOld.l
hpen.l
hpenOld.l
sz.SIZE
i.l
hDC.l
Dim f.b(32) ;{"Arial Black"}
CopyMemory("Arial Black",@f(0),Len("Arial Black"))
hDC = BeginPaint_(window, ps)
;// Initialisation de la Structure LOGFONT
ZeroMemory_(@lf, SizeOf(LOGFONT))
CopyMemory(@f(0),@lf\lfFaceName[0],Len("Arial Black"))
lf\lfHeight = 100
;// Céation de la fonte
hFont = CreateFontIndirect_(lf)
hFontOld = SelectObject_(hDC, hFont)
;// Création du crayon
hpen = createpen_(#ps_solid, 3, 0)
hpenOld = SelectObject_(hDC, hpen)
;// Dessin du chemin
BeginPath_(hDC)
TextOut_(hDC, 10, 10, "Bonjour", 7)
EndPath_(hDC)
StrokePath_(hDC)
;// Dessin dans la découpe du chemin
BeginPath_(hDC)
TextOut_(hDC, 10, 120, "Bonjour", 7)
EndPath_(hDC)
SelectClipPath_(hDC, #RGN_XOR)
GetTextExtentPoint32_(hDC, "Bonjour",7 , @sz)
For i = 121 To (120 + sz\cy) Step 6
MoveToEx_(hDC, 11, i, #Null)
LineTo_(hDC, (9 + sz\cx), i)
Next i
SelectObject_(hDC, hFontOld)
SelectObject_(hDC, hpenOld)
DeleteObject_(hpen)
DeleteObject_(hFont)
EndPaint_(window, ps)
ProcedureReturn 0
EndSelect
ProcedureReturn res
EndProcedure
;// Création de la fenêtre.
OpenWindow(0, 0, 0, 322, 224,#PB_Window_ScreenCentered | #PB_Window_SystemMenu , "Path and Clip")
;// Et la fameuse boucle de messages
SetWindowCallback(@WindowCallback())
Repeat
event=WaitWindowEvent()
Until event=#PB_EventCloseWindow 