Productique tournage

Télécharger le projet
Commenter

Description

Voila mon programme permet de créer un programme ISO de tournage.
Dedans il y'a des controles utilisateurs style xp et une gestion de la memoire.
Son peut utiliser une richtextbox autrement merci dme le signaler.

Source / Exemple : 


Petite partie du code :

Public Sub CreateCodeISO(Dec As Integer, AffiCoul As Integer, tAffiNom As Integer, tAffiNumBloc As Integer, tAffiComm As Integer, Comm As Integer, SautLigne As Integer)
'Fonction qui crée le programme ISO

Dim strTemp As String
Dim strTemp2 As String
Dim strTemp3 As String
Dim strTemp4 As String
Dim intTemp As Integer
Dim intTemp2 As Integer
Dim intTemp3 As Integer
Dim intTemp4 As Integer
Dim intTemp5 As Integer
Dim comptBloc As Integer
Dim comptLigne As Integer
Dim tabTemp() As String

If AffiCoul = 0 Then
    AffiNom = 0
    AffiNumBloc = 0
    AffiComm = 0
Else
    AffiNom = tAffiNom
    AffiNumBloc = tAffiNumBloc
    AffiComm = tAffiComm
End If

strTemp3 = "\f1\par}"
comptBloc = 2
comptLigne = 0
intTemp4 = 0
If Dec = 1 Then intTemp4 = 7

With frmCodeISO.CodeISO
    .TextRTF = ""
    intTemp = 0
    If AffiNom = 1 Then intTemp = 1
    strTemp = "{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 " & optPolice & ";}{\f1\fswiss\fcharset0 Arial;}}{\colortbl ;\red128\green0\blue128;\red128\green0\blue0;\red0\green0\blue0;\red0\green0\blue128;}{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\cf" & intTemp & "\lang1036\f0\fs20 " & NomProgramme & "\cf0\par"
    intTemp = 0
    If AffiNumBloc = 1 Then intTemp = 2
    strTemp = strTemp & "\cf" & intTemp & Space(intTemp4) & " N10\cf0  G0 G52 X0 Z0 M9 G40 G80\cf2\par"
    For b = 1 To NbrCycles
        intTemp3 = tabNomCycles(b, 2) - tabNomCycles(b, 1)
        intTemp = 0
        intTemp2 = 0
        If AffiNumBloc = 1 Then intTemp = 2
        If AffiComm = 1 Then intTemp2 = 4
        strTemp2 = ""
        If SautLigne = 1 Then strTemp2 = "\par "
        strTemp2 = strTemp2 & "\cf" & intTemp & Space(intTemp4) & " N" & comptBloc * 10 & "\cf0  " & tabProgramme(comptLigne)
        If Comm = 1 Then strTemp2 = strTemp2 & " \cf" & intTemp2 & "   ( " & tabNomCycles(b, 0) & " )"
        strTemp2 = strTemp2 & "\par"
        strTemp = strTemp & strTemp2
        For c = tabNomCycles(b, 1) + 1 To tabNomCycles(b, 2)
            comptBloc = comptBloc + 1
            intTemp = 0
            intTemp2 = 0
            If AffiNumBloc = 1 Then intTemp = 2
            If AffiComm = 1 Then intTemp2 = 4
            strTemp4 = tabProgramme(c)
            If Left(strTemp4, 1) = "@" Then
                strTemp4 = Right(strTemp4, Len(strTemp4) - 1)
                Select Case Left(strTemp4, 3) 'Fonctions spéciales
                    Case "G79"
                        intTemp5 = Right(strTemp4, Len(strTemp4) - 3)
                        strTemp4 = "G79 N" & (comptBloc + intTemp5 + 1) * 10
                    Case "G64"
                        tabTemp = Split(strTemp4, "/")
                        intTemp5 = tabTemp(4)
                        strTemp4 = "G64 N" & (comptBloc - intTemp5) * 10 & " N" & (comptBloc - 1) * 10 & " I" & tabTemp(1) & " K" & tabTemp(2) & " F" & tabTemp(3)
                    Case "G77"
                        tabTemp = Split(strTemp4, "/")
                        strTemp4 = "G77"
                        For d = 1 To UBound(tabTemp)
                            intTemp5 = tabTemp(d)
                            strTemp4 = strTemp4 & " N" & (comptBloc + intTemp5) * 10
                        Next d
                End Select
            End If
            strTemp = strTemp & "\cf" & intTemp & Space(intTemp4) & " N" & comptBloc * 10 & "\cf0  " & strTemp4 & "\cf" & intTemp2 & "  \par"
        Next c
        comptLigne = comptLigne + intTemp3 + 1
        comptBloc = comptBloc + 1
    Next b
    If SautLigne = 1 Then strTemp = strTemp & "\par "
    intTemp = 0
    If AffiNumBloc = 1 Then intTemp = 2
    strTemp = strTemp & "\cf" & intTemp & Space(intTemp4) & " N" & (DerniereLigneProg + 2) * 10 & "\cf0  M2\par"
    .TextRTF = strTemp & strTemp3
End With
End Sub

Conclusion :


Mise a jour prévue pour le filtage bientot, ou si qq est motive pour le continuer (prévenez moi ^^).
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 (cs_NeoUmbrella)