Example 3 - Setting variable values and displaying them in date format in zenon

Requirement:

A date should be saved in a doubleword process variable.

e.g.: 990305 (year, month, day)

First we have to create a macro, which opens frmDateSet.

With the object obElem we search for the variable linked to the clicked element.

Public Sub LeftClickUp_DateSet (obElem As Element)
Dim i As Integer
For i = 0 To obElem.CountVariable - 1
frmDateSet.cmbVariables.AddItem obElem.ItemVariable (i). Name
Next i
frmDateSet.cmbVariables.Text = frmDateSet.cmbVariables.List (0)
frmDateSet.Show
End Sub

The variable name now is written to a combobox of frmDateSet, so the change event of the combobox cmbVariables is triggered.

Info

The value (e.g. 000304) stands for the date (00-03-03), but in the variable only the value 304 is saved.

Therefore as many zeros are added to the value, until the value has six digits. (000304)

Now the six digit value is split (00, 03, 04) and sent to the text fields.

Private Sub cmbVariables_Change ()
'get value from variable, write value in textboxes
Dim obVariable As Variable
Dim strValue As String
Set obVariable = thisProject.Variables.Item (cmbVariables.Text)
'variable exists
If obVariable Is Nothing Then
Exit Sub
End If
strValue = obVariable.Value
Do Until Len (strValue) = 6
strValue = 0 + strValue
Loop
tbYear.Value = Left $( strValue , 2 )
tbMonth.Value = Mid $( strValue , 3 , 2 )
tbDay.Value = Right $( strValue , 2 )
tbYear.SetFocus
tbYear.SelStart = 0
tbYear.SelLength = Len ( tbYear.Text )
End Sub

'Die folgende Prozedur schließt das Fenster.
Private Sub cmdExit _ Click ()
Unload Me
End Sub

By clicking the set button the entered date value is written to the variable.

But before this is done, it is checked, if this date is possible.

(e.g.: 99-02-31 - this input is not correct, there is no February 31st)

Private Sub cmdSet _ Click ()
'Check input date if it is possible, and write value to variable
Dim obVariable As Variable
Dim MyDate As Date
Dim NextDate As Date
Dim strNextMonth As String
Dim strNextYear As String
Dim intCountDays As Integer

Set obVariable = thisProject . Variables.Item ( cmbVariables.Text )

'variable exists
If obVariable Is Nothing Then
Exit Sub
End If

If tbYear.Text = Or tbMonth.Text = Or tbDay.Text = Then
MsgBox ( Bitte geben Sie ein Datum ein !)
tbYear.SetFocus
tbYear.SelStart = 0
tbYear.SelLength = Len ( tbYear.Text )
Exit Sub
End If

MyDate = 1 +.+ tbMonth.Text +.+ tbYear.Text
strNextMonth = Val ( tbMonth.Text ) + 1
If strNextMonth = 13 Then
strNextYear = Val ( tbYear.Text ) + 1
strNextYear = Right $( strNextYear , 2 )
strNextMonth = 1
Else
strNextYear = tbYear.Text
End If

NextDate = 1 +.+ strNextMonth +.+ strNextYear
intCountDays = NextDate - MyDate
If tbDay.Value > intCountDays Then
MsgBox ( Dieser Monat hat nur & intCountDays )
tbDay.Value = intCountDays
tbDay.SetFocus
tbDay.SelStart = 0
tbDay.SelLength = Len ( tbDay.Text )
Exit Sub
End If
obVariable.Value = tbYear.Text + tbMonth.Text + tbDay.Text
Unload Me
End Sub

In the text field tbDay only values between 0 and 31 can be entered.

Private Sub tbDay _ Change ()
'Check inserted value, whether it is between 0 and 31

Dim obVariable As Variable
Dim bIsNum As Boolean
Dim strValue As String

Set obVariable = thisProject.Variables.Item ( cmbVariables.Text )
strValue = obVariable.Value

If tbDay.Text Like [ 0 - 9 ]* Then
bIsNum = True
Else
bIsNum = False

If bIsNum = False Then
tbDay.Text =

If tbDay.Value = Then Exit Sub

If tbDay.Value < 0 Or tbDay > 31 Then
MsgBox ( Bitte nur Werte zwischen 1 u.31 eingeben )
tbDay.Value = Right $( strValue , 2 )
tbDay.SetFocus
tbDay.SelStart = 0
tbDay.SelLength = Len ( tbDay.Text )
Exit Sub
End If

