Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

FRM2DDT - Convert VB5/6 .frm form files to DDT-based PBDLL .bas format

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • FRM2DDT - Convert VB5/6 .frm form files to DDT-based PBDLL .bas format

    usage: simply use visual basic to create a form (eg. testform.frm) with some controls on it, save the form, then run frm2ddt.exe testform.frm
    testform.bas will be created, which is the pbdll ddt version of the vb form. size and location are accurate to within 2 pixels.
    tested with vb6, but should also work with vb5

    Code:
    'frm2ddt.bas
    'frm2ddt: vb6 frm -> pbdll6 bas convertor v1.0
    'converts visual basic .frm files to ddt-based pbdll .bas format
    'by wayne diamond, updated may 15 2001
     
    #compile exe "frm2ddt.exe"  'pbdll
    #include "win32api.inc"
    global thefile as string
    global xobject as string
    global xdepth as integer
    global vbobject as string, vbname as string
    global vbleft as string, vbtop as string
    global vbheight as string, vbwidth as string
    global vbtext as string
    global vbmaxlength as string
    global vbborderstyle as string
    global vbexstyle as string
    global masterform as string
    global styles as string
    global currentcontrol as integer
    %addcomments = 1    '1 = add comments to generated code, 0 = dont add comments
     
    sub resetvbvars
     vbleft = "0"
     vbtop = "0"
     vbwidth = "0"
     vbheight = "0"
     vbexstyle = "
     vbtext = chr$(34) & chr$(34)
     vbmaxlength = "
    end sub
     
    sub convertform(xfile as asciiz)
    on error resume next
    local tempstr$
    currentcontrol = 100
    open xfile for input as #1
    open left$(thefile, len(thefile) - 4) & ".ba~" for output as #2
     print #2, "function winmain (byval hcurinstance as long, _" & chr$(13) & chr$(10) & _
               "                  byval hprevinstance as long, _"  & chr$(13) & chr$(10) & _
               "                  lpcmdline as asciiz, _"  & chr$(13) & chr$(10) & _
               "                  byval ncmdshow as long) as long"  & chr$(13) & chr$(10)
     dim nextline$
     dim j1&
     do until eof(1)
        nextline$ = "
        line input #1, nextline$
        if nextline$ = " or left$(nextline$,3) = "end" then exit do
        nextline$ = trim$(nextline$)
        if left$(nextline$,14) = "begin vb.form " then
           call resetvbvars
           vbobject = "form"
           vbname = trim$(right$(nextline$, len(nextline$) - 14))
           masterform = vbname
        elseif left$(nextline$,9) = "begin vb." then
           if vbobject <> " then call xsaveobject
           ! inc currentcontrol
           j1& = instr(3, nextline$, "=")
           call resetvbvars
           vbobject = trim$(ucase$(mid$(nextline$,10,j1& - 10)))
           vbname = trim$(right$(nextline$, len(nextline$) - j1&))
           if instr(1,vbobject," ") > 0 then vbobject = left$(vbobject,instr(1,vbobject, " ")-1)
           if vbobject = "commandbutton" then vbobject = "button"
           if vbobject = "optionbutton" then vbobject = "option"
           if vbobject = "vscrollbar" then vbobject = "scrollbar"
           if vbobject = "hscrollbar" then vbobject = "scrollbar"
           if vbobject = "picturebox" then vbobject = "image"
           if vbobject = "image" then
              vbexstyle = ", , %ws_ex_clientedge"  '%ss_sunken"
           else
              vbexstyle = "
           end if
        elseif left$(nextline$, 4) = "top " or left$(nextline$, 10) = "clienttop " then
           j1& = instr(3, nextline$, "=")
           vbtop = trim$(right$(nextline$, len(nextline$) - j1&))
           xv## = val(vbtop)
           xv## = cint((xv## + 24) / 24) - 1
           vbtop = str$(xv##)
        elseif left$(nextline$, 5) = "left " or left$(nextline$, 11) = "clientleft " then
           j1& = instr(3, nextline$, "=")
           vbleft = trim$(right$(nextline$, len(nextline$) - j1&))
           xv## = val(vbleft)
           xv## = cint((xv## + 24) / 24) - 1
           vbleft = str$(xv##)
        elseif left$(nextline$, 7) = "height " or left$(nextline$, 13) = "clientheight "  or left$(nextline$, 12) = "scaleheight " then
           j1& = instr(3, nextline$, "=")
           vbheight = trim$(right$(nextline$, len(nextline$) - j1&))
           xv## = val(vbheight)
           xv## = cint((xv## + 24) / 24) - 1
           if vbobject = "form" then xv## = xv## + 1
           vbheight = str$(xv##)
        elseif left$(nextline$, 6) = "width " or left$(nextline$, 12) = "clientwidth " or left$(nextline$, 11) = "scalewidth " then
           j1& = instr(3, nextline$, "=")
           vbwidth = trim$(right$(nextline$, len(nextline$) - j1&))
           xv## = val(vbwidth)
           xv## = cint((xv## + 24) / 24) - 1
           if vbobject = "form" then xv## = xv## + 1
           vbwidth = str$(xv##)
        elseif left$(nextline$, 8) = "caption " or left$(nextline$, 5) = "text " then
           j1& = instr(3, nextline$, "=")
           vbtext = trim$(right$(nextline$, len(nextline$) - j1&))
        elseif left$(nextline$, 10) = "maxlength " or left$(nextline$, 10) = "maxlength " then
           j1& = instr(3, nextline$, "=")
           vbmaxlength = trim$(right$(nextline$, len(nextline$) - j1&))
           styles = styles & "control send " & masterform & ", " & trim$(str$(currentcontrol)) & ", %em_limittext, " & trim$(vbmaxlength) & ", 0"
           if %addcomments = 1 then styles = styles & " 'set max length to " & trim$(vbmaxlength)
           styles = styles & $crlf
        elseif left$(nextline$, 12) = "borderstyle " then
           j1& = instr(3, nextline$, "=")
           tempstr$ = trim$(right$(nextline$, len(nextline$) - j1&))
           tempstr$ = left$(tempstr$,1)
           if tempstr$ = "0" then
              vbexstyle = "
           else
              vbexstyle = ", , %ws_ex_clientedge"
           end if
           'vbborderstyle
           'vbexstyle
        end if
     loop
    close #1
    if vbobject <> " then call xsaveobject
    if right$(styles,2) = $crlf then styles = left$(styles, len(styles) - 2)
    if styles <> " then
       if %addcomments = 1 then print #2, "'// extended styles for " & ucase$(masterform)
       print #2, styles
    end if
    if masterform <> " then print #2, "dialog show modal " & masterform ' & ", call wndproc to showform"  'modal " & masterform & " to showform"
    print #2, "end function"
    print #2, "
    close #2
    close #5
    open left$(thefile, len(thefile) - 4) & ".ba~" for input as #5
    open left$(thefile, len(thefile) - 4) & ".bas" for output as #6
     print #6, "'// generated " & time$ & " " & date$ & " by frm2ddt"
     print #6, "'// original vb source: " & xfile & crlf$
     print #6, "#compile exe"
     print #6, "#include " & chr$(34) & "win32api.inc" & chr$(34)
     do until eof(5)
      line input #5, nextline$
      print #6, nextline$
     loop
    close #5
    close #6
    kill left$(thefile, len(thefile) - 4) & ".ba~"
    end sub
     
    sub xsaveobject
    on error resume next
      if vbobject = "form" then
         print #2, "local " & masterform & " as long" & $crlf
         if %addcomments = 1 then print #2, "'// controls for " & ucase$(masterform)
         print #2, "dialog new 0, " & vbtext & ", " & vbleft & ", " & vbtop & ", " & vbwidth & ", " & vbheight & ", %ds_modalframe or %ws_caption or  %ws_sysmenu or %ds_center to " & masterform
      else
         print #2, "control add " & ucase$(vbobject) & ", " & masterform & ", " & trim$(str$(currentcontrol)) & ", " &  vbtext  & ", " & vbleft & ", " &  vbtop & ", "  & vbwidth & ", " & vbheight & vbexstyle
          ' & ", 0 " 'call ctrl" & ucase$(vbname) & "
      end if
    end sub
     
    function winmain (byval hcurinstance as long, _
                      byval hprevinstance as long, _
                      lpcmdline as asciiz, _
                      byval ncmdshow as long) as long
    dim nextline$
    if lpcmdline = " then
       msgbox "usage: frm2ddt.exe vbform.frm",%mb_ok + %mb_iconinformation, "frm2ddt"
       exit function
    elseif dir$(lpcmdline) = " then
       msgbox lpcmdline & " doesn't exist!",%mb_ok + %mb_iconinformation, "frm2ddt"
       exit function
    end if
    open lpcmdline for binary access read lock shared as #1
    if lof(1) < 20 then
       close #1
       msgbox "form file is too small to be a vb form file!",%mb_ok + %mb_iconinformation, "frm2ddt"
       exit function
    end if
    close #1
    xdepth = 0
    open lpcmdline for input as #1
     line input #1, nextline$
    close #1
     if left$(ucase$(nextline$),9) = "version 5" or _
        left$(ucase$(nextline$),9) = "version 6" then
     else
        msgbox "form file is not a version 5/6 form!",%mb_ok + %mb_iconinformation, "frm2ddt"
        exit function
     end if
     thefile = lpcmdline
     call convertform(lpcmdline)
     msgbox "conversion complete!",%mb_ok + %mb_iconinformation, "frm2ddt"
    end function
    apologies for the lack of comments in the code - this is meant only as a developers tool, not source code you'd learn anything from

    for feedback on frm2ddt, please post only to this thread:
    http://www.powerbasic.com/support/pb...ead.php?t=3729


    [this message has been edited by wayne diamond (edited may 14, 2001).]
    -

  • #2
    Wayne,
    Congratulations! This is an excellent idea, and it actually did the translation the first time I tried it. So far (after 5 minutes) I discovered two problems:
    1. Listboxes are translated with a empty string as placeholder where the optional array should be
    2. The Menu Add String translates as CONTROL ADD MENU.

    Peter Redei

    ------------------

    Comment

    Working...
    X