Ecran lcd

Télécharger le projet
Commenter

Description

C'est un ecran LCD 16 segments & un point.
il est multiligne et pas mal paramétrable, c a vous de juger ...

Source / Exemple : 


Ce source a été créé par The Dolphin
                                 SupraDolph ®

'Déclaration d'un type d'énumération
Public Enum Horizontal
    Gauche = 1
    Droite = 2
    Centre = 3
End Enum
Public Enum Appear
    [Flat]
    [3D]
End Enum
Public Enum Border
    [None]
    [Fixed Single]
End Enum

'Variables
Dim Ctrl_Caption As String          'Texte a écrire
Dim Ctrl_AlignementH As Horizontal  'Alignement Horizontal
Dim Ctrl_Font_Color As OLE_COLOR    'Couleur De La Police
Dim Ctrl_Back_Color As OLE_COLOR    'Couleur De Fond
Dim Ctrl_Back_Seg As OLE_COLOR      'Couleur Des segments eteind
Dim Ctrl_LCDWidth As Integer        'Largeur d'un LCD
Dim Ctrl_SegWidth As Integer        'Largeur d'un segment
Dim Ctrl_Appearance As Appear       'Apparence
Dim Ctrl_BorderStyle As Border      'Style de la bordure
Dim Ctrl_AutoSegWidth As Boolean    'Configuration de l'autowidth d'un segment
Dim Ctrl_See_Back_Seg As Boolean    'Configuration de l'affichage des segments non eclairé

'Constantes
Const Def_Ctrl_AlignementH = 1
Const Def_Ctrl_Font_Color = vbBlack
Const Def_Ctrl_Back_Color = &H8000000F
Const Def_Ctrl_Back_Seg = &H808080
Const Def_Ctrl_LCDWidth = 200
Const Def_Ctrl_SegWidth = 1
Const Def_Ctrl_Appearance = 1
Const Def_Ctrl_BorderStyle = 0
Const Def_Ctrl_AutoSegWidth = True
Const Def_Ctrl_See_Back_Seg = True

'Evénements
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Private Sub UserControl_Click()
RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Resize()
Change
End Sub

Private Sub UserControl_Show()
Change
End Sub

Private Sub UserControl_InitProperties()
Ctrl_Caption = Extender.Name
Ctrl_AlignementH = Def_Ctrl_AlignementH
Ctrl_Font_Color = Def_Ctrl_Font_Color
Ctrl_Back_Color = Def_Ctrl_Back_Color
Ctrl_Back_Seg = Def_Ctrl_Back_Seg
Ctrl_Appearance = Def_Ctrl_Appearance
Ctrl_BorderStyle = Def_Ctrl_BorderStyle
Ctrl_LCDWidth = Def_Ctrl_LCDWidth
Ctrl_SegWidth = Def_Ctrl_SegWidth
Ctrl_AutoSegWidth = Def_Ctrl_AutoSegWidth
Ctrl_See_Back_Seg = Def_Ctrl_See_Back_Seg
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Ctrl_Caption = PropBag.ReadProperty("Caption", Extender.Name)
Ctrl_AlignementH = PropBag.ReadProperty("AlignementH", Def_Ctrl_AlignementH)
Ctrl_Font_Color = PropBag.ReadProperty("FontColor", Def_Ctrl_Font_Color)
Ctrl_Back_Color = PropBag.ReadProperty("BackColor", Def_Ctrl_Back_Color)
Ctrl_Back_Seg = PropBag.ReadProperty("Back_Seg", Def_Ctrl_Back_Seg)
Ctrl_LCDWidth = PropBag.ReadProperty("LCDWidth", Def_Ctrl_LCDWidth)
Ctrl_SegWidth = PropBag.ReadProperty("SegWidth", Def_Ctrl_SegWidth)
Ctrl_Appearance = PropBag.ReadProperty("Appearance", Def_Ctrl_Appearance)
Ctrl_BorderStyle = PropBag.ReadProperty("BorderStyle", Def_Ctrl_BorderStyle)
Ctrl_AutoSegWidth = PropBag.ReadProperty("AutoSegWidth", Def_Ctrl_AutoSegWidth)
Ctrl_See_Back_Seg = PropBag.ReadProperty("SeeBackSeg", Def_Ctrl_See_Back_Seg)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Caption", Ctrl_Caption, Extender.Name)
Call PropBag.WriteProperty("AlignementH", Ctrl_AlignementH, Def_Ctrl_AlignementH)
Call PropBag.WriteProperty("FontColor", Ctrl_Font_Color, Def_Ctrl_Font_Color)
Call PropBag.WriteProperty("BackColor", Ctrl_Back_Color, Def_Ctrl_Back_Color)
Call PropBag.WriteProperty("Back_Seg", Ctrl_Back_Seg, Def_Ctrl_Back_Seg)
Call PropBag.WriteProperty("LCDWidth", Ctrl_LCDWidth, Def_Ctrl_LCDWidth)
Call PropBag.WriteProperty("SegWidth", Ctrl_SegWidth, Def_Ctrl_SegWidth)
Call PropBag.WriteProperty("Appearance", Ctrl_Appearance, Def_Ctrl_Appearance)
Call PropBag.WriteProperty("BorderStyle", Ctrl_BorderStyle, Def_Ctrl_BorderStyle)
Call PropBag.WriteProperty("AutoSegWidth", Ctrl_AutoSegWidth, Def_Ctrl_AutoSegWidth)
Call PropBag.WriteProperty("SeeBackSeg", Ctrl_See_Back_Seg, Def_Ctrl_See_Back_Seg)
End Sub