If Len ( tbDay.Text ) = 2 Then
cmdSet.SetFocus
End If
End Sub

On leaving the text field a leading 0 is added, if the entry has only one digit. (e.g.: 5 becomes 05)

Private Sub tbDay _ Exit ( ByVal Cancel As MSForms.ReturnBoolean )
If Len ( tbDay.Value ) = 1 Then
tbDay.Value = 0 + tbDay.Value
End If
End Sub

In the text field tbMonth only values between 1 and 12 can be entered.

Private Sub tbMonth _ Change ()
'Check inserted value, whether it is between 1 and 12
Dim obVariable As Variable
Dim bIsNum As Boolean
Dim strValue As String

Set obVariable = thisProject.Variables.Item ( cmbVariables.Text )
strValue = obVariable.Value

If tbMonth.Text Like [ 0 - 9 ]* Then
bIsNum = True
Else
bIsNum = False

If bIsNum = False Then tbMonth.Value =

If tbMonth.Value = Then Exit Sub
If tbMonth.Value < 0 Or tbMonth.Value > 12 Then
MsgBox ( Bitte nur Werte zwischen 1 u.12 eingeben )
tbMonth.Value = Mid $( strValue , 3 , 2 )
tbMonth.SetFocus
tbMonth.SelStart = 0
tbMonth.SelLength = Len ( tbMonth.Text )
Exit Sub
End If

If Len ( tbMonth.Text ) = 2 Then
tbDay.SetFocus
tbDay.SelStart = 0
tbDay.SelLength = Len ( tbMonth.Text )
End If
End Sub

Also on leaving the text field month a zero is added in front of a one digit value.

Private Sub tbMonth _ Exit (ByVal Cancel As MSForms.ReturnBoolean)
If Len ( tbMonth.Value ) = 1 Then
tbMonth.Value = 0 + tbMonth.Value
End If
End Sub

Private Sub tbYear _ Change ()
Dim bIsNum As Boolean

If tbYear.Value = Then Exit Sub
If tbYear.Text Like [ 0 - 9 ]* Then
bIsNum = True
Else
bIsNum = False
If bIsNum = False Then
tbYear.Text =
If Len (tbYear.Text) = 2 Then
tbMonth.SetFocus
tbMonth.SetFocus
tbMonth.SelStart = 0
tbMonth.SelLength = Len (tbMonth.Text)
End If
End Sub

Now that the input of a date is possible, the value of the variable has to be displayed as a date (YY-MM-DD) in the according element.

For this we create the new macro Drw_Date.

Draw_Date is executed on each redraw of the element.

First the according variable is determined from the selected element.

The background and text color of the element is determined.

Then a rectangle is drawn over the element with the draw object. (i.e. the original value no longer is visible)

Now the value of the variable is split and newly combined with a separator (-).

e.g.: 990430 = 99-04-30

The TextOut function writes the value to the rectangle.

Public Sub Draw_Date (obElem As Element , ByVal hdc As OLE_HANDLE )
Dim obDraw As Draw
Dim obVariable As Variable
Dim intCenter As Integer
Dim strValue As String

On Error Resume Next
obElem.Draw hdc

'variable from element
Set obVariable = obElem.ItemVariable (0)
Set obDraw = obElem.DrawApi

'set backgroundcolor
obDraw.SetBkColor hdc , obElem.BackColor

'set textcolor
obDraw.SetTextColor hdc , obElem.ForeColor

'Rectangle
obDraw.FillSolidRect hdc , obElem.Left + 10 , obElem.Top + 10 ,

(obElem.Right - obElem.Left) - 20 , (obElem.Bottom - obElem.Top) - 20 ,
obElem.BackColor
intCenter = obElem.Right - obElem.Left
intCenter = intCenter / 2 - 20
strValue = obVariable.Value
Do Until Len ( strValue ) = 6
strValue = 0 + strValue
Loop
strValue = Left $( strValue , 2 ) + - + Mid $( strValue , 3 , 2 ) + - +
Right $( strValue , 2 )

'write time to element
obDraw.TextOut hdc , obElem.Left + intCenter , obElem.Top + 10 , strValue
End Sub