text cleanup

Begin Dialog dlgClear 16,35,260,190,"ColumnClearing", .Enable
PushButton 20,158,60,20, "Ok", .ok 'PB1
PushButton 180,159,60,20, "Abort", .abbruch 'PB2
Text 10,10,200,8, "This script create in the file (1) a new column (3),"
Text 10,20,200,8, "which contains the content from charColumn (2) but was"
Text 10,30,200,8, "prepared as specified"
Text 10,50,270,8, "1. Choose File:"
DropListBox 10,60,240,80, aFileName(), .DrpList1
Text 10,80,270,8, "2. Choose char column:"
DropListBox 10,90,240,80, aColumnName(), .DrpList2
Text 10,105,240,8, "________________________________________________________________________________"
Text 10,120,200,8, "3. New column:"
Text 10,130,100,8, "New ColumnNname:"
TextBox 10,140,104,10, .TextBox1
Text 150,130,100,8, "New ColumnLength"
TextBox 150,140,20,10, .TextBox2
End Dialog
Dim sFileName As String
Dim sColumnName As String
Dim sTargetColumn As String
Dim sTargetColumnLength As String

Sub Main
Dim button As Integer
Dim v As Integer

v = 0

Do
Dim Dlg0 As dlgClear
button = Dialog(Dlg0)

If button = 2 Then
Exit Sub
ElseIf button = 0 Then
Exit Sub
End If

sTargetColumn = iupper(dlg0.TextBox1)
sTargetColumnLength = dlg0.TextBox2

If IsNumeric(sTargetColumnLength) = False Then
MsgBox "There is not a numeric value inserted for attribute length (no 3) ."&Chr(13)&"Please correct this.",0,"Hint"
Else
If sTargetColumnLength > 500 Then
MsgBox "The length value is to long."&Chr(13)&"Length must be <= 500.",0,"Hint"
dlg0.TextBox2 = ""
Else
If iIsBlank(sTargetColumn) = 1 And iIsBlank(sTargetColumnLength) = 1 And button = 1 Then
MsgBox "You have not filled out a new ColumnName."&Chr(13)& _
"Please insert a new ColumnName."&Chr(13)&Chr(13)& _
"Formatting rules for the new ColumnName" &Chr(13)& _
"- Length of ColumnName not longer than 20 characters." &Chr(13)& _
"- Use only letters, numbers and underline" &Chr(13)& _
"- First character is not a number value" &Chr(13)& _
"- Use no spaces in the new ColumnName" &Chr(13)& _
"- Do not use special characters",0,"Hint"
ElseIf iIsBlank(sTargetColumn) = 1 And iIsBlank(sTargetColumnLength) = 0 And button = 1 Then
MsgBox "You have not used a new ColumnName."&Chr(13)& _
"Please insert a new ColumnName."&Chr(13)&Chr(13)& _
"Formatting rules for the new ColumnName (no 3):" &Chr(13)& _
"- Length of ColumnName not longer than 20 characters." &Chr(13)& _
"- Use only letters, numbers and underline" &Chr(13)& _
"- First character is not a number value" &Chr(13)& _
"- Use no spaces in the new ColumnName" &Chr(13)& _
"- Do not use special characters",0,"Hint"
ElseIf iIsBlank(iRegExpr(sTargetColumn, "^[a-zA-Z]+[a-zA-Z0-9_]*$")) = 1 Then
MsgBox "The new ColumnName is not allowed to have special characters, spaces, leading numbers."&Chr(13)& _
"Please insert a new ColumnName."&Chr(13)&Chr(13)& _
"Formatting rules for the new ColumnName (no 3):" &Chr(13)& _
"- Length of ColumnName not longer than 20 characters." &Chr(13)& _
"- Use only letters, numbers and underline" &Chr(13)& _
"- First character is not a number value" &Chr(13)& _
"- Use no spaces in the new ColumnName" &Chr(13)& _
"- Do not use special characters",0,"Hint"
ElseIf Len(sTargetColumn) > 20 Then
MsgBox "The new ColumnName ist longer than 20 characters."&Chr(13)& _
"Please insert a new ColumnName."&Chr(13)&Chr(13)& _
"Formatting rules for the new ColumnName (no 3):" &Chr(13)& _
"- Length of ColumnName not longer than 20 characters." &Chr(13)& _
"- Use only letters, numbers and underline" &Chr(13)& _
"- First character is not a number value" &Chr(13)& _
"- Use no spaces in the new ColumnName" &Chr(13)& _
"- Do not use special characters",0,"Hint"
ElseIf iIsBlank(sTargetColumn) = 0 And iIsBlank(sTargetColumnLength) = 1 And button = 1 Then
MsgBox "You have not give a new ColumnLength."&Chr(13)&"Please insert a ColumnLength for the new column.",0,"Hint"
Else
If IsNumeric(sTargetColumnLength) = False Then
MsgBox "The ColumnLength you have inserted is not numeric."&Chr(13)&"Please insert a numeric ColumnLength.",0,"Hint"
Else
v = 1
End If
End If
End If
End If