Private Function TxtToLCD(Texte As String) As String
Select Case LCase(Texte)
    Case "a", "à"
        TxtToLCD = "a1,a2,b,c,e,f,g1,g2"
    Case "b"
        TxtToLCD = "a1,a2,b,c,d1,d2,g2,i,l"
    Case "c", "ç"
        TxtToLCD = "a1,a2,d1,d2,e,f"
    Case "d"
        TxtToLCD = "a1,a2,b,c,d1,d2,i,l"
    Case "e", "é", "è", "ë", "ê"
        TxtToLCD = "a1,a2,d1,d2,e,f,g1"
    Case "f"
        TxtToLCD = "a1,a2,e,f,g1"
    Case "g"
        TxtToLCD = "a1,a2,c,d1,d2,e,f,g2"
    Case "h"
        TxtToLCD = "b,c,e,f,g1,g2"
    Case "i"
        TxtToLCD = "a1,a2,d1,d2,i,l"
    Case "j"
        TxtToLCD = "a1,a2,d1,e,i,l"
    Case "k"
        TxtToLCD = "e,f,g1,j,k"
    Case "l"
        TxtToLCD = "d1,d2,e,f"
    Case "m"
        TxtToLCD = "b,c,e,f,h,h,j"
    Case "n"
        TxtToLCD = "b,c,e,f,h,k"
    Case "o"
        TxtToLCD = "a1,a2,b,c,d1,d2,e,f"
    Case "p"
        TxtToLCD = "a1,a2,b,e,f,g1,g2"
    Case "q"
        TxtToLCD = "a1,a2,b,c,d1,d2,e,f,k"
    Case "r"
        TxtToLCD = "a1,a2,b,e,f,g1,g2,k"
    Case "s", "5"
        TxtToLCD = "a1,a2,c,d1,d2,f,g1,g2"
    Case "t"
        TxtToLCD = "a1,a2,i,l"
    Case "u", "ù"
        TxtToLCD = "b,c,d1,d2,e,f"
    Case "v"
        TxtToLCD = "e,f,j,m"
    Case "w"
        TxtToLCD = "b,c,e,f,k,m"
    Case "x" ', "*"
        TxtToLCD = "h,j,k,m"
    Case "y"
        TxtToLCD = "h,j,m"
    Case "z"
        TxtToLCD = "a1,a2,a1,d1,d2,j,m"
        
    Case "0"
        TxtToLCD = "a1,a2,b,c,d1,d2,e,f"
    Case "1", "|"
        TxtToLCD = "b,c"
    Case "2"
        TxtToLCD = "a1,a2,b,d1,d2,e,g1,g2"
    Case "3"
        TxtToLCD = "a1,a2,b,c,d1,d2,g1,g2"
    Case "4"
        TxtToLCD = "b,c,f,g1,g2"
