[Gambas-user] COBOL and how great it was!

[Fabien Bodard]

' Gambas module file

Public Sub Main()

   Dim sPatternTitle As String = "$$L3!!$$AC,L10!!&1$$L5,AC!!
$$L15,AC,D3!!&2$$L5!!$$L8,AC!!&3"
  Dim sFilledPattern As String =
"$$L3!!$$AC,L10,F-!!$$L5,AC!!|$$L15,F-!!$$L5!!$$L8,F-!!"
  Dim sPattern As String =
"$$L3!!->$$AC,L10!!&1$$L5,AC!!|$$L15,AL!!&2$$L5,AC!!|$$L8,AF,D3!!&3"
  Dim i As Integer

  ''Format patern
  '$$ -> start Format
  'L# -> Lenght
  'A# -> L,R,C,F Alignment
  'F# -> One letter filling
  'C# -> Decimal letter ... '.' or ',' or else
  'D# -> number of decimal
  '!! endof formating string

  'ex : $$L10,AC!!text$$L2!!$$L8,AF,D3!!2.536

  Print MakeLine(Subst(sPatternTitle, "Date", "Test", "Value"))
  Print MakeLine(sFilledPattern)
  For i = 1 To 10

  Print MakeLine(Subst(sPattern, Format(Now(), "dd/mm/yyy"), "Maurice", "2.52"))
  Print MakeLine(Subst(sPattern, Format(Now(), "dd/mm/yyy"), "Marcel",
"23.535"))
  Next
End


Public Sub MakeLine(sLine As String) As String


  Dim sPattern, sText As String
  Dim iSta, iEnd As Integer
  Dim sRet As String
  Dim s As String
  Dim sSingle As String
  Dim sAling, sFill As String
  Dim sDecChar As String
  Dim iDec As Integer = 2
  'Find the next opened pattern
  iSta = InStr(sLine, "$$") + 1
  Do
  iEnd = InStr(sLine, "!!", iSta + 1) - 1

  sPattern = sLine[iSta, iEnd - iSta]
  iSta = InStr(sLine, "$$", iEnd) + 1
  If iSta = 1 Then
    sText = sLine[iEnd + 2, sLine.Len - (iEnd + 2)]
  Else
    sText = sLine[iEnd + 2, iSta - 2 - (iEnd + 2)]
  Endif

  For Each s In Split(sPattern)
    Select Case Left(s)
      Case "L"
        sSingle = String(Val(Right(s, -1)), " ")
      Case "A"
        sAling = Right(s, -1)
      Case "F"
        sFill = Right(s, -1)
      Case "C"
        sDecChar = Right(s, -1)
      Case "D"
        iDec = Right(s, -1)
    End Select
  Next
   If sFill Then
     sSingle = String(sSingle.Len, sFill)
     sFill = ""
   Endif
  If sText.Len > sSingle.Len Then sText = Left(stext, sSingle.Len)
  Select Case sAling
    Case "L"
      Mid(sSingle, 1, stext.Len) = sText
    Case "R"
      Mid(sSingle, sSingle.Len - sText.Len + 1, stext.Len) = sText
    Case "C"
      Mid(sSingle, (sSingle.len - sText.Len) / 2 + 1, stext.Len) = stext
    Case "F"
      If Not sDecChar Then sDecChar = "."
       stext = stext & String(Max(0, iDec - (stext.len - (InStr(stext,
sDecChar)))), " ")
       Mid(sSingle, sSingle.Len - sText.Len + 1, stext.Len) = sText
    Case Else
      Mid(sSingle, 1, stext.Len) = sText
  End Select

  sRet &= sSingle
  sSingle = ""
  sAling = 0
  sDecChar = ""
  iDec = 2
  If iSta = 1 Then Break
  Loop
  'Analyse du pattern

  Return sRet

End


Enjoy it :-)