POSTEZ !

[Ago]

29 pages en une nuit , vous etes fort les gars (sauf ceux de la contrex )

[chattanooga]

je suis de retour, apres une bone nuit de sommeil, des joli DM en perspective

DM

[chattanooga]

[Big Dragon]

29 pages en une nuit , vous etes fort les gars (sauf ceux de la contrex )

Agonistic, c'est la trève des privates jokes

renseignes-toi

[chattanooga]

un petit cour :

-----------

d'abort le b-a-ba:

(define (rectangle x1 y1 x2 y2)

(overlay

(filled-triangle x1 y1 x2 y2 x1 y2)

(filled-triangle x1 y1 x2 y2 x2 y1)))

--ensuite plus difficile:

(define (sierpinski n xa ya xb yb xc yc)

(if (= n 0)

(filled-triangle xa ya xb yb xc yc)

(let (

(xab (/ (+ xa xb)2))

(yab (/ (+ ya yb)2))

(xac (/ (+ xa xc)2))

(yac (/ (+ ya yc)2))

(xbc (/ (+ xb xc)2))

(ybc (/ (+ yb yc)2)))

(overlay (sierpinski (- n 1) xa ya xab yab xac yac)

(sierpinski (- n 1) xab yab xb yb xbc ybc)

(sierpinski (- n 1) xac yac xbc ybc xc yc)))))

(sierpinski 3 -0.9 -0.9 0.7 0.9 0.9 0)

(define (pyramide n x y L H)

(if (= n 1)

(rectangle x y (+ x L) (+ y (/ H n)))

(overlay (rectangle x y (+ x L) (+ y (/ H n)))

(pyramide (- n 1)

(+ x (/ L (- (* 2 n) 1)))

(+ y (/ H n))

(- L (* 2 (/ L (- (* 2 n) 1))))

(- H (/ H n))))

)

)

(pyramide 16 -0.9 -0.8 1.8 1.5)

-- TRES DIFFICILE :

(define (rectangle-plein x1 y1 x2 y2)

(overlay (filled-triangle x1 y1 x2 y2 x1 y2)

(filled-triangle x1 y1 x2 y1 x2 y2)))

(define (quart-de-tour-a-gauche image)

(quarter-turn-right

(quarter-turn-right

(quarter-turn-right image))))

(define (triangle)

(let ((t (filled-triangle -1 -1 -1 1 1 -1)))

(resize-image t 50 50)))

(define (rectangle-noir)

(let ((r (rectangle-plein -1 -1 1 1)))

(resize-image r 25 50)))

(define (rectangle-blanc)

(let ((r (line 1 1 1 1)))

(resize-image r 25 50)))

(define (collage-horizontal dessins)

(quart-de-tour-a-gauche

(collage-vertical

(map quarter-turn-right dessins))))

(define (collage-vertical dessins)

(if (pair? (cdr dessins))

(stack (car dessins)

(collage-vertical (cdr dessins)))

(car dessins)))

(define (demi-tronc n)

(cons (rectangle-noir) (collage-multiple (- n 1) (rectangle-blanc))))

(define (demi-etage-droit i n)

(append (collage-multiple i (rectangle-noir))

(list (triangle))

(collage-multiple (- n i 2) (rectangle-blanc))))

(define (collage-multiple i dessin)

(if (> i 0)

(cons dessin (collage-multiple (- i 1) dessin))

(list)))

(define (demi-ramure i n)

(if (< i (- n 1))

(cons (demi-etage-droit i n)

(demi-ramure (+ i 1) n))

(list (demi-tronc n))))

(define (mon-beau-sapin n)

(let* ((dessins-demi-sapin (demi-ramure 0 n))

(demi-sapin (collage-vertical

(map collage-horizontal dessins-demi-sapin))))

(collage-horizontal

(list (mirror-image demi-sapin) demi-sapin))))

(mon-beau-sapin 6)

--------------------------------------------------------------------------------------------

[chattanooga]

heu:

(define (ag-A1)

(let* ((A1 (ag-noeud 'a '()))

(A2 (ag-noeud 'b '()))

(A3 (ag-noeud 'c '()))

(A1-2 (ag-noeud 'd '()))

(A2-2 (ag-noeud 'e '()))

(a3-2 (ag-noeud 'f '()))

(A4 (ag-noeud 'u (list A1 A2)))

(A5 (ag-noeud 't (list A1-2 A2-2 A3-2))))

(ag-noeud 's (list A1 A5 A3 A4))))

(define (ag-feuille? e)

(ag-noeud '() '()))

(define (tous-egaux? liste)

(define (egaux? x liste)

(if (pair? liste)

(and (equal? x (car liste))

(egaux? x (cdr liste)))

#t ))

(egaux? (car liste)(cdr liste)))

(tous-egaux? '(a a a a))

(tous-egaux? '(20 21 20 20 20 20))

(define (le-max L)

(if (and (pair? L)

(pair? (cdr L)))

(max (car L)(le-max (cdr L)))

(car L)))

(le-max '(20 23 55 10 40 45))

(define (ag-strahler L)

(if (ag-feuille? L)

0

(let ((str (map ag-strahler (ag-foret A))))

(if(tous-egaux? str)

(+ 1 (car str))

(le-max str)))))

(ag-strahler (ag-A1))

[chattanooga]

y'a plus personne ....

DM

[Poulpatine]

DM

[Ago]

Agonistic, c'est la trève des privates jokes

renseignes-toi

je viens de le lire

sinon

Option Explicit

Private mCaption As String

Private mValue As Double

Private mMax As Double

Private mMin As Double

Private mBarColor As Double

Private mBackColor As Double

Private mShowCaption As Boolean

Private mSmoothScrolling As Boolean

Private mX As Single

Private mY As Single

Private mCaptionOffsetY

Private mCaptionOffsetX

Private mCapW As Long

Enum ReyProgressCaption

[Caption : Pourcentages Int] = 0 ' 49%

[Caption : Pourcentages Dec] ' 49,16%

[Caption : Valeur] ' 49

[Caption : Etapes] ' 49/105

End Enum

Enum ReyProgressType

[Type : Bar] = 0

[Type : Round]

End Enum

Enum ReyProgressCaptionAlignment

[CaptionAlignment : TopLeft] = DT_LEFT Or DT_TOP Or DT_SINGLELINE

[CaptionAlignment : TopCenter] = DT_CENTER Or DT_TOP Or DT_SINGLELINE

[CaptionAlignment : TopRight] = DT_RIGHT Or DT_TOP Or DT_SINGLELINE

[CaptionAlignment : MiddleLeft] = DT_LEFT Or DT_VCENTER Or DT_SINGLELINE

[CaptionAlignment : MiddleCenter] = DT_CENTER Or DT_VCENTER Or DT_SINGLELINE

[CaptionAlignment : MiddleRight] = DT_RIGHT Or DT_VCENTER Or DT_SINGLELINE

[CaptionAlignment : BottomLeft] = DT_LEFT Or DT_BOTTOM Or DT_SINGLELINE

[CaptionAlignment : BottomCenter] = DT_CENTER Or DT_BOTTOM Or DT_SINGLELINE

[CaptionAlignment : BottomRight] = DT_RIGHT Or DT_BOTTOM Or DT_SINGLELINE

End Enum

Enum ReyDirection

[Direction : Right] = 0

[Direction : left]

[Direction : Up]

[Direction : Down]

[Direction : ClockWise]

[Direction : CounterClockWise]

End Enum

Private mProgressType As ReyProgressType

Private mStartAngle As Double

Private mCaptionType As ReyProgressCaption

Private mCaptionMask As String

Private mCaptionAlignment As ReyProgressCaptionAlignment

Private mCaptionColor As OLE_COLOR

Private mUseCaptionColor As Boolean

Private mDir As ReyDirection

Public Event Change(Value As Double)

Public Event Complete()

Public Event Reset()

Private lSave_hDc As Long, lSave_hBmp As Long

Private lBarHdc As Long, lBarBmp As Long

Private lMustDraw As Boolean

Private lMustResize As Boolean

Public Property Get UseCaptionColor() As Boolean: UseCaptionColor = mUseCaptionColor: End Property

Public Property Let UseCaptionColor(new_UseCaptionColor As Boolean)

mUseCaptionColor = new_UseCaptionColor

Refresh

End Property

Public Property Get CaptionOffsetY() As Long: CaptionOffsetY = mCaptionOffsetY: End Property

Public Property Let CaptionOffsetY(new_CaptionOffsetY As Long)

mCaptionOffsetY = new_CaptionOffsetY

Refresh

End Property

Public Property Get CaptionOffsetX() As Long: CaptionOffsetX = mCaptionOffsetX: End Property

Public Property Let CaptionOffsetX(new_CaptionOffsetX As Long)

mCaptionOffsetX = new_CaptionOffsetX

Refresh

End Property

Public Property Get CaptionColor() As OLE_COLOR: CaptionColor = mCaptionColor: End Property

Public Property Let CaptionColor(new_CaptionColor As OLE_COLOR)

mCaptionColor = new_CaptionColor

mUseCaptionColor = True

Refresh

End Property

Public Property Get ProgressType() As ReyProgressType: ProgressType = mProgressType: End Property

Public Property Let ProgressType(new_ProgressType As ReyProgressType)

Dim hRgn As Long

mProgressType = new_ProgressType

Direction = mDir

UserControl_Resize

End Property

Public Property Get Direction() As ReyDirection: Direction = mDir: End Property

Public Property Let Direction(new_Direction As ReyDirection)

' verifie la cohérence des parametres

If mProgressType = [Type : Bar] Then

If new_Direction = [Direction : ClockWise] Or new_Direction = [Direction : CounterClockWise] Then new_Direction = [Direction : Right]

Else

If new_Direction <> [Direction : ClockWise] And new_Direction <> [Direction : CounterClockWise] Then new_Direction = [Direction : ClockWise]

End If

mDir = new_Direction

lMustResize = True

Call Refresh

End Property

Public Property Get CaptionAlignment() As ReyProgressCaptionAlignment: CaptionAlignment = mCaptionAlignment: End Property

Public Property Let CaptionAlignment(new_CaptionAlignment As ReyProgressCaptionAlignment)

mCaptionAlignment = new_CaptionAlignment

Call Refresh

End Property

Public Property Get ShowCaption() As Boolean: ShowCaption = mShowCaption: End Property

Public Property Let ShowCaption(new_ShowCaption As Boolean)

mShowCaption = new_ShowCaption

Call Refresh

End Property

Public Property Get SmoothScrolling() As Boolean: SmoothScrolling = mSmoothScrolling: End Property

Public Property Let SmoothScrolling(new_SmoothScrolling As Boolean)

mSmoothScrolling = new_SmoothScrolling

Call Refresh

End Property

Public Property Get BarColor() As OLE_COLOR: BarColor = mBarColor: End Property

Public Property Let BarColor(new_BarColor As OLE_COLOR)

mBarColor = new_BarColor

Call ReinitMemPicture

Call Refresh

End Property

Public Property Get BackColor() As OLE_COLOR: BackColor = mBackColor: End Property

Public Property Let BackColor(new_BackColor As OLE_COLOR)

mBackColor = new_BackColor

Call ReinitMemPicture

Call Refresh

End Property

Public Property Get StartAngle() As Long: StartAngle = mStartAngle: End Property

Public Property Let StartAngle(new_StartAngle As Long)

mStartAngle = new_StartAngle

If mProgressType = [Type : Round] Then

ReinitMemPicture

Refresh

End If

End Property

Public Property Get hwnd() As Long: hwnd = UserControl.hwnd: End Property

Public Property Get Value() As Double: Value = mValue: End Property

Public Property Let Value(new_Value As Double)

If new_Value > mMax Then new_Value = mMax

If new_Value < mMin Then new_Value = mMin

mValue = new_Value

mCaption = Caption

mCapW = TextWidth(mCaption)

Call Refresh

If mMax = mValue Then RaiseEvent Complete

If mValue = mMin Then RaiseEvent Reset

RaiseEvent Change(mValue)

End Property

Private Property Get StrValue() As String

Select Case mCaptionType

Case [Caption : Pourcentages Dec]:

StrValue = Format((mValue) / (mMax - mMin), "0.00%")

Case [Caption : Pourcentages Int]:

StrValue = Int((mValue * 100) / (mMax - mMin)) & "%"

Case [Caption : Valeur]

StrValue = mValue

Case [Caption : Etapes]:

StrValue = Int(mValue) & "/" & mMax

End Select

End Property

Public Property Get Font() As StdFont: Set Font = UserControl.Font: End Property

Public Property Set Font(new_Font As StdFont)

Set UserControl.Font = new_Font

lMustResize = True

Call Refresh

Value = mValue

End Property

Public Property Get Max() As Double: Max = mMax: End Property

Public Property Let Max(new_Max As Double)

If new_Max - mMin <= 0 Then new_Max = mMin + 1

mMax = new_Max

Me.Value = IIf(new_Max < mValue, new_Max, mValue)

lMustResize = True

Call Refresh

End Property

Public Property Get CaptionType() As ReyProgressCaption: CaptionType = mCaptionType: End Property

Public Property Let CaptionType(new_CaptionType As ReyProgressCaption)

mCaptionType = new_CaptionType

Me.Value = mValue

lMustResize = True

Call Refresh

End Property

Public Property Get Min() As Double: Min = mMin: End Property

Public Property Let Min(new_Min As Double)

If mMax - new_Min <= 0 Then mMax = new_Min + 1

mMin = new_Min

Me.Value = IIf(new_Min > mValue, new_Min, mValue)

lMustResize = True

Call Refresh

End Property

Private Sub UserControl_Paint()

Refresh

End Sub

Public Sub Refresh()

If Not lMustDraw Then Exit Sub '# Si on ne dois pas afficher, on sort......

If (mMax - mMin) = 0 Then mMax = mMin + 1

Dim n As Double

If lMustResize Then

mCaption = Caption

mX = (ScaleWidth - TextWidth(mCaption)) / 2

mY = (ScaleHeight - TextHeight(mCaption)) / 2

lMustResize = False

Call ReinitMemPicture

End If

Dim ClipRgn As Long

'# On dessine le fond une seule fois, et on le mémorise......

If lSave_hDc = 0 Then

UserControl.Cls

lSave_hDc = CreateCompatibleDC(UserControl.hDc)

lSave_hBmp = CreateCompatibleBitmap(UserControl.hDc, ScaleWidth, ScaleHeight)

DeleteObject (SelectObject(lSave_hDc, lSave_hBmp))

If mProgressType = [Type : Bar] Then

DeleteObject (SelectObject(lSave_hDc, CreatePen(0, 1&, ShiftColor(mBackColor, 1.2, [Multiply Only]))))

MoveToEx lSave_hDc, 1, 1, ByVal 0&

LineTo lSave_hDc, ScaleWidth - 2, 1

LineTo lSave_hDc, ScaleWidth - 2, ScaleHeight - 2

LineTo lSave_hDc, 1, ScaleHeight - 2

LineTo lSave_hDc, 1, 1

DeleteObject (SelectObject(lSave_hDc, CreatePen(0, 1&, ShiftColor(mBackColor, 0.6, [Multiply Only]))))

MoveToEx lSave_hDc, 0, 0, ByVal 0&

LineTo lSave_hDc, ScaleWidth - 1, 0

LineTo lSave_hDc, ScaleWidth - 1, ScaleHeight - 1

LineTo lSave_hDc, 0, ScaleHeight - 1

LineTo lSave_hDc, 0, 0

Else

DeleteObject (SelectObject(lSave_hDc, CreatePen(0, 3&, ShiftColor(mBackColor, 0.6, [Multiply Only]))))

Ellipse lSave_hDc, 0, 0, ScaleWidth - 1, ScaleHeight - 1

ClipRgn = CreateEllipticRgn(1, 1, ScaleWidth - 1, ScaleHeight - 1)

SelectClipRgn lSave_hDc, ClipRgn

DeleteObject ClipRgn

End If

If mDir = [Direction : Right] Or mDir = [Direction : left] Or mDir = [Direction : ClockWise] Or mDir = [Direction : CounterClockWise] Then

For n = 1 To ScaleHeight - 3

DeleteObject (SelectObject(lSave_hDc, CreatePen(0, 1&, ShiftColor(mBackColor, -n))))

MoveToEx lSave_hDc, 1, n, ByVal 0&

LineTo lSave_hDc, ScaleWidth - 2, n

Next n

Else

For n = 1 To ScaleWidth - 3

DeleteObject (SelectObject(lSave_hDc, CreatePen(0, 1&, ShiftColor(mBackColor, -n))))

MoveToEx lSave_hDc, n, 1, ByVal 0&

LineTo lSave_hDc, n, ScaleHeight - 2

Next n

End If

lBarHdc = CreateCompatibleDC(UserControl.hDc)

If ProgressType = [Type : Bar] Then

If mDir = [Direction : left] Or mDir = [Direction : Right] Then

lBarBmp = CreateCompatibleBitmap(UserControl.hDc, 1, ScaleHeight - 4)

DeleteObject (SelectObject(lBarHdc, lBarBmp))

For n = 0 To ScaleHeight

SetPixel lBarHdc, 0, n, ShiftColor(mBarColor, -n)

Next n

ElseIf mDir = [Direction : Up] Or mDir = [Direction : Down] Then

lBarBmp = CreateCompatibleBitmap(UserControl.hDc, ScaleWidth - 4, 1)

DeleteObject (SelectObject(lBarHdc, lBarBmp))

For n = 0 To ScaleWidth

SetPixel lBarHdc, n, 0, ShiftColor(mBarColor, -n)

SetPixel lBarHdc, n - 1, 0, ShiftColor(mBarColor, -n)

Next n

End If

Else

lBarBmp = CreateCompatibleBitmap(UserControl.hDc, ScaleWidth - 4, ScaleWidth - 4)

DeleteObject (SelectObject(lBarHdc, lBarBmp))

For n = 1 To ScaleHeight - 3

DeleteObject (SelectObject(lBarHdc, CreatePen(0, 1&, ShiftColor(mBarColor, -n))))

MoveToEx lBarHdc, 1, n, ByVal 0&

LineTo lBarHdc, ScaleWidth - 2, n

Next n

ClipRgn = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight)

SelectClipRgn lSave_hDc, ClipRgn

DeleteObject ClipRgn

End If

End If

'# On affiche l'image du fond, que l'on a enregistrée au début

BitBlt UserControl.hDc, 0, 0, ScaleWidth, ScaleHeight, lSave_hDc, 0, 0, vbSrcCopy

Dim rSize As Double

Dim R As RECT, BarBr As Long

Dim Pos As Double

Dim Size As Double

Dim Gap As Double

Dim ForStart As Long, ForEnd As Long, ForStep As Long

If mProgressType = [Type : Bar] Then

If mDir = [Direction : left] Or mDir = [Direction : Right] Then

rSize = (ScaleWidth - 4) * (mValue) / (mMax - mMin) ' Calcul du pourcentage

If mDir = [Direction : Right] Then

Call SetRect(R, 2, 2, rSize, ScaleHeight - 3)

Else

Call SetRect(R, ScaleWidth - 2 - rSize, 2, ScaleWidth - 3, ScaleHeight - 3)

End If

ElseIf mDir = [Direction : Down] Or mDir = [Direction : Up] Then

rSize = (ScaleHeight - 4) * (mValue) / (mMax - mMin) ' Calcul du pourcentage

If mDir = [Direction : Down] Then

Call SetRect(R, 2, 2, ScaleWidth - 3, rSize)

Else

Call SetRect(R, 2, ScaleHeight - 2 - rSize, ScaleWidth - 3, ScaleHeight - 3)

End If

End If

If mDir = [Direction : left] Or mDir = [Direction : Right] Then

If Not mSmoothScrolling Then

Select Case ScaleWidth

Case Is < 50: Size = ((ScaleWidth) \ 5)

Case Is < 100: Size = ((ScaleWidth) \ 10)

Case Else: Size = ((ScaleWidth) \ 20)

End Select

Gap = 1

If mDir = [Direction : Right] Then

ForStart = 2: ForEnd = rSize: ForStep = Size + Gap

Else

ForStart = ScaleWidth - 4 - Size: ForEnd = ScaleWidth - 4 - rSize - Size: ForStep = -(Size + Gap)

End If

For Pos = ForStart To ForEnd Step ForStep

If mDir = [Direction : Right] And Pos + Size > ScaleWidth - 4 Then

Size = ScaleWidth - 2 - Pos

End If

StretchBlt UserControl.hDc, Pos, R.Top, Size, ScaleHeight - 4, lBarHdc, 0, 0, 1, ScaleHeight - 4, vbSrcCopy

Line (Pos, R.Top)-(Pos + Size, R.Top), ShiftColor(mBarColor, &H50, Multiply)

Line (Pos, R.Bottom)-(Pos + Size, R.Bottom), ShiftColor(mBarColor, &H50, Multiply)

Next Pos

Else

StretchBlt UserControl.hDc, R.Left, R.Top, rSize, ScaleHeight - 4, lBarHdc, 0, 0, 1, ScaleHeight - 4, vbSrcCopy

Line (R.Left, R.Top)-(R.Right, R.Top), ShiftColor(mBarColor, &H50, Multiply)

Line (R.Left, R.Bottom)-(R.Right, R.Bottom), ShiftColor(mBarColor, &H50, Multiply)

End If

ElseIf mDir = [Direction : Up] Or mDir = [Direction : Down] Then

If Not mSmoothScrolling Then

Select Case ScaleHeight

Case Is < 50: Size = ((ScaleHeight - 4) \ 5)

Case Is < 100: Size = ((ScaleHeight - 4) \ 10)

Case Else: Size = ((ScaleHeight - 4) \ 20)

End Select

Gap = 1

If mDir = [Direction : Down] Then

ForStart = 2: ForEnd = rSize: ForStep = Size + Gap

Else

ForStart = ScaleHeight - 4 - Size: ForEnd = ScaleHeight - 4 - rSize - Size: ForStep = -(Size + Gap)

End If

For Pos = ForStart To ForEnd Step ForStep

If Pos + Size > ScaleHeight - 4 Then

Size = ScaleHeight - 2 - Pos

End If

StretchBlt UserControl.hDc, R.Left, Pos, ScaleWidth - 4, Size, lBarHdc, 0, 0, ScaleWidth - 4, 1, vbSrcCopy

Line (R.Left, Pos)-(R.Left, Pos + Size), ShiftColor(mBarColor, &H50, Multiply)

Line (R.Right, Pos)-(R.Right, Pos + Size), ShiftColor(mBarColor, &H50, Multiply)

Next Pos

Else

StretchBlt UserControl.hDc, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, lBarHdc, 0, 0, ScaleWidth - 4, 1, vbSrcCopy

Line (R.Left, R.Top)-(R.Left, R.Bottom), ShiftColor(mBarColor, &H50, Multiply)

Line (R.Right, R.Top)-(R.Right, R.Bottom), ShiftColor(mBarColor, &H50, Multiply)

End If

End If

If mShowCaption Then

If Not mSmoothScrolling Then

Call SetRect(R, 2, 2, ScaleWidth - 4, ScaleHeight - 4)

UserControl.ForeColor = OleColorToRGB(mCaptionColor)

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Else

Call SetRect(R, 2, 2, ScaleWidth - 4, ScaleHeight - 4)

If mUseCaptionColor Then

UserControl.ForeColor = OleColorToRGB(mCaptionColor)

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Else

OffsetRect R, mCaptionOffsetX, mCaptionOffsetY

Select Case mDir

Case [Direction : Right]:

ClipRgn = CreateRectRgn(0, 0, rSize, ScaleHeight)

UserControl.ForeColor = mBackColor

Case [Direction : left]:

ClipRgn = CreateRectRgn(0, 0, ScaleWidth - 2 - rSize, ScaleHeight)

UserControl.ForeColor = mBarColor

Case [Direction : Up]:

ClipRgn = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight - 2 - rSize)

UserControl.ForeColor = mBarColor

Case [Direction : Down]:

ClipRgn = CreateRectRgn(0, 0, ScaleWidth, rSize)

UserControl.ForeColor = mBackColor

End Select

Call SelectClipRgn(UserControl.hDc, ClipRgn)

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Call DeleteObject(ClipRgn)

Select Case mDir

Case [Direction : Right]

ClipRgn = CreateRectRgn(rSize, 0, ScaleWidth, ScaleHeight)

UserControl.ForeColor = mBarColor

Case [Direction : left]

ClipRgn = CreateRectRgn(ScaleWidth - 2 - rSize, 0, ScaleWidth, ScaleHeight)

UserControl.ForeColor = mBackColor

Case [Direction : Up]

ClipRgn = CreateRectRgn(0, ScaleHeight - 2 - rSize, ScaleWidth, ScaleHeight)

UserControl.ForeColor = mBackColor

Case [Direction : Down]

ClipRgn = CreateRectRgn(0, rSize, ScaleWidth, ScaleHeight)

UserControl.ForeColor = mBarColor

End Select

Call SelectClipRgn(UserControl.hDc, ClipRgn)

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Call DeleteObject(ClipRgn)

ClipRgn = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight)

Call SelectClipRgn(UserControl.hDc, ClipRgn)

Call DeleteObject(ClipRgn)

End If

End If

End If

Else '# ROUND

rSize = 360 * (mValue) / (mMax - mMin)

BeginPath UserControl.hDc

If mDir = [Direction : CounterClockWise] Then

MoveToEx UserControl.hDc, ScaleWidth / 2, ScaleHeight / 2, 0&

AngleArc UserControl.hDc, ScaleWidth / 2, ScaleHeight / 2, ScaleWidth / 2, mStartAngle, -rSize

Else

MoveToEx UserControl.hDc, ScaleWidth / 2, ScaleHeight / 2, 0&

AngleArc UserControl.hDc, ScaleWidth / 2, ScaleHeight / 2, ScaleWidth / 2, mStartAngle, rSize

End If

LineTo UserControl.hDc, ScaleWidth / 2, ScaleHeight / 2

EndPath UserControl.hDc

Dim PathRgn As Long: PathRgn = PathToRegion(UserControl.hDc)

SelectClipRgn UserControl.hDc, PathRgn

BitBlt UserControl.hDc, 0, 0, ScaleWidth, ScaleHeight, lBarHdc, 0, 0, vbSrcCopy

Call SetRect(R, 2, 2, ScaleWidth - 4, ScaleHeight - 4)

If mUseCaptionColor Then

UserControl.ForeColor = OleColorToRGB(mCaptionColor)

Else

UserControl.ForeColor = OleColorToRGB(mBackColor)

End If

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Dim GlobalRgn As Long: GlobalRgn = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight)

Dim PathRgn2 As Long: PathRgn2 = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight)

CombineRgn PathRgn2, GlobalRgn, PathRgn, RGN_XOR

SelectClipRgn UserControl.hDc, PathRgn2

DeleteObject PathRgn

DeleteObject PathRgn2

Call SetRect(R, 2, 2, ScaleWidth - 4, ScaleHeight - 4)

If mUseCaptionColor Then

UserControl.ForeColor = OleColorToRGB(mCaptionColor)

Else

UserControl.ForeColor = OleColorToRGB(mBarColor)

End If

Call DrawText(UserControl.hDc, mCaption, Len(mCaption), R, mCaptionAlignment)

Call SelectClipRgn(UserControl.hDc, GlobalRgn)

Call DeleteObject(GlobalRgn)

End If

End Sub

Public Property Get UseDefaultProperties() As Boolean: UseDefaultProperties = False: End Property

Public Property Let UseDefaultProperties(new_UseDefaultProperties As Boolean)

If new_UseDefaultProperties Then Call UserControl_InitProperties

End Property

Public Sub Inc(Optional Step As Double = 1)

Value = mValue + Step

End Sub

Public Sub Dec(Optional Step As Double = 1)

Value = mValue - Step

End Sub

Public Sub Reset()

Value = mMin

End Sub

Public Sub Complete()

Value = mMin

End Sub

Public Property Get CaptionMask() As String: CaptionMask = mCaptionMask: End Property

Public Property Let CaptionMask(new_CaptionMask As String)

mCaptionMask = new_CaptionMask

Value = mValue

mX = (ScaleWidth - TextWidth(mCaption)) / 2

mY = (ScaleHeight - TextHeight(mCaption)) / 2

UserControl_Paint

End Property

Public Property Get Caption() As String

Dim lStrVal As String

If mMax <= mMin Then Max = mMin + 1

Select Case mCaptionType

Case [Caption : Pourcentages Dec]:

lStrVal = (Format((mValue) / (mMax - mMin), "0.00%"))

Case [Caption : Pourcentages Int]:

lStrVal = (Int((mValue * 100) / (mMax - mMin)) & "%")

Case [Caption : Valeur]

lStrVal = (mValue)

Case [Caption : Etapes]:

lStrVal = (Int(mValue) & "/" & mMax)

End Select

Dim Tmp As String

Tmp = Replace(mCaptionMask, "%Max", mMax, compare:=vbTextCompare)

Tmp = Replace(Tmp, "%Min", mMin, compare:=vbTextCompare)

Caption = Replace(Tmp, "%Val", lStrVal, compare:=vbTextCompare)

End Property

Private Sub UserControl_Resize()

lMustResize = True

Dim WinRgn As Long

If mProgressType = [Type : Round] Then

WinRgn = CreateEllipticRgn(0, 0, ScaleWidth - 1, ScaleHeight - 1)

SetWindowRgn UserControl.hwnd, WinRgn, True

DeleteObject WinRgn

If Width <> Height Then Height = Width

Else

WinRgn = CreateRectRgn(0, 0, ScaleWidth - 1, ScaleHeight - 1)

SetWindowRgn UserControl.hwnd, WinRgn, True

DeleteObject WinRgn

End If

Call Refresh

End Sub

Private Sub UserControl_Show()

Call ReinitMemPicture

End Sub

Private Sub UserControl_Terminate()

Call ReinitMemPicture

End Sub

Private Sub ReinitMemPicture()

Call DeleteDC(lSave_hDc)

Call DeleteObject(lSave_hBmp)

lSave_hDc = 0

Call DeleteDC(lBarHdc)

Call DeleteObject(lBarBmp)

End Sub

Private Sub UserControl_InitProperties()

lMustDraw = False '# Permet de ne pas redessiner pour chacun des paramètre, mais bien une fois le chargement terminé...(donc plus rapide !)

Me.Min = 0

Me.Max = 100

Me.Value = 50

Me.BackColor = &HEDF2F2

Me.BarColor = &HC57A1F

Me.ShowCaption = True

Me.CaptionColor = 0

Me.UseCaptionColor = False

Set Me.Font = Ambient.Font

Me.CaptionMask = "%Val"

Me.CaptionType = [Caption : Pourcentages Int]

Me.CaptionAlignment = [CaptionAlignment : MiddleCenter]

Me.SmoothScrolling = True

Me.CaptionOffsetX = 0

Me.CaptionOffsetY = 0

Me.StartAngle = 0

Me.ProgressType = [Type : Bar]

Me.Direction = [Direction : Right]

lMustDraw = True

Refresh

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

lMustDraw = False

With PropBag

Me.Min = .ReadProperty("Min", 0)

Me.Max = .ReadProperty("Max", 100)

Me.Value = .ReadProperty("Value", 50)

Me.BarColor = .ReadProperty("BarColor", &HC57A1F)

Me.BackColor = .ReadProperty("BackColor", &HEDF2F2)

Me.ShowCaption = .ReadProperty("ShowCaption", True)

Me.CaptionMask = .ReadProperty("CaptionMask", "%Val")

Set Me.Font = .ReadProperty("Font", Ambient.Font)

Me.CaptionType = .ReadProperty("CaptionType", [Caption : Pourcentages Int])

Me.CaptionColor = .ReadProperty("CaptionColor", 0)

Me.UseCaptionColor = .ReadProperty("UseCaptionColor", False)

Me.CaptionAlignment = .ReadProperty("CaptionAlignment", [CaptionAlignment : MiddleCenter])

Me.SmoothScrolling = .ReadProperty("SmoothScrolling", True)

Me.CaptionOffsetY = .ReadProperty("CaptionOffsetY", 0)

Me.CaptionOffsetX = .ReadProperty("CaptionOffsetX", 0)

Me.ProgressType = .ReadProperty("ProgressType", [Type : Bar])

Me.Direction = .ReadProperty("Direction", [Direction : Right])

Me.StartAngle = .ReadProperty("StartAngle", 0)

End With

lMustDraw = True

Refresh

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

With PropBag

Call .WriteProperty("CaptionAlignment", Me.CaptionAlignment, [CaptionAlignment : MiddleCenter])

Call .WriteProperty("Min", Me.Min, 0)

Call .WriteProperty("CaptionColor", Me.CaptionColor, 0)

Call .WriteProperty("UseCaptionColor", Me.UseCaptionColor, False)

Call .WriteProperty("Max", Me.Max, 100)

Call .WriteProperty("Value", Me.Value, 50)

Call .WriteProperty("CaptionType", Me.CaptionType, [Caption : Pourcentages Int])

Call .WriteProperty("BarColor", Me.BarColor, &HC57A1F)

Call .WriteProperty("BackColor", Me.BackColor, &HEDF2F2)

Call .WriteProperty("ShowCaption", Me.ShowCaption, True)

Call .WriteProperty("Direction", Me.Direction, [Direction : Right])

Call .WriteProperty("Font", Me.Font, Ambient.Font)

Call .WriteProperty("StartAngle", Me.StartAngle, 0)

Call .WriteProperty("CaptionMask", Me.CaptionMask, "%Val")

Call .WriteProperty("SmoothScrolling", Me.SmoothScrolling, True)

Call .WriteProperty("CaptionOffsetX", Me.CaptionOffsetX, 0)

Call .WriteProperty("CaptionOffsetY", Me.CaptionOffsetY, 0)

Call .WriteProperty("ProgressType", Me.ProgressType, [Type : Bar])

End With

End Sub

[chattanooga]

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

DM DM DM DM

[Ago]

mais non pas dm

[Ago]

après le vb, un peu de php

<?php
/**
* @version $Id: mod_latestnews.php,v 1.16 2004/09/14 14:20:43 stingrey Exp $
* @package Mambo_4.5.1
* @copyright (C) 2000 - 2004 Miro International Pty Ltd
* @license http://www.gnu.org/copyleft/gpl.html GNU/GPL
* Mambo is Free Software
*/

/** ensure this file is being included by a parent file */
defined( '_VALID_MOS' ) or die( 'Direct Access to this location is not allowed.' );

global $mosConfig_offset, $mosConfig_live_site, $mainframe;

$count = intval( $params->get( 'count', 5 ) );
$catid = trim( $params->get( 'catid' ) );
$secid = trim( $params->get( 'secid' ) );
$show_front = $params->get( 'show_front', 1 );
$moduleclass_sfx = $params->get( 'moduleclass_sfx' );

$now = date( 'Y-m-d H:i:s', time()+$mosConfig_offset*60*60 );

$query = "SELECT a.id, a.title, a.sectionid, a.catid"
. "\n FROM #__content AS a"
. "\n LEFT JOIN #__content_frontpage AS f ON f.content_id = a.id"
. "\n WHERE ( a.state = '1' AND a.checked_out = '0' AND a.sectionid > '0' )"
. "\n AND ( a.publish_up = '0000-00-00 00:00:00' OR a.publish_up <= '". $now ."' )"
. "\n AND ( a.publish_down = '0000-00-00 00:00:00' OR a.publish_down >= '". $now ."' )"
. ( $catid ? "\n AND ( a.catid IN (". $catid .") )" : '' )
. ( $secid ? "\n AND ( a.sectionid IN (". $secid .") )" : '' )
. ( $show_front == "0" ? "\n AND f.content_id IS NULL" : '' )
. "\n ORDER BY a.created DESC LIMIT $count"
;
$database->setQuery( $query );
$rows = $database->loadObjectList();

// needed to reduce queries used by getItemid
$bs = $mainframe->getBlogSectionCount();
$bc = $mainframe->getBlogCategoryCount();
$gbs = $mainframe->getGlobalBlogSectionCount();

// Output
echo '<ul>';
foreach ( $rows as $row ) {
// get Itemid
$Itemid = $mainframe->getItemid( $row->id, 0, 0, $bs, $bc, $gbs );
// Blank itemid checker for SEF
if ($Itemid == NULL) {
 $Itemid = '';
} else {
 $Itemid = '&Itemid='. $Itemid;
}
echo '<li><a href="'. sefRelToAbs( 'index.php?option=com_content&task=view&id='. $row->id . $Itemid ) .'">'. $row->title .'</a></li>';
}
echo '</ul>';
?>

dommage qu'il n'y a pas de coloration syntaxique

[YoannOn59.]

DM DM DM DM DM DM DM DM DM DM

[chattanooga]

arrete tes cours ... on en souffre deja assez a l'ecole

[Ago]

arrete tes cours ... on en souffre deja assez a l'ecole

bon d'accord j'arrette

Déhèmeuuuuh

[Big Dragon]

DM

[chattanooga]

un chien et un chat se promenent dans la foret ...

EDIt: j'ai la fleme d'editer mes fautes d'orthographe

[Pipotron]

c'est la fête...

[m00t]

Si je colle mon code, vous êtes mal barés ^^

[Ago]

Si je colle mon code, vous êtes mal barés ^^

ouais va y colle le

[chattanooga]

PAS CHICHE

[chattanooga]

en meme temp, c'est un developpeur C ...

[m00t]

C'est surtout que le prog sur lequel je bosse fait 1.5 millions de lignes

Va ptete faire beaucoup

[Ago]

colle que la moitié alors

[m00t]