'   Case "5" 'voir s
    Case "6"
        TxtToLCD = "a1,a2,c,d1,d2,e,f,g1,g2"
    Case "7"
        TxtToLCD = "a1,a2,b,c"
    Case "8"
        TxtToLCD = "a1,a2,b,c,d1,d2,e,f,g1,g2"
    Case "9"
        TxtToLCD = "a1,a2,b,c,d1,d2,f,g1,g2"
    Case ".", ","
        TxtToLCD = "pt"
    
    Case "'"
        TxtToLCD = "f"
    Case "!"
        TxtToLCD = "b,c,pt"
    Case "?"
        TxtToLCD = "a1,a2,b,c,f,pt"
    Case "+"
        TxtToLCD = "g1,g2,i,l"
    Case "-"
        TxtToLCD = "g1,g2"
    Case "*" ' cf x
        TxtToLCD = "h,i,j,k,l,m,g1,g2"
    Case "/"
        TxtToLCD = "j,m"
    Case "="
        TxtToLCD = "d1,d2,g1,g2"
    Case "_"
        TxtToLCD = "d1,d2"
    Case ">", ")"
        TxtToLCD = "h,m"
    Case "<", "("
        TxtToLCD = "j,k"
    Case "\"
        TxtToLCD = "h,k"
    Case "["
        TxtToLCD = "a1,d1,e,f"
    Case "]"
        TxtToLCD = "a2,b,c,d2"
    Case "%"
        TxtToLCD = "a1,d2,j,m"
    Case ":"
        TxtToLCD = "i,l"
    Case "°"
        TxtToLCD = "a1,f,g1,i"
    Case Else
        TxtToLCD = " "
End Select
End Function

Private Function Aff_LCD(LCD As String, Deb As Long, Fin As Long, ByVal Top As Long, Optional Color As OLE_COLOR)
Dim Esp As Long, lar As Long, Segments() As String, i As Byte, DW As Integer

DW = 0.009 * (Fin - Deb)
If DW < 1 Then DW = 1
Top = Top + DW * 15
DrawWidth = IIf(Ctrl_AutoSegWidth, DW, Ctrl_SegWidth)
Esp = 0.18 * (Fin - Deb)
lar = Fin - Deb - 2 * Esp
Segments = Split(LCD, ",")
For i = 0 To UBound(Segments)
    Select Case Segments(i)
        Case "a1"
'Line (Deb + Esp, Top)-(Fin - Esp, Top), Color
            Line (Deb + Esp, Top)-((Deb + Fin - Esp) / 2, Top), Color
        Case "a2"
            Line ((Deb + Fin + Esp) / 2, Top)-(Fin - Esp, Top), Color
        Case "b"
            Line (Fin, Top + Esp)-(Fin, Top + lar + Esp), Color
        Case "c"
            Line (Fin, Top + 3 * Esp + lar)-(Fin, Top + 3 * Esp + 2 * lar), Color
        Case "d1"
'Line (Deb + Esp, Top + 4 * Esp + 2 * lar)-(Fin - Esp, Top + 4 * Esp + 2 * lar), Color
            Line (Deb + Esp, Top + 4 * Esp + 2 * lar)-((Deb + Fin - Esp) / 2, Top + 4 * Esp + 2 * lar), Color
        Case "d2"
            Line ((Deb + Fin + Esp) / 2, Top + 4 * Esp + 2 * lar)-(Fin - Esp, Top + 4 * Esp + 2 * lar), Color
        Case "e"
            Line (Deb, Top + 3 * Esp + lar)-(Deb, Top + 3 * Esp + 2 * lar), Color
        Case "f"
            Line (Deb, Top + Esp)-(Deb, Top + lar + Esp), Color
        Case "g1"