Loop Until v = 1 And button = 1

sub_clearing

MsgBox "The clearing for the column "& sColumnName &" from file "& sFileName &" was done."&Chr(13)& _
"The File "& sFileName &" now contains the new column "& iUpper(sTargetColumn) &"."& Chr(13) & Chr(13),"","Hint"
End Sub

Function Enable(ControlID$, Action%, SuppValue%)

Select Case Action%
Case 1
sub_fileName_read
DlgListBoxArray "DrpList1", aFileName()
sFileName = aFileName(0)
sub_charColumns_read
DlgListBoxArray "DrpList2", aColumnName()
sColumnName = aColumnName(0)

Case 2
If ControlID$ = "drpList1" Then
sFileName = aFileName(SuppValue%)
sub_charColumns_read
DlgListBoxArray "DrpList2", aColumnName()
sColumnName = aColumnName(0)
End If

If ControlID$ = "drpList2" Then
sColumnName = aColumnName(SuppValue%)
End If
End Select

End Function

Sub sub_fileName_read
Dim s As String

s = Dir(Client.WorkingDirectory + "*.imd")
ReDim aFileName(0)

While iIsBlank(s) = 0
aFileName(UBound(aFileName)) = s
s = Dir
If iIsBlank(s) = 0 Then
ReDim preserve aFileName(UBound(aFileName)+1)
End If
Wend

End Sub

Sub sub_charColumns_read

Dim n As Integer
Dim i As Integer
Dim nSpaltenanzahl As Integer

Set db = Client.OpenDatabase(Client.WorkingDirectory + sFileName)
Set table = db.TableDef
nSpaltenanzahl = table.count
ReDim aColumnName(0)
n = 0
For i = 1 To nSpaltenanzahl

Set field = table.GetFieldAt(i)
If field.IsCharacter() = true Then
If n > 0 Then
ReDim preserve aColumnName(UBound(aColumnName)+1)
End If
aColumnName(UBound(aColumnName)) = field.name
n=n+1
End If
Next
db.Close
End Sub

Sub sub_clearing

Dim sFormula As String
Dim eqn As String

'very simple formula...
sFormula = "@mid(@UPPER(" + sColumnName + "); 1; "+sTargetColumnLength+") "

Set db = Client.OpenDatabase (Client.WorkingDirectory + sFileName)

Set table = db.TableDef
Set field = table.NewField

eqn = sFormula
field.Name = sTargetColumn

field.Description = "new Field from example_ColumnClearing.iss"
field.Type = WI_VIRT_CHAR
field.Equation = eqn

field.Length = sTargetColumnLength
table.AppendField field

db.Close

Set db = Nothing
Set task = Nothing
Set field = Nothing

End Sub