openconsole 'IBasic Standard Source To IBasic Pro Source 'Trying to group converting functions into their own subroutines so some of the code may be duplicated in places Def version:String:version="v0.16" 'Updated 6/01/04 version 0.16 'Added conversion of SetID To Const searches through the code and removes @ from constant name 'Added conversion of \ to \\ Code by Boris 'redone gui 'Updated 4/01/04 version 0.15 'Changed to a window 'Removed top buttons you can now grab between the edit controls 'Updated 4/01/04 version 0.14 'Added Append$ conversion 'Added Chr$() conversion for \n \t - \" not working at the moment 'Added automated Groupbox Checkbox selection if it can determine it, ' otherwise a requestor pops up asking you which one it should be 'Added Menu's to GUI 'increased amount of code that can be pasted into Edit Control 'Imcreased memory buffer size 'changed pbuffer to a memory variable 'Updated 2/01/04 version 0.13 'Added Instr support 'Added pasted text converting 'Fancied up the About Dialog (a break from doing the Instr routine :) 'Added changing of &H to 0x 'Updated 01/01/2004 v0.12 'Added ContextMenu conversion 8 hours+ of coding/debugging thought i had learnt something form doing the other menu stuff 'incorporated all menu conversions into one subroutine and removed 200 lines of excess code 'changed the standard source buffer (sbuffer) to a memory var still sbuffer 'now accesses the memory variable as a typecast string #sbuffer 'much much faster loading of the source file doing it this way :) 'modified the ReturnCommand subroutine slightly 'changing to a memory var fixed the 254 char line limitation 'v0.10 First Release 29/12/2003 'Updated 30/12/2003 v0.11 'Fixed Bug in converting Control commands that had a lowercase control identifier 'Improved converting of Control commands now allows for wierd spacing well wierd to me Type tangle Def left:int Def top:int Def right:int Def bottom:int EndType Def rcfill:tangle Declare import,FillRect(hdc:int, lpRect:TANGLE, hBrush:int),int Declare import,SetRect(pRect:TANGLE, X1:int, Y1:int, X2:int, Y2:int),int Declare import,CreateSolidBrush(crColor:int),int Declare import,DeleteObject(hObject:int),int Declare import,GetTickCount(),int TYPE POINTAPI Def x:INT Def y:INT ENDTYPE Type Rec Def l:Int Def t:Int Def w:int Def h:int EndType CONST IDC_SIZEWE = 32644 CONST WM_KILLFOCUS = 0x8 CONST WS_THICKFRAME = 0x40000 CONST SWP_NOSIZE = &H1 CONST SPI_GETWORKAREA = 48 CONST COLOR_BTNFACE = 15 Def d1:Window :' main window Def d2:Window :' about window Def pbuffer:Memory :' Pro source code buffer Def sbuffer:Memory :' define sbuffer as a memory variable Def text[1024]:IString :' text we are working with Def texd[1024]:IString :' temp text we are working with Def myspos,mypos,run,run2:Int :' some useful variables for finding stuff in strings Def changes,nol,count:Int :' number of lines changed Def p,q,r,x,ready,clr:Int Def myfile:File Def mybfile:File Def start,fname,cl,command:String Def short,long,mydate,filter:String Def myspointer,myppointer:Pointer def drag,varW,varH,Left,Top,Width,Height:int def xbo,xb,ybs,ybh,con1xs,con2xw,minshow:int def ArrowCurs,epos:int Declare allocatememory(),Int Declare unhexit(hex:string),Int Declare IMPORT,LoadCursorA(Hinst:int,c:int),int Declare IMPORT,GetSysColor(index:int),int DECLARE "user32.dll", SystemParametersInfo Alias SystemParametersInfoA(uAction:INT, uParam:INT, lpvParam:pointer, fuWinIni:INT),INT Def mypoint:pointapi Def pmypoint:pointer pmypoint=mypoint Def myrect:rec Def mypointer:pointer mypointer=myrect SystemParametersInfo(SPI_GETWORKAREA,0,#mypointer,0) varW=myrect.w varH=myrect.h short="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" :' Month Strings long="January February March April May June July August SeptemberOctober November December " Gosub InitWindowBitsFL :' Some code i got off Fletchie for using progress bar Gosub InitProgressBitsFL :' Some code i got off Fletchie for using progress bar 'GETSCREENSIZE Width,Height filter = "IBasic Files (*.iba)|*.iba||" start = GETSTARTPATH :' startup path FName = "" :' Load and Save FileName cl="\n":'chr$(13)+chr$(10) :' Carriage Return And LineFeed 'xb - split point 'xbo - the original (starting point) 'ybs - y start positon for controls & bar 'ybh - height of controls & bar 'ArrorCurs - flag to say if the arrow cursor is on 'xbo=390 'xb=xbo:ybs=20:ybh=480 xbo=(varW/2)-10 'xb=xbo:ybs=20:ybh=height-180 xb=xbo:ybs=20:ybh=varH-120 'con1xs - start position of 1st control 'con2xw - width (give or take a couple of pixels) of 2nd control 'minshow - the minimum width of a control 'con1xs=8 'con2xw=390 'minshow=60 con1xs=8 'con2xw=(width/2)-4 con2xw=(varW/2)-4 minshow=60 ' old edit flags 0x50B010C4 OpenWindow d1,0,0,varW-300,varH,@MINBOX|@MAXBOX,0,"S2P Convertor "+version,&Handler SETWINDOWCOLOR d1,GetSysColor(COLOR_BTNFACE) CONTROL d1,@richEDIT,"",con1xs,ybs,(xb-con1xs),ybh,@CTEDITMULTI|@CTEDITRETURN|@HSCROLL|@VSCROLL ,1 CONTROL d1,@richEDIT,"",xb+6,ybs,con2xw,ybh,@CTEDITMULTI|@CTEDITRETURN|@HSCROLL|@VSCROLL ,2 'CONTROL d1,@GROUPBOX,"Standard Source",con1xs-5,ybs-20,(xb-con1xs+4),ybh+30,0x50000007,3 'CONTROL d1,@GROUPBOX,"Pro Source",404,34,391,500,0x50000007,4 CONTROL d1,@BUTTON,"Load",con2xw-140,ybh+46,70,20,0x50030000,5 CONTROL d1,@BUTTON,"Save",con2xw+60,ybh+46,70,20,0x50010000,6 CONTROL d1,@BUTTON,"Convert",con2xw-40,ybh+46,70,20,0x50010000,7 'CONTROL d1,@BUTTON,"Spare",246,550,70,20,0x50010000,8 'CONTROL d1,@BUTTON,"Spare",325,550,70,20,0x50010000,9 'CONTROL d1,@BUTTON,">>",6,10,70,20,0x50010000,10 'CONTROL d1,@BUTTON,">><<",366,10,70,20,0x50010000,11 'CONTROL d1,@BUTTON,"<<",725,10,70,20,0x50010000,12 CONTROL d1,@STATIC,"",varW-150,ybh+44,140,20,0|@CTEDITRIGHT,13 CONTROL d1,@STATIC,"Std Source Code",18,0,170,20,0|@CTEDITLeft,14 CONTROL d1,@STATIC,"Pro Source Code",varW-117,0,140,20,0|@CTEDITLeft,15 'CONTROL d1,@RADIOBUTTON,"Convert Pasted Code",140,10,126,20,0x50000009,14 run=1 WaitUntil run=0 closewindow d1 Freemem sbuffer Freemem pbuffer If d2 > 0 Then CloseWindow d2 End Sub Handler(),int Select @CLASS Case @IDSIZE /* IF CONTROLEXISTS(d1,1) :' needed for startup GETCLIENTSIZE d1,Left,Top,varW,varH xbo=(varW/2)-10 xb=xbo:ybs=20:ybh=varH-140 con1xs=8 con2xw=(varW/2)-4 SetSize d1,con1xs,ybs,(xb-con1xs),ybh,1 :' adjust edit control 1 size/position SetSize d1,xb+6,ybs,con2xw-(xb-xbo),ybh,2 :' adjust edit control 2 size/position SetSize d1,8,ybh+44,70,20,5 :' adjust Load Button position SetSize d1,88,ybh+44,70,20,6 :' adjust Save Button position SetSize d1,167,ybh+44,70,20,7 :' adjust Convert Button position SetSize d1,varW-80,ybh+44,70,20,13 :' adjust Output Text position SetSize d1,varW-120,0,140,20,15 :' adjust Pro Source Text position SetSize d1,8,ybh+24,varW-18,10,200 :' adjust Progress Bar size/position EndIf*/ Case @IDCloseWindow run=0 Case @IDCreate CENTERWINDOW d1 'conProgressControl(d1,200,8,ybh+28,varW-18,10,"S") :' create the progress bar 'conSetPCBkgColor(d1,200,rgb(0,0,0)) :' set progress bar background colour 'conSetPCBarColor(d1,200,rgb(255,0,0)) :' set progress bar foreground colour CONTROLCMD d1,1,@RTSETLIMITTEXT,5000000 :' set paste limit to 5000000 bytes CONTROLCMD d1,2,@RTSETLIMITTEXT,5000000 :' set paste limit to 5000000 bytes BeginMenu d1 MenuTitle "&File" MenuItem " &Load", 0 ,1 MenuItem " &Save", 0 ,2 MenuItem " &Quit", 0 ,3 EndMenu BeginInsertMenu d1,2 MenuTitle "Se&ttings" MenuItem "There",0,4 MenuItem " Are",0,5 MenuItem "None!",0,6 MenuItem " Yet",0,7 ' MenuTitle "Se&ttings" ' MenuItem "There",0,4 ' MenuItem " Are",0,5 ' MenuItem "None!",0,6 ' MenuItem " Yet",0,7 EndMenu BeginInsertMenu d1,3 MenuTitle "&Help" ' MenuItem "",0,8 ' MenuItem "",0,9 ' MenuItem "",0,10 MenuItem "About",0,11 EndMenu StartTimer d1,100 :' timer to display about window on startup Case @IDTimer :' need timer otherwise about window opens before main dialog window StopTimer d1 Gosub about Case @IDMENUPICK Select @MENUNUM Case 1 :' load menu Gosub load Case 2 :' save menu Gosub save Case 3 :' quit menu run=0 Case 11 :' about menu Gosub About EndSelect Case @IDCONTROL Select @CONTROLID Case 5 Gosub load Case 6 If #myppointer > "" Then Gosub save Case 7 Gosub convert EndSelect Case @IDLBUTTONDN If @mousex>=xb & @mousex<=(xb+6) & @mousey>=ybs & @mousey<=(ybs+ybh-1) drag=1 'disable controls so we receive @idmousemove messages if moving mouse fast EnableControl d1,1,0 EnableControl d1,2,0 EndIf Case @idlbuttonup if drag=1 drag=0 EnableControl d1,1,1 EnableControl d1,2,1 EndIf Case @idmousemove If @mousex>=xb & @mousex<=(xb+2) & @mousey>=ybs & @mousey<=(ybs+ybh-1) If Not(ArrowCurs) SetCursor d1, @cscustom,LoadCursorA(0,idc_sizewe) ArrowCurs=-1 EndIf Else If ArrowCurs & drag=0 Setcursor d1,@csarrow ArrowCurs=0 EndIf EndIf if drag xb=@mousex If (xb-con1xs) 0 Then Return :' wait for about window to be closed mypos=0:myspos=1:count=0 :' reset all the vars spos is start position mydate=Mid$(Date$,4,3)+Mid$(short,3*val(Left$(Date$,2))-2,3)+Mid$(Date$,6) changes=0 count = CONTROLCMD (d1, 1, @RTGETLINECOUNT) ?count If count=1 MessageBox d1,"No source text","Error":Return EndIf return string outline$ CONTROLCMD (d1, 2, @RTGETLINE, 0, outline$) If Instr(outline$,"Code converted with S2P") MessageBox d1,"Already Converted","Error" Return EndIf string t1="'Code converted with S2P "+version+" on the "+mydate+" at "+Time$+cl+cl nol=CONTROLCMD (d1,1,@EDGETLINECOUNT) :' count the lines in edit control 'Gosub HexConvert:' change &H to 0x count=0 Do :' start of main loop char_index = CONTROLCMD ( d1,1, @RTCHARFROMLINE, count) length = CONTROLCMD (d1,1, @RTGETLINELENGTH, char_index) CONTROLCMD (d1,1, @RTGETLINE, count, text) ?count,char_index,length," ",text mypos=Instr(#myspointer,cl,myspos) :' search for chr$(13)+chr$(10) (cl) text=Mid$(#myspointer,myspos,mypos-myspos) :' put the line into text var myspos=mypos+2 :' set start position past cl ready for next loop Gosub BorisSlashCode :' change \ to \\ tpos=Instr(LTrim$(text)," ") :' find the first space char on line command = Ltrim$(UCase$(Mid$(Ltrim$(text),0,tpos-1))) :' Get the first word on the line x=Instr(UCase$(text),"SETID",1) :' search for SETID If x > 0 Then Gosub SetIdCommand :' go convert SETID x=Instr(UCase$(text),"INSTR",1) :' search for INSTR If x > 0 Then Gosub BorisInstrCode :' go convert INSTR x=Instr(UCase$(text),"APPEND$",1) :' search for APPEND$ If x > 0 Then Gosub AppendCommand :' go convert APPEND$ x=Instr(UCase$(text),"CHR$",1) :' search for CHR$ If x > 0 Then Gosub ChrSCommand :' go convert CHR$ Select command :' check to see if the word is here Case "CONTROL" Gosub ControlCommand changes++ :' increment changes Case "DIALOG" Gosub DialogCommand changes++ :' increment changes Case "WINDOW" Gosub WindowCommand changes++ :' increment changes Case "RETURN" Gosub ReturnCommand changes++ :' increment changes Case "MENU" Gosub MenuCommand changes++ :' increment changes Case "INSERTMENU" Gosub MenuCommand changes++ :' increment changes Case "CONTEXTMENU" Gosub MenuCommand changes++ :' increment changes Case "SETID" changes++ Case "SEARCH" changes++ :' increment changes #myppointer=#myppointer+text+cl Default #myppointer=#myppointer+text+cl :' it's not here so just add the line to #myppointer EndSelect ' If count > 968 & count < 971 Then MessageBox d1,text,"" count++ :' increment the progress bar var SetControlText d1,13,Str$(count) :' debug output Wait 1 Until count = nol #myppointer=#myppointer+cl+"' "+Str$(changes)+" lines converted by S2P "+version+cl SetControlText (d1,2,#myppointer) :' insert #myppointer into edit control SetControlText d1,13,"Completed" MessageBox d1,Str$(changes)+" Lines were converted."+CHR$(10)+" From"+Str$(nol)+" Lines Read","Info" Freemem sbuffer Return EndSub Sub SetIDCommand Int pos1,pos2,ln,pos4:string constant ln=Len(text) pos1=Instr(text,"\"",x+6):pos2=Instr(text,"\"",pos1+1) :' find both quotes If pos1 > x+12 | pos2 = 0 Then Return :' check for quotes text=Left$(text,x-1)+"CONST "+Mid$(text,x+6) :' remove setid from text constant=Mid$(text,pos1+1,pos2-pos1-1) :' constant name text=Left$(text,pos1-1)+constant+Mid$(text,pos2+1) :' remove quotes from text pos1=Instr(text,",",pos2-pos1-1) :' find comma text=Left$(text,pos1-1)+" = "+Mid$(text,pos1+1) :' swap , for = pos1=1 Do pos1=Instr(UCase$(#myspointer),"@"+UCase$(constant),pos1) :' search through sbuffer for constant If pos1 > 0 :' if we find it remove the @ sign #myspointer=Left$(#myspointer,pos1-1)+constant+Mid$(#myspointer,pos1+Len(constant)+1) EndIf Until pos1=0 command="SETID" Return EndSub Sub AppendCommand :' lots of varables not sure if i use them all or not :) Int pos1,pos2,pos3,pos4,spos,epos,a,k,o,c,oo,op,qu String t,p1,p2,p3 : p1="":p2="":p3="" comma=0:o=0:c=0:a=0:oo=0:k=1:qu=0 op=x x=x+6 Do :' start of outer loop Do :' start of inner loop t=Mid$(text,x,1) :' get char after Append$ Select t Case "(" o++ :If oo = 0 then pos1=x+1 oo++ Case ")" c++ :epos=x :' somehow parse through text until we hit a comma Case "," :' and there is one more open than closed brackets If qu = 0 :' if comma is between quotes don't increment a a++ :pos2=x EndIf Case "\"" :' toggle open and closing quotes If qu=0 then qu++ Else qu-- EndSelect x++ Until (o=c+1|o=c) & (a = k) | x > Len(text) :' check for open and closed brackets and comma k++ pos3=pos2+1:spos=pos1-1 text=Left$(text,pos2-1)+"+"+Mid$(text,pos2+1) Until o=c | x > Len(text) :' loop until open and closed brackets are even text=Left$(text,op-1)+Mid$(text,pos1,epos-pos1)+Mid$(text,epos+1) command="SEARCH" :' set command to INSTR for when it returns Return EndSub Sub BorisSlashCode :' thanks for this code Boris Int pos1:pos1=0 text=" "+text:pos1=Instr(text,"\\") While pos1 > 0 If (Mid$(text,pos1-1,1)<>"\\") & (Mid$(text,pos1+1,1)<>"\\") then text=Left$(text,pos1)+"\\"+Mid$(text,pos1+1) pos1=Instr(text,"\\",pos1+2) EndWhile text=Mid$(text,2) command="SEARCH" Return EndSub Sub BorisInstrCode return /*sub Iconv(text:string) def arg$[4]:string:Int pos,pos1,n pos=instr(ucase$(text),"INSTR(") while pos>0 bkt=1:qt=1:argnum=1:for n=1 to 3:arg$[n]="":next n for n=pos+6 to len(text) c$=mid$(text,n,1):arg$[argnum]=arg$[argnum]+c$ if c$="\"" then qt=(qt+1) % 2 else if (c$="(")*qt then bkt=bkt+1 else if (c$=")")*qt then bkt=bkt-1 else if ((c$=",")*qt)&(bkt=1) then argnum=argnum+1 ' if bkt > 0 then next n pos1=n if argnum=3 then text=left$(text,pos+5)+arg$[2]+arg$[3]+","+left$(arg$[1],len(arg$[1])-1)+mid$(text,pos1) pos=instr(ucase$(text),"INSTR(",pos1) endwhile Return*/ EndSub Sub ChrSCommand Def spos,pos,ob,cb,av:Int:pos=0:spos=0:ob=0:cb=0:av=0 Do pos=Instr(UCase$(text),"CHR$",spos) :' find position of CHR$ If pos ob=Instr(text,"(",pos) :' find the open bracket cb=Instr(text,")",pos) :' find the close bracket If ob > 0 & cb > 0 :' check to make sure it's a valid Chr$ av=Val(LTrim$(RTrim$(Mid$(text,ob+1,cb-1)))) :' get the value of the Chr$() Select av :' select the corresponding value then convert the line Case 9 :' tab text=Left$(text,pos-1)+"\"" + "\\t" + "\""+Mid$(text,cb+1) Case 10 :' linefeed text=Left$(text,pos-1)+"\"" + "\\n" + "\""+Mid$(text,cb+1) Case 13 :' carriage return text=Left$(text,pos-1)+"\"" + "\\n" + "\""+Mid$(text,cb+1) ' text=Left$(text,pos-1)+"\"" + "\\r" + "\""+Mid$(text,cb+1) Case 34 :' quote text=Left$(text,pos-1)+"\""+"\\"+"\""+"\""+Mid$(text,cb+1) EndSelect EndIf EndIf spos=pos+1 :' increment start position Until pos=0 :' loop through the line until no more Chr$ command="SEARCH" :' set command to SEARCH for when it returns Return EndSub Sub HexConvert :' convert &H to 0x spos=0 Do pos=Instr(#myspointer,"&H",spos) If pos ##(sbuffer+pos-1)=0x5830 :' 0 ##(sbuffer+pos)=0x5878 :' x changes++ EndIf spos=pos+1 Until pos=0 spos=0 Do pos=Instr(#myspointer,"&h",spos) If pos ##(sbuffer+pos-1)=0x5830 ##(sbuffer+pos)=0x5878 changes++ EndIf spos=pos+1 Until pos=0 Return EndSub Sub InstrCommand Def pos1,pos2,pos3,pos4,spos,epos,a,k,o,c,oo:Int Def t,p1,p2,p3:String:p1="":p2="":p3="" comma=0:o=0:c=0:a=0:oo=0:k=1 x=x+5 Do :' start of outer loop Do :' start of inner loop t=Mid$(text,x,1) :' get char after Instr Select t Case "(" o++ :If oo = 0 then pos1=x+1 oo++ Case ")" c++ :epos=x :' somehow parse through text until we hit a comma Case "," :' and there is one more open than closed brackets a++ :pos2=x EndSelect x++ Until o=c & (a = k) | x > Len(text) :' check for open and closed brackets and comma '(o=c+1|o=c) If a=1 :' if this is the 1st comma get the 1st parameter k++ pos3=pos2+1:spos=pos1-1 p1=Mid$(text,pos1,pos2-pos1) EndIf If a=2 :' if this is the 2nd comma get the 2nd parameter pos4=pos2+1 p2=Mid$(text,pos3,pos2-pos3) EndIf Until o=c | x > Len(text) :' loop until open and closed brackets are even If p2 = "" :' if p2 is null then it was a 2 parameter Instr #myppointer=#myppointer+text+cl :' copy text to #myppointer changes-- :' don't count this as a change Else p3=Mid$(text,pos4,epos-pos4) :' 3 parameter Instr, rearrange paremeters text=Mid$(text,1,spos)+p2+","+p3+","+p1+Mid$(text,epos)+cl EndIf x=Instr(UCase$(text),"INSTR",epos) :' check for any more INSTR in text If x > 0 comma=0:o=0:c=0:a=0:oo=0:p2="":p3="" x=x-8 Gosub InstrCommand :' if there are then loop EndIf command="SEARCH" :' set command to INSTR for when it returns Return EndSub Sub InstrCommandold Def pos1,pos2,pos3,pos4,spos,a,k,o,c,oo:Int Def t,p1,p2,p3:String:p1="":p2="":p3="" pos1=0:pos2=0:pos3=0:pos4=0:comma=0:o=0:c=0:a=0:oo=0:k=1 x=x+5 Do :' start of outer loop Do :' start of inner loop t=Mid$(text,x,1) :' get char after Instr Select t Case "(" o++ :If oo = 0 then pos1=x+1 oo++ Case ")" c++ :epos=x :' somehow parse through text until we hit a comma Case "," :' and there is one more open than closed brackets a++ :pos2=x EndSelect x++ Until (o=c+1|o=c) | (a=k) | x > Len(text) :' check for open and closed brackets and comma If a=1 :' if this is the 1st comma get the 1st parameter k++ pos3=pos2+1:spos=pos1-1 p1=Mid$(text,pos1,pos2-pos1) EndIf If a=2 :' if this is the 2nd comma get the 2nd parameter pos4=pos2+1 p2=Mid$(text,pos3,pos2-pos3) EndIf Until o=c | x > Len(text) :' loop until open and closed brackets are even If p2 = "" :' if p2 is null then it was a 2 parameter Instr changes-- :' don't count this as a change Else p3=Mid$(text,pos4,epos-pos4) :' 3 parameter Instr get the 3rd parameter text=Mid$(text,1,spos)+p2+","+p3+","+p1+Mid$(text,epos)+cl :' rearrange paremeters EndIf x=Instr(UCase$(text),"INSTR",epos) :' check for any more INSTR in text If x > 0 Gosub InstrCommand :' if there are then loop EndIf command="SEARCH" :' set command to INSTR for when it returns Return EndSub Sub MenuCommand Def comma,pos1,pos2,pu,xxx,quote:Int comma=0:pos1=0:pos2=0:pu=0:xxx=0:quote=0 Def ct,tt,dfn:String Select command :' select type of menu converion Case "MENU" comma=Instr(text," ",pos1) :' find the space between Menu and window var pos1=comma+1 comma=Instr(text,",",pos1) :' find the comma after the window var pos2=comma ct=Mid$(text,pos1,pos2-pos1) :' get window var name #myppointer=#myppointer+"\t"+"BeginMenu "+ct+cl :' add Beginmenu and window var name to #myppointer text=Mid$(text,pos2+1) :' remove Menu and win var name from text Case "CONTEXTMENU" comma=Instr(text,"\"",pos1) :' find the first quote pos1=comma-1 ct=Left$(text,pos1) :' get window var name and pos vars comma=Instr(ct,",",0) :' find the first comma pos1=comma+1 comma=Instr(ct,",",pos1) :' find the second comma pos1=comma+1 comma=Instr(ct,",",pos1) :' find the last comma pos1=comma-1 ct=Left$(ct,pos1) :' remove the last comma from ct #myppointer=#myppointer+"\t"+ct+cl :' add ContextMenu and window var name to #myppointer text=Mid$(text,pos1+2) :' remove ContextMenu and win var and pos vars from text Case "INSERTMENU" comma=Instr(text," ",pos1) :' find the space between InsertMenu and window var pos1=comma+1 comma=Instr(text,"\"",pos2) :' find the first quote ct=Mid$(text,pos1,comma-pos1) :' ct=window name and menu number ct=RTrim$(ct):ct=Left$(ct,Len(ct)-1) text=Mid$(text,comma) :' remove InsertMenu and menu number from text #myppointer=#myppointer+"\t"+"BeginInsertMenu "+ct+cl:' add BeginInsertMenu and menu number to #myppointer EndSelect Do :' parse through the definitions comma=0:pos1=0:pos2=0 comma=Instr(text,"\"",pos1) :' find the first quote pos1=comma text=Mid$(text,pos1) :' remove any leading chars before quote from text comma=Instr(text,"\"",2) :' find the second quote pos2=comma If pos1 = 0 | pos2 = 0 :' no more valid definitions #myppointer=#myppointer+"' "+text+cl :' add whats left to #myppointer as a comment text="" :' set text to null Else dfn=Left$(text,pos2) :' get the first definition from text comma=0:pos1=0:pos2=0 comma=Instr(dfn,",") :' find the first comma ct=LTrim$(RTrim$(Mid$(dfn,2,comma-2))) :' get the Menu type comma=Instr(dfn,",",pos1) :' find the next comma pos1=comma+1 comma=Instr(dfn,",",pos1) :' find the next comma pos2=comma tt=Mid$(dfn,pos1,pos2-pos1) :' get menu name If LTrim$(RTrim$(tt))="-" :' check to see if the menu name is a - #myppointer=#myppointer+"\t"+"\t"+"Separator"+cl :' if it is, add Separator to #myppointer ct="" :' set ct to Null so that it isn't found in following select EndIf Select UCase$(ct) Case "T" :' Menu title If pu = 1 :' check to see if we previously started a PopUp menu #myppointer=#myppointer+"\t"+"\t"+"EndPopup"+cl :' if we did add EndPopup to #myppointer pu=0 :' reset pu flag EndIf #myppointer=#myppointer+"\t"+"\t"+"MenuTitle "+"\""+tt+"\""+cl :' add MenuTitle & title text to #myppointer Case "I" :' Menu Item comma=0:pos1=0:pos2=0 :' reset vars comma=Instr(dfn,",",pos1) pos1=comma+1 comma=Instr(dfn,",",pos1) pos2=comma #myppointer=#myppointer+"\t"+"\t"+"MenuItem "+"\""+tt+"\""+Mid$(dfn,pos2,Len(dfn)-pos2)+cl :'add MenuItem & title text to #myppointer Case "S" :' start PopUp Menu pu=1 :' set popup flag #myppointer=#myppointer+"\t"+"BeginPopup "+"\""+tt+"\""+cl :' add BeginPopup & title text to #myppointer Case "^I" :' end popup menu If pu = 1 :' if popup flag set #myppointer=#myppointer+"EndPopup"+cl :' add EndPopUp to #myppointer pu=0 :' reset popup flag EndIf comma=0:pos1=0:pos2=0 :' reset vars comma=Instr(dfn,",",pos1) pos1=comma+1 comma=Instr(dfn,",",pos1) pos2=comma #myppointer=#myppointer+"\t"+"MenuItem "+"\""+tt+"\""+Mid$(dfn,pos2,Len(dfn)-pos2)+cl :' add MenuItem & title text to #myppointer EndSelect If Len(text) >= Len(dfn)+1 text=Mid$(text,Len(dfn)+1) :' remove this definition from text Else text=Mid$(text,Len(dfn)) :' remove this definition from text EndIf EndIf xxx++ :' increment xxx by 1 Until Len(text)=0 | xxx=80 :' if xxx=80 we might be in an endless loop for some reason exit loop :' also limits addmenu mods to 80 in a row If pu = 1 :' if popup flag is still set #myppointer=#myppointer+"\t"+"EndPopup"+cl :' add EndPopUp to #myppointer pu=0 :' reset popup flag EndIf #myppointer=#myppointer+"\t"+"EndMenu"+cl :' add EndMenu to #myppointer Return EndSub Sub ReturnCommand :' check to see if the Return is tabbed or spaced out from left :' or whether there is additional text after the Return statement If Left$(text,1) = Chr$(9) | Left$(text,1) = " " & Len(RTrim$(text)) > 6 #myppointer=#myppointer+text+cl :' probably mid subroutine don't add EndSub after line and add to #myppointer Else #myppointer=#myppointer+text+cl+"EndSub"+cl :' this is up against left edge or is just Return EndIf :' add EndSub after line and add to #myppointer Return EndSub Sub ControlCommand Def comma,pos1,pos2,cnt,flags,c1,c2,x,y:Int:Def z:UInt Def ct,tt,hc:String comma=0:pos1=0:pos2=0:cnt=0:flags=0:c1=0:c2=0:x=0:y=0:z=0 comma=Instr(text,"\"",0) :' find the first quote pos1=comma text=Left$(text,comma-1)+Mid$(text,comma+1) :' remove the quote from text comma=Instr(text,",",pos1) :' find the comma after the control definition pos2=comma:y=comma ct=LTrim$(RTrim$(Mid$(text,pos1,pos2-pos1))) :' get the chars for the control type Select UCase$(ct) :' select the control type were working with Case "B" text=Left$(text,pos1-1)+"@BUTTON"+Mid$(text,pos2) :' replace B with @BUTTON Case "C" :' two Controls with C definition For x = 0 To 5:c1=Instr(text,",",y):y=c1+1:Next x:' attempt auto determination c2=Instr(text,",",y)-1 hc=Mid$(text,y+6,c2-c1-6) z=unhexit(hc) If (z & 7)=7 z=7 Else If (z & 3)=3 z=3 EndIf EndIf If z = 3 | z = 7 :' If we can determine the type Select z Case 3 text=Left$(text,pos1-1)+"@CHECKBOX"+Mid$(text,pos2) :' replace C with @CHECKBOX Case 7 text=Left$(text,pos1-1)+"@GROUPBOX"+Mid$(text,pos2) :' replace C with @GROUPBOX EndSelect Else def msgboxReturn:INT :' ask user which it is msgboxReturn = Messagebox(d1,text+Chr$(10)+Chr$(10)+"Yes for Groupbox, No for Checkbox","Groupbox or CheckBox",3|32) '1=ok 2=cancel 3=abort 4=retry 5=ignore 6=yes 7=no Select msgboxReturn Case 6 text=Left$(text,pos1-1)+"@GROUPBOX"+Mid$(text,pos2) :' replace C with @GROUPBOX Case 7 text=Left$(text,pos1-1)+"@CHECKBOX"+Mid$(text,pos2) :' replace C with @CHECKBOX EndSelect EndIf Case "E" text=Left$(text,pos1-1)+"@EDIT"+Mid$(text,pos2) :' replace E with @EDIT Case "L" text=Left$(text,pos1-1)+"@LISTBOX"+Mid$(text,pos2) :' replace L with @LISTBOX Case "LV" text=Left$(text,pos1-1)+"@LISTVIEW"+Mid$(text,pos2) :' replace LV with @LISTVIEW Case "M" text=Left$(text,pos1-1)+"@COMBOBOX"+Mid$(text,pos2) :' replace M with @COMBOBOX Case "R" text=Left$(text,pos1-1)+"@RADIOBUTTON"+Mid$(text,pos2) :' replace R with @RADIOBUTTON Case "RE" text=Left$(text,pos1-1)+"@RICHEDIT"+Mid$(text,pos2) :' replace RE with @RICHEDIT Case "S" text=Left$(text,pos1-1)+"@SCROLLBAR"+Mid$(text,pos2) :' replace S with @SCROLLBAR Case "SW" text=Left$(text,pos1-1)+"@STATUS"+Mid$(text,pos2) :' replace SW with @STATUS Case "T" text=Left$(text,pos1-1)+"@STATIC"+Mid$(text,pos2) :' replace T with @STATIC EndSelect comma=Instr(text,",",pos1) :' find the comma before the control text pos1=comma+1 comma=Instr(text,",",pos1) :' find the comma after the control text pos2=comma ct=Mid$(text,pos1,pos2-pos1) :' ct = the control text text=Left$(text,pos1-1)+"\""+ct+"\""+Mid$(text,pos2) :' put ct between two quotes text=RTrim$(text) :' remove any spaces from end of text If Right$(text,1) = "\"" :' if the last char is a quote remove it (quick fix) text = Left$(text,Len(text)-1) :' remove the quote Else :' have to find it, probably comments at the end of line pos1=Instr(text,"\"",pos2+3) :' search for the quote at the end of the definition If pos1 :' found it! text=Left$(text,pos1-1)+Mid$(text,pos1+1) :' remove the quote EndIf EndIf 'if count > 1697 Then messagebox d1,Str$(Len(#myppointer)),"" #myppointer=#myppointer+text+cl :' put the modified text into #myppointer 'if count > 1697 Then messagebox d1,"SECOND","" Return EndSub Sub DialogCommand Def q,s,t,x,pos1,pos2:Int pos1=1:q=0:s=0 Do temp=Mid$(text,pos1,1) pos1++ If temp = Chr$(9) Then t++ If temp = " " Then s++ Until temp <> Chr$(9) & temp <> " " temp="" If t > 0 For x = 1 To q:temp=temp+Chr$(9):Next x EndIf temp=temp+Space$(s) text=LTrim$(text) text=temp+"CreateDialog"+Mid$(text,7) pos1=0:pos2=0 For t = 0 To 7 pos1=Instr(text,",",pos2) pos2=pos1+1 Next t text=Left$(text,pos1)+"&"+Mid$(text,pos2) #myppointer=#myppointer+text+cl Return EndSub Sub WindowCommand Def q,s,t,x,pos1,pos2:Int pos1=1:q=0:s=0 Do temp=Mid$(text,pos1,1) pos1++ If temp = Chr$(9) Then t++ If temp = " " Then s++ Until temp <> Chr$(9) & temp <> " " temp="" If t > 0 For x = 1 To q:temp=temp+Chr$(9):Next x EndIf temp=temp+Space$(s) text=LTrim$(text) text=temp+"OpenWindow"+Mid$(text,7) pos1=0:pos2=0 For t = 0 To 7 pos1=Instr(text,",",pos2) pos2=pos1+1 Next t text=Left$(text,pos1)+"&"+Mid$(text,pos2) #myppointer=#myppointer+text+cl Return EndSub Sub allocatememory() If AllocMem (sbuffer,5000000,1) = -1 :' allocate 200k of memory MessageBox d1,"Free some memory and try again","Error" Return -1 EndIf If AllocMem (pbuffer,5000000,1) = -1 :' allocate 200k of memory MessageBox d1,"Free some memory and try again","Error" Return -1 EndIf myspointer=sbuffer :' set myspointer to memory vaiable myppointer=pbuffer :' set myspointer to memory vaiable Return 0 EndSub Sub load If run2 <> 0 Then Return FName = FILEREQUEST ("Select IBasic Standard Source File",0,1,filter,"iba",0,start) If FName = "" Then Return :' if load is cancelled then return If allocatememory()=-1 Then Return IF(OPENFILE(mybfile,FName,"R") = 0) SetControlText d1,1,"":SetControlText d1,2,"" :' clear both edit controls CONTROLCMD (d1, 1, @RTLOAD, mybfile, 0) 'conSetPCPos(d1,200,0) :' set the progress bar back to 0 'Read(mybfile,sbuffer) :' read file into memory variable ?'sbuffer cLOSEFILE mybfile 'SetControlText (d1,1,#myspointer) :' insert the code into the edit control 'FreeMem sbuffer SetControlText d1,13,"Ready" 'Gosub getpath :' put the path into start variable Else MESSAGEBOX d1,"Error opening "+FName+" file for reading.","Error" EndIf Return EndSub Sub Save If run2 <> 0 Then Return FName = FILEREQUEST ("Save Pro Source File",0,0,filter,"iba",0,start) If FName = "" Then Return IF(OPENFILE(myfile,FName,"W") = 0) Write(myfile,#myppointer) CLOSEFILE myfile Else MESSAGEBOX d1,"Error saving "+FName,"Error" EndIf Return EndSub Sub getpath :' grab the path and stick it in start variable def t: string def i,p: int i=len(FName) p=0 WHILE t<>"\\" i--:p++ t=Mid$(FName,i,1) ENDWHILE start=Left$(FName,Len(FName)-p) RETURN EndSub Sub About Def cid,t:Int:p=120:q=140:r=170 OpenWindow d2,0,0,320,140,0x80C80080|@TOPMOST,d1,"About",&aboutHandler Control d2,@STATIC,"IBasic Standard To Pro Convertor "+version,8,p,300,20,0x50000101,1 Control d2,@STATIC,"Brought to you by ibDevGroup",8,q,300,20,0x50000101,2 Control d2,@STATIC,"ibDevGroup Home Page",8,r,300,20,0x50000101,3 ' SETWINDOWCOLOR d2,RGB(255,255,255) For t = 1 To 2:SetControlColor d2,t,0,RGB(255,255,255):Next t SetControlColor d2,3,RGB(0,0,255),RGB(255,255,255) StartTimer d2,10:nol=0:run2=1 WaitUntil run2=0 CloseWindow d2 Return EndSub SUB abouthandler(),int Select @CLASS Case @IDTimer If nol < 100 Setsize d2,8,p-nol,300,20,1 Setsize d2,8,q-nol,300,20,2 Setsize d2,8,r-nol,300,20,3 nol++ Else StopTimer d1 EndIf Case @idcontrol If @controlid = 3 Then System "http://ibdev.hytext.com/" Case @IDCLOSEWINDOW StopTimer d1 run2=0 Case @IDCreate CENTERWINDOW d2 EndSelect Return 0 EndSub sub unhexit(hex:string) def n:uint n=0 mul=1 if len(hex)>0 for t=len(hex) to 1 step -1 n=n+(instr("0123456789ABCDEF",ucase$(mid$(hex,t,1)))-1)*mul mul=mul*16 next t EndIf return n EndSub '------ Component Part ----- Code Supplied by Fletchie ------------------- sub InitWindowBitsFL declare "user32",CreateWindowExA(dwexstyle:int,lpclassname:string,lpwindowname:string,dwstyle:int,x:int,y:int,nwidth:int,nheight:int,hwndparent:int,hmenu:int,hinstance:int,lpparam:int),int declare "user32",GetDlgItem(hwnd:int,cid:int),int declare "user32",SendMessageA(w:int,m:int,wp:int,p:int),int declare "comctl32",InitCommonControlsEx(c:a) declare conNewControl(par:pointer,cid:uint,clas:string,x:int,y:int,w:int,h:int,st:uint,ex:uint) declare conGetWin(par:pointer,cid:int),Int declare conSM(par:pointer,cid:int,m:int,wp:int,lp:int),Int setid "idcontextmenu",0x7b type a def a:int def b:int endtype def fred:a fred.a=8 fred.b=0x800 InitCommonControlsEx(fred) Return EndSub sub InitProgressBitsFL 'declare conProgressControl(par:pointer,cid:uint,x:int,y:int,w:int,h:int,style:string) 'declare conSetPCRange(par:pointer,cid:int,min:int,max:int) 'declare conSetPCPos(par:pointer,cid:int,pos:int) 'declare conSetPCBkgColor(par:pointer,cid:int,col:int) 'declare conSetPCBarColor(par:pointer,cid:int,col:int) Return EndSub sub conProgressControl(par:pointer,cid:uint,x:int,y:int,w:int,h:int,style:string) if instr(ucase$(style),"S") then st=1 if instr(ucase$(style),"V") then st=st|4 ConNewControl(par,cid,"msctls_progress32",x,y,w,h,st,0) Return EndSub sub conNewControl(par:pointer,cid:uint,clas:string,x:int,y:int,w:int,h:int,st:uint,ex:uint) def stx,hnd:int ex=ex|512 stx=0x10000000|0x40000000|st hnd=CreateWindowExA(ex|4,clas,"",stx,x,y,w,h,#par,cid+2024,0,0) Return EndSub '---------------------------------------------------------------------- sub conSetPCRange(par:pointer,cid:int,min:int,max:int) SendMessageA(conGetWin(par,cid),0x401,0,min+max*65536) Return EndSub '---------------------------------------------------------------------- sub conSetPCPos(par:pointer,cid:int,pos:int) SendMessageA(ConGetWin(par,cid),0x402,pos,0) Return EndSub '---------------------------------------------------------------------- sub conSetPCBarColor(par:pointer,cid:int,col:int) conSM(par,cid,0x409,0,col) Return EndSub '---------------------------------------------------------------------- sub conSetPCBkgColor(par:pointer,cid:int,col:int) conSM(par,cid,0x2001,0,col) Return EndSub sub conGetWin(par:pointer,cid:int) Return GetDlgItem(par,cid+2024) EndSub sub conSM(par:pointer,cid:int,m:int,wp:int,lp:int) Return SendMessageA(ConGetWin(par,cid),m,wp,lp) EndSub