'Line (Deb + Esp, Top + 2 * Esp + lar)-(Fin - Esp, Top + 2 * Esp + lar), Color
            Line (Deb + Esp, Top + 2 * Esp + lar)-((Deb + Fin - Esp) / 2, Top + 2 * Esp + lar), Color
        Case "g2"
            Line ((Deb + Fin + Esp) / 2, Top + 2 * Esp + lar)-(Fin - Esp, Top + 2 * Esp + lar), Color
        Case "h"
            Line (Deb + Esp, Top + Esp)-((Fin + Deb - Esp) / 2, Top + Esp + lar), Color
        Case "i"
            Line ((Fin + Deb) / 2, Top + Esp)-((Fin + Deb) / 2, Top + Esp + lar), Color
        Case "j"
            Line (Fin - Esp, Top + Esp)-((Fin + Deb + Esp) / 2, Top + Esp + lar), Color
        Case "k"
            Line ((Fin + Deb + Esp) / 2, Top + 3 * Esp + lar)-(Fin - Esp, Top + 3 * Esp + 2 * lar), Color
        Case "l"
            Line ((Fin + Deb) / 2, Top + 3 * Esp + lar)-((Fin + Deb) / 2, Top + 3 * Esp + 2 * lar), Color
        Case "m"
            Line ((Fin + Deb - Esp) / 2, Top + 3 * Esp + lar)-(Deb + Esp, Top + 3 * Esp + 2 * lar), Color
        Case "pt"
            PSet (Fin, Top + 4 * Esp + 2 * lar), Color
        Case "all"
            'DrawWidth = 1
            Line (Deb + Esp, Top)-((Deb + Fin - Esp) / 2, Top), Color
            Line ((Deb + Fin + Esp) / 2, Top)-(Fin - Esp, Top), Color
            Line (Fin, Top + Esp)-(Fin, Top + lar + Esp), Color
            Line (Fin, Top + 3 * Esp + lar)-(Fin, Top + 3 * Esp + 2 * lar), Color
            Line (Deb + Esp, Top + 4 * Esp + 2 * lar)-((Deb + Fin - Esp) / 2, Top + 4 * Esp + 2 * lar), Color
            Line ((Deb + Fin + Esp) / 2, Top + 4 * Esp + 2 * lar)-(Fin - Esp, Top + 4 * Esp + 2 * lar), Color
            Line (Deb, Top + 3 * Esp + lar)-(Deb, Top + 3 * Esp + 2 * lar), Color
            Line (Deb, Top + Esp)-(Deb, Top + lar + Esp), Color
            Line (Deb + Esp, Top + 2 * Esp + lar)-((Deb + Fin - Esp) / 2, Top + 2 * Esp + lar), Color
            Line ((Deb + Fin + Esp) / 2, Top + 2 * Esp + lar)-(Fin - Esp, Top + 2 * Esp + lar), Color
            Line (Deb + Esp, Top + Esp)-((Fin + Deb - Esp) / 2, Top + Esp + lar), Color
            Line ((Fin + Deb) / 2, Top + Esp)-((Fin + Deb) / 2, Top + Esp + lar), Color
            Line (Fin - Esp, Top + Esp)-((Fin + Deb + Esp) / 2, Top + Esp + lar), Color
            Line ((Fin + Deb + Esp) / 2, Top + 3 * Esp + lar)-(Fin - Esp, Top + 3 * Esp + 2 * lar), Color
            Line ((Fin + Deb) / 2, Top + 3 * Esp + lar)-((Fin + Deb) / 2, Top + 3 * Esp + 2 * lar), Color
            Line ((Fin + Deb - Esp) / 2, Top + 3 * Esp + lar)-(Deb + Esp, Top + 3 * Esp + 2 * lar), Color
            PSet (Fin, Top + 4 * Esp + 2 * lar), Color
    End Select
Next i
End Function

Public Property Get Caption() As String
Caption = Ctrl_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
Ctrl_Caption = New_Caption
Change
PropertyChanged "Caption"
End Property

Public Property Get AlignementH() As Horizontal
AlignementH = Ctrl_AlignementH
End Property

Public Property Let AlignementH(ByVal New_AlignementH As Horizontal)
Ctrl_AlignementH = New_AlignementH
Change
PropertyChanged "AlignementH"
End Property

Public Property Get FontColor() As OLE_COLOR
FontColor = Ctrl_Font_Color
End Property

Public Property Let FontColor(ByVal New_Font_Color As OLE_COLOR)
Ctrl_Font_Color = New_Font_Color
Change
PropertyChanged "FontColor"
End Property

Public Property Get BackColor() As OLE_COLOR
BackColor = Ctrl_Back_Color
End Property

Public Property Let BackColor(ByVal New_Back_Color As OLE_COLOR)
Ctrl_Back_Color = New_Back_Color
Change
PropertyChanged "BackColor"
End Property

Public Property Get Back_Seg() As OLE_COLOR
Back_Seg = Ctrl_Back_Seg
End Property

Public Property Let Back_Seg(ByVal New_Back_Seg As OLE_COLOR)
Ctrl_Back_Seg = New_Back_Seg
Change
PropertyChanged "Back_Seg"
End Property

Public Property Get LCDWidth() As Integer
LCDWidth = Ctrl_LCDWidth
End Property

Public Property Let LCDWidth(ByVal New_LCDWidth As Integer)
Ctrl_LCDWidth = New_LCDWidth
Change
PropertyChanged "LCDWidth"
End Property

Public Property Get SegWidth() As Integer
SegWidth = Ctrl_SegWidth
End Property

Public Property Let SegWidth(ByVal New_SegWidth As Integer)
Ctrl_SegWidth = New_SegWidth
Change
PropertyChanged "SegWidth"
End Property

Public Property Get Appearance() As Appear
Appearance = Ctrl_Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Appear)
Ctrl_Appearance = New_Appearance
Change
PropertyChanged "Appearance"
End Property

Public Property Get BorderStyle() As Border
BorderStyle = Ctrl_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Border)
Ctrl_BorderStyle = New_BorderStyle
Change
PropertyChanged "BorderStyle"
End Property

Public Property Get AutoSegWidth() As Boolean
AutoSegWidth = Ctrl_AutoSegWidth
End Property

Public Property Let AutoSegWidth(ByVal New_AutoSegWidth As Boolean)
Ctrl_AutoSegWidth = New_AutoSegWidth
Change
PropertyChanged "AutoSegWidth"
End Property

Public Property Get SeeBackSeg() As Boolean
SeeBackSeg = Ctrl_See_Back_Seg
End Property

Public Property Let SeeBackSeg(ByVal New_See_Back_Seg As Boolean)
Ctrl_See_Back_Seg = New_See_Back_Seg
Change
PropertyChanged "SeeBackSeg"
End Property

Private Function Change()
Dim i As Integer, Deb As Long, Fin As Long, Lettre As String, Top As Long, Esp As Long, lar As Long, Ligne As Integer
Cls
If Ctrl_Caption = "" Then Exit Function
UserControl.Appearance = Ctrl_Appearance
UserControl.BorderStyle = Ctrl_BorderStyle
UserControl.BackColor = Ctrl_Back_Color

Fin = VCurrentX(0) - Ctrl_LCDWidth * 0.35 / 2

For i = 1 To Len(Ctrl_Caption)
    Deb = Fin
    Fin = Deb + Ctrl_LCDWidth
    Lettre = Mid(Ctrl_Caption, i, 1)
    
    Esp = 0.18 * (Fin - Deb)
    lar = Fin - Deb - 2 * Esp
    If Lettre = vbCr Then
        Top = Top + 4 * Esp + 2 * lar
        Ligne = Ligne + 1
        Fin = VCurrentX(Ligne) - Ctrl_LCDWidth * 0.35 / 2
        i = i + 1
    Else
        If Ctrl_See_Back_Seg Then Aff_LCD "all", Deb + Ctrl_LCDWidth * 0.35, Fin, Top, Ctrl_Back_Seg
        Aff_LCD TxtToLCD(Lettre), Deb + Ctrl_LCDWidth * 0.35, Fin, Top, Ctrl_Font_Color
    End If
Next i
End Function

Private Function VCurrentX(Ligne As Integer) As Long
Dim Texte() As String

Texte = Split(Ctrl_Caption, vbCrLf)
Select Case Ctrl_AlignementH
    Case 1
        VCurrentX = 0
    Case 2
        VCurrentX = ScaleWidth - Len(Texte(Ligne)) * Ctrl_LCDWidth
    Case 3
        VCurrentX = (ScaleWidth - Len(Texte(Ligne)) * Ctrl_LCDWidth) / 2
End Select
End Function
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (SupraDolph)