├── .gitignore ├── C-To-Delphi-0.9.0.png ├── C2Delphi.Forms.Main.dfm ├── C2Delphi.Forms.Main.pas ├── C2Delphi.dpr ├── C2Delphi.dproj ├── LICENSE ├── README.md ├── Releases ├── C2Delphi-0.9.0.zip ├── C2Delphi-0.9.1.zip └── C2Delphi-0.9.2.zip ├── Test ├── C2DelphiTests.dpr ├── C2DelphiTests.dproj ├── C2DelphiTests.res ├── Test.CReader.pas └── Win32 │ └── Debug │ └── dunitx-results.xml ├── WvN.Pascal.CReader.pas └── WvN.Pascal.Model.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /C-To-Delphi-0.9.0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/6658bfb38e8d37e4d2e9f42c845cd30412930b37/C-To-Delphi-0.9.0.png -------------------------------------------------------------------------------- /C2Delphi.Forms.Main.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'C to Delphi' 5 | ClientHeight = 834 6 | ClientWidth = 1184 7 | Color = clBtnFace 8 | DoubleBuffered = True 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | ShowHint = True 17 | OnClose = FormClose 18 | OnCreate = FormCreate 19 | OnDestroy = FormDestroy 20 | PixelsPerInch = 96 21 | TextHeight = 13 22 | object Splitter1: TSplitter 23 | Left = 777 24 | Top = 21 25 | Width = 8 26 | Height = 672 27 | ResizeStyle = rsUpdate 28 | ExplicitLeft = 1009 29 | ExplicitTop = 77 30 | ExplicitHeight = 671 31 | end 32 | object Splitter2: TSplitter 33 | Left = 241 34 | Top = 21 35 | Width = 8 36 | Height = 672 37 | ResizeStyle = rsUpdate 38 | ExplicitLeft = 162 39 | ExplicitTop = -11 40 | ExplicitHeight = 887 41 | end 42 | object Splitter3: TSplitter 43 | Left = 0 44 | Top = 710 45 | Width = 1184 46 | Height = 8 47 | Cursor = crVSplit 48 | Align = alBottom 49 | ResizeStyle = rsUpdate 50 | ExplicitLeft = 8 51 | ExplicitTop = 939 52 | ExplicitWidth = 1778 53 | end 54 | object SearchBox1: TSearchBox 55 | Left = 0 56 | Top = 0 57 | Width = 1184 58 | Height = 21 59 | Align = alTop 60 | TabOrder = 0 61 | TextHint = 'Search' 62 | OnChange = SearchBox1Change 63 | end 64 | object TreeView1: TTreeView 65 | Left = 0 66 | Top = 21 67 | Width = 241 68 | Height = 672 69 | Align = alLeft 70 | HideSelection = False 71 | Indent = 19 72 | ParentShowHint = False 73 | ReadOnly = True 74 | RowSelect = True 75 | ShowHint = True 76 | ShowRoot = False 77 | TabOrder = 1 78 | OnChange = TreeView1Change 79 | OnCustomDrawItem = TreeView1CustomDrawItem 80 | end 81 | object ListBox1: TListBox 82 | Left = 0 83 | Top = 718 84 | Width = 1184 85 | Height = 97 86 | Align = alBottom 87 | ItemHeight = 13 88 | TabOrder = 2 89 | OnDblClick = ListBox1DblClick 90 | end 91 | object StatusBar1: TStatusBar 92 | Left = 0 93 | Top = 815 94 | Width = 1184 95 | Height = 19 96 | Panels = < 97 | item 98 | Width = 50 99 | end 100 | item 101 | Width = 100 102 | end 103 | item 104 | Width = 500 105 | end 106 | item 107 | Width = 50 108 | end 109 | item 110 | Width = 50 111 | end> 112 | end 113 | object ProgressBar1: TProgressBar 114 | Left = 0 115 | Top = 693 116 | Width = 1184 117 | Height = 17 118 | Align = alBottom 119 | Smooth = True 120 | MarqueeInterval = 2 121 | TabOrder = 4 122 | end 123 | object Panel1: TPanel 124 | Left = 249 125 | Top = 21 126 | Width = 528 127 | Height = 672 128 | Align = alLeft 129 | BevelOuter = bvNone 130 | TabOrder = 5 131 | object StatusBar3: TStatusBar 132 | Left = 0 133 | Top = 653 134 | Width = 528 135 | Height = 19 136 | Panels = < 137 | item 138 | Width = 80 139 | end 140 | item 141 | Width = 50 142 | end> 143 | end 144 | object edCCode: TSynEdit 145 | Left = 0 146 | Top = 0 147 | Width = 528 148 | Height = 653 149 | Align = alClient 150 | Color = 2238503 151 | Font.Charset = DEFAULT_CHARSET 152 | Font.Color = clWindowText 153 | Font.Height = -13 154 | Font.Name = 'Courier New' 155 | Font.Style = [] 156 | TabOrder = 1 157 | OnClick = edCCodeSelectionChanged 158 | Gutter.Font.Charset = DEFAULT_CHARSET 159 | Gutter.Font.Color = clWindowText 160 | Gutter.Font.Height = -11 161 | Gutter.Font.Name = 'Courier New' 162 | Gutter.Font.Style = [] 163 | Gutter.Visible = False 164 | Gutter.Width = 0 165 | Highlighter = SynCppSyn1 166 | Lines.Strings = ( 167 | 'edCCode') 168 | Options = [eoAltSetsColumnMode, eoAutoIndent, eoDragDropEditing, eoEnhanceEndKey, eoGroupUndo, eoScrollPastEol, eoShowScrollHint, eoSmartTabDelete, eoSmartTabs, eoTabsToSpaces] 169 | RightEdge = 0 170 | OnChange = edCCodeChange 171 | OnSpecialLineColors = edCCodeSpecialLineColors 172 | FontSmoothing = fsmNone 173 | ExplicitWidth = 312 174 | end 175 | end 176 | object Panel2: TPanel 177 | Left = 785 178 | Top = 21 179 | Width = 399 180 | Height = 672 181 | Align = alClient 182 | BevelOuter = bvNone 183 | TabOrder = 6 184 | object StatusBar2: TStatusBar 185 | Left = 0 186 | Top = 653 187 | Width = 399 188 | Height = 19 189 | Panels = < 190 | item 191 | Width = 80 192 | end 193 | item 194 | Width = 50 195 | end> 196 | end 197 | object edPascalCode: TSynEdit 198 | Left = 0 199 | Top = 0 200 | Width = 399 201 | Height = 653 202 | Align = alClient 203 | Color = 2238503 204 | Font.Charset = DEFAULT_CHARSET 205 | Font.Color = clWindowText 206 | Font.Height = -13 207 | Font.Name = 'Courier New' 208 | Font.Style = [] 209 | TabOrder = 1 210 | OnClick = edPascalCodeClick 211 | Gutter.Font.Charset = DEFAULT_CHARSET 212 | Gutter.Font.Color = clWindowText 213 | Gutter.Font.Height = -11 214 | Gutter.Font.Name = 'Courier New' 215 | Gutter.Font.Style = [] 216 | Gutter.Visible = False 217 | Gutter.Width = 0 218 | Highlighter = SynPasSyn1 219 | Lines.Strings = ( 220 | 'syndt1') 221 | Options = [eoAltSetsColumnMode, eoAutoIndent, eoDragDropEditing, eoEnhanceEndKey, eoGroupUndo, eoScrollPastEol, eoShowScrollHint, eoSmartTabDelete, eoSmartTabs, eoTabsToSpaces] 222 | RightEdge = 0 223 | OnSpecialLineColors = edPascalCodeSpecialLineColors 224 | FontSmoothing = fsmNone 225 | end 226 | end 227 | object ActionManager1: TActionManager 228 | Left = 368 229 | Top = 256 230 | StyleName = 'Platform Default' 231 | object Action1: TAction 232 | Caption = '&Save' 233 | ShortCut = 16467 234 | OnExecute = Action1Execute 235 | end 236 | object actRun: TAction 237 | Caption = 'Run' 238 | ShortCut = 120 239 | OnExecute = actRunExecute 240 | end 241 | end 242 | object PopupMenu1: TPopupMenu 243 | Left = 992 244 | Top = 448 245 | object Run1: TMenuItem 246 | Action = actRun 247 | end 248 | end 249 | object ApplicationEvents1: TApplicationEvents 250 | OnException = ApplicationEvents1Exception 251 | OnHint = ApplicationEvents1Hint 252 | Left = 448 253 | Top = 352 254 | end 255 | object SynCppSyn1: TSynCppSyn 256 | Options.AutoDetectEnabled = False 257 | Options.AutoDetectLineLimit = 0 258 | Options.Visible = False 259 | AsmAttri.Background = clBlack 260 | AsmAttri.Foreground = clLime 261 | CommentAttri.Background = 2238503 262 | CommentAttri.Foreground = 9671571 263 | IdentifierAttri.Foreground = clSilver 264 | KeyAttri.Foreground = 7481081 265 | NumberAttri.Foreground = 16744878 266 | HexAttri.Foreground = 16744878 267 | OctalAttri.Foreground = 16744878 268 | StringAttri.Foreground = 7658470 269 | CharAttri.Foreground = clLime 270 | Left = 464 271 | Top = 192 272 | end 273 | object SynPasSyn1: TSynPasSyn 274 | Options.AutoDetectEnabled = False 275 | Options.AutoDetectLineLimit = 0 276 | Options.Visible = False 277 | AsmAttri.Background = clBlack 278 | AsmAttri.Foreground = clLime 279 | CommentAttri.Background = 2238503 280 | CommentAttri.Foreground = 9671571 281 | IdentifierAttri.Foreground = clSilver 282 | KeyAttri.Foreground = 7481081 283 | NumberAttri.Foreground = 16744878 284 | HexAttri.Foreground = 16744878 285 | StringAttri.Foreground = 7658470 286 | CharAttri.Foreground = clLime 287 | Left = 912 288 | Top = 160 289 | end 290 | end 291 | -------------------------------------------------------------------------------- /C2Delphi.Forms.Main.pas: -------------------------------------------------------------------------------- 1 | unit C2Delphi.Forms.Main; 2 | 3 | interface 4 | 5 | {.$DEFINE USE_DELPHIAST} 6 | {.$DEFINE USE_DWS} 7 | 8 | uses 9 | Winapi.Windows, 10 | Winapi.Messages, 11 | 12 | System.SysUtils, 13 | System.Variants, 14 | System.Classes, 15 | System.Actions, 16 | 17 | 18 | Vcl.Forms, 19 | Vcl.Dialogs, 20 | Vcl.Graphics, 21 | Vcl.Controls, 22 | Vcl.ExtCtrls, 23 | Vcl.StdCtrls, 24 | Vcl.WinXCtrls, 25 | Vcl.ComCtrls, 26 | Vcl.ActnList, 27 | Vcl.PlatformDefaultStyleActnCtrls, 28 | Vcl.ActnMan, 29 | Vcl.Menus, 30 | 31 | Vcl.Styles.Hooks, 32 | Threading, 33 | SynEditKeyCmds, 34 | 35 | {$IFDEF USE_DELPHIAST} 36 | DelphiAST, 37 | DelphiAST.Consts, 38 | DelphiAST.Classes, 39 | {$ENDIF} 40 | 41 | {$IFDEF USE_DWS} 42 | dwsComp, 43 | dwsExprs, 44 | dwsStringResult, 45 | {$ENDIF} 46 | 47 | WvN.Pascal.Model, 48 | WvN.Pascal.CReader, Vcl.AppEvnts, 49 | SynHighlighterPas, SynEditHighlighter, SynHighlighterCpp, SynEdit, 50 | 51 | Vcl.Themes 52 | 53 | ; 54 | 55 | 56 | const 57 | AppName='C to Delphi'; 58 | 59 | type 60 | TfrmMain = class(TForm) 61 | Splitter1: TSplitter; 62 | SearchBox1: TSearchBox; 63 | TreeView1: TTreeView; 64 | Splitter2: TSplitter; 65 | ActionManager1: TActionManager; 66 | Action1: TAction; 67 | actRun: TAction; 68 | Splitter3: TSplitter; 69 | ListBox1: TListBox; 70 | StatusBar1: TStatusBar; 71 | PopupMenu1: TPopupMenu; 72 | Run1: TMenuItem; 73 | ProgressBar1: TProgressBar; 74 | ApplicationEvents1: TApplicationEvents; 75 | Panel1: TPanel; 76 | Panel2: TPanel; 77 | StatusBar2: TStatusBar; 78 | StatusBar3: TStatusBar; 79 | edCCode: TSynEdit; 80 | edPascalCode: TSynEdit; 81 | SynCppSyn1: TSynCppSyn; 82 | SynPasSyn1: TSynPasSyn; 83 | procedure FormCreate(Sender: TObject); 84 | procedure edCCodeSelectionChanged(Sender: TObject); 85 | procedure edCCodeChange(Sender:TObject); 86 | procedure SearchBox1Change(Sender: TObject); 87 | procedure TreeView1Change(Sender: TObject; Node: TTreeNode); 88 | procedure Action1Execute(Sender: TObject); 89 | procedure actRunExecute(Sender: TObject); 90 | procedure edPascalCodeCaretChanged(ASender: TObject; X, Y: Integer); 91 | procedure edCCodeCaretChanged(ASender: TObject; X, Y: Integer); 92 | procedure ListBox1DblClick(Sender: TObject); 93 | procedure edPascalCodeChange(Sender: TObject); 94 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 95 | procedure ApplicationEvents1Hint(Sender: TObject); 96 | procedure ApplicationEvents1Exception(Sender: TObject; E: Exception); 97 | procedure FormDestroy(Sender: TObject); 98 | procedure edPascalCodeClick(Sender: TObject); 99 | procedure edCCodeSpecialLineColors(Sender: TObject; Line: Integer; 100 | var Special: Boolean; var FG, BG: TColor); 101 | procedure edPascalCodeSpecialLineColors(Sender: TObject; Line: Integer; 102 | var Special: Boolean; var FG, BG: TColor); 103 | procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; 104 | Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); 105 | private 106 | procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES; 107 | procedure UpdateTree; 108 | procedure ShowElement(Sender:TObject; el: TPascalElement); 109 | function ReadCCodeFromFile(cfn: string):string; 110 | procedure GetRangeSource(const sl: TStrings; e: TPascalElement; out p1,p2: TBufferCoord); 111 | procedure GetRangeRender(const sl: TStrings; e: TPascalElement; out p1,p2: TBufferCoord); 112 | procedure FindParent(var e: TPascalElement); 113 | public 114 | e:TPascalElement; 115 | CFileName:string; 116 | Pas:WvN.Pascal.Model.TPascalUnit; 117 | 118 | {$IFDEF USE_DWS} 119 | dws : TDelphiWebScript; 120 | prog : IdwsProgram; 121 | exec : IdwsProgramExecution; 122 | {$ENDIF} 123 | 124 | {$IFDEF USE_DELPHIAST} 125 | ex : ESyntaxTreeException; 126 | {$ENDIF} 127 | task:ITask; 128 | procedure Run; 129 | end; 130 | 131 | var 132 | frmMain: TfrmMain; 133 | 134 | implementation 135 | 136 | {$R *.dfm} 137 | 138 | uses ShellAPI, Math, System.IOUtils, dwsErrors, 139 | System.Diagnostics, 140 | RegularExpressions 141 | ; 142 | 143 | 144 | {$IFDEF USE_DELPHIAST} 145 | function Parse(const FileName: string;var ex:ESyntaxTreeException): string; 146 | var 147 | SyntaxTree: TSyntaxNode; 148 | begin 149 | try 150 | ex := nil; 151 | SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False); 152 | SyntaxTree.Free; 153 | Result := 'Pascal syntax OK'; 154 | except 155 | on E: ESyntaxTreeException do 156 | begin 157 | Result := Format('[%d, %d] %s', [E.Line, E.Col, E.Message]); 158 | ex := E; 159 | end; 160 | end; 161 | end; 162 | {$ENDIF} 163 | 164 | 165 | function getPosition(const sl:TStrings; Offset:Integer):TBufferCoord; 166 | var 167 | I,n: Integer; 168 | const lineEndSize=length(sLineBreak); 169 | begin 170 | n := 0; 171 | for I := 0 to sl.Count-1 do 172 | begin 173 | if (n + sl[I].Length + lineEndSize) > offset then 174 | begin 175 | Result.Line := I; 176 | Result.Char := Offset - n; 177 | Exit; 178 | end; 179 | n := n + sl[I].Length + lineEndSize; 180 | end; 181 | Result.Line := 0; 182 | Result.Char := 0; 183 | end; 184 | 185 | 186 | procedure TfrmMain.edCCodeSelectionChanged(Sender: TObject); 187 | var c,t:string; 188 | begin 189 | if edCCode.SelLength=0 then 190 | begin 191 | edCCodeCaretChanged(edCCode, edCCode.CaretX, edCCode.CaretY); 192 | Exit; 193 | end; 194 | 195 | c := edCCode.SelText; 196 | pas := TPascalUnit.Create(nil); 197 | 198 | c_to_pas(c,t,pas.Name, 199 | procedure(progress:double;const text:string) 200 | begin 201 | TThread.Synchronize(TThread.CurrentThread, 202 | procedure 203 | begin 204 | ProgressBar1.Position := round(Progress * 100); 205 | Statusbar1.Panels[2].Text := round(Progress * 100).toString+'% '+ Text; 206 | if ListBox1.Count>0 then 207 | ListBox1.Perform(lb_SetTopIndex,ListBox1.Count-1,0); 208 | end); 209 | end, 210 | Pas); 211 | UpdateTree; 212 | 213 | edPascalCode.Text := pas.toPascal; 214 | end; 215 | 216 | procedure TfrmMain.edCCodeSpecialLineColors(Sender: TObject; Line: Integer; 217 | var Special: Boolean; var FG, BG: TColor); 218 | var p1,p2:TBufferCoord; 219 | begin 220 | if e=nil then 221 | Exit; 222 | 223 | if e.Sourceinfo.Position>edCCode.Text.Length then 224 | Exit; 225 | 226 | if e.Sourceinfo.Position<0 then 227 | Exit; 228 | 229 | p1 := getPosition( edCCode.Lines, e.Sourceinfo.Position); 230 | p2 := getPosition( edCCode.Lines, e.Sourceinfo.Position + e.Sourceinfo.Length ); 231 | if InRange(Line, p1.Line, p2.Line) then 232 | begin 233 | Special := False; 234 | BG := edCCode.Color + $111111; 235 | end; 236 | 237 | end; 238 | 239 | procedure TfrmMain.GetRangeSource(const sl: TStrings; e: TPascalElement; out p1,p2: TBufferCoord); 240 | begin 241 | p1 := getPosition(sl, e.Sourceinfo.Position); 242 | p2 := getPosition(sl, e.Sourceinfo.Position + e.Sourceinfo.Length); 243 | end; 244 | 245 | procedure TfrmMain.GetRangeRender(const sl: TStrings; e: TPascalElement; out p1,p2: TBufferCoord); 246 | begin 247 | p1 := getPosition(sl, e.Renderinfo.Position); 248 | p2 := getPosition(sl, e.Renderinfo.Position + e.Renderinfo.Length); 249 | end; 250 | 251 | 252 | procedure TfrmMain.edPascalCodeCaretChanged(ASender: TObject; X, Y: Integer); 253 | var c:TClassdef;e:TPascalElement; 254 | p1,p2:TBufferCoord; 255 | begin 256 | StatusBar2.Panels[0].Text := Format('[Line:%d,Col%d]', [Y,X]); 257 | if pas=nil then 258 | Exit; 259 | 260 | 261 | for c in pas.Classes do 262 | for e in c.FMethods do 263 | begin 264 | GetRangeRender(edPascalCode.Lines, e, p1, p2); 265 | if InRange(Y,p1.Line, p2.Line) then 266 | begin 267 | ShowElement(ASender,e); 268 | edCCode.Refresh; 269 | Exit; 270 | end; 271 | end; 272 | 273 | for e in pas.GlobalArrays1D do 274 | begin 275 | GetRangeRender(edPascalCode.Lines, e, p1, p2); 276 | if InRange(Y,p1.Line, p2.Line) then 277 | begin 278 | ShowElement(ASender,e); 279 | edCCode.Refresh; 280 | Exit; 281 | end; 282 | end; 283 | 284 | for e in pas.GlobalArrays2D do 285 | begin 286 | GetRangeRender(edPascalCode.Lines, e, p1, p2); 287 | if InRange(Y,p1.Line, p2.Line) then 288 | begin 289 | ShowElement(ASender,e); 290 | edCCode.Refresh; 291 | Exit; 292 | end; 293 | end; 294 | 295 | for e in pas.Classes do 296 | begin 297 | GetRangeRender(edPascalCode.Lines, e, p1, p2); 298 | if InRange(Y,p1.Line, p2.Line) then 299 | begin 300 | ShowElement(ASender,e); 301 | edCCode.Refresh; 302 | Exit; 303 | end; 304 | end; 305 | 306 | end; 307 | 308 | procedure TfrmMain.edPascalCodeChange(Sender: TObject); 309 | {$IFDEF USE_DELPHIAST} 310 | var fn,t:string; 311 | {$ENDIF} 312 | begin 313 | {$IFDEF USE_DELPHIAST} 314 | fn := TPath.Combine(TPath.GetTempPath, Pas.Name+'_tmp.pas'); 315 | edPascalCode.Lines.SaveToFile(fn); 316 | t := Parse(fn,ex); 317 | ListBox1.Items.Add(t); 318 | TFile.Delete(fn); 319 | {$ENDIF} 320 | end; 321 | 322 | 323 | procedure TfrmMain.edPascalCodeClick(Sender: TObject); 324 | begin 325 | edPascalCodeCaretChanged(edPascalCode, edPascalCode.CaretX, edPascalCode.CaretY); 326 | end; 327 | 328 | procedure TfrmMain.edPascalCodeSpecialLineColors(Sender: TObject; 329 | Line: Integer; var Special: Boolean; var FG, BG: TColor); 330 | var p1,p2:TBufferCoord; 331 | begin 332 | if e=nil then 333 | Exit; 334 | 335 | p1 := getPosition( edPascalCode.Lines, e.Renderinfo.Position); 336 | p2 := getPosition( edPascalCode.Lines, e.Renderinfo.Position + e.Renderinfo.Length ); 337 | if InRange(Line, p1.Line, p2.Line) then 338 | begin 339 | Special := False; 340 | BG := edPascalCode.Color + $111111; 341 | end; 342 | 343 | end; 344 | 345 | procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); 346 | begin 347 | if Assigned(Task) then 348 | Task.Cancel; 349 | Task.Wait(1); 350 | 351 | end; 352 | 353 | procedure TfrmMain.FormCreate(Sender: TObject); 354 | begin 355 | TStyleManager.Engine.RegisterStyleHook(TCustomSynEdit, TScrollingStyleHook); 356 | 357 | {$IFDEF USE_DWS} 358 | dws:=TDelphiWebScript.Create(nil); 359 | {$ENDIF} 360 | CFileName := ''; 361 | edCCode.Color := $00222827; 362 | edCCode.Text := 363 | 'void hello(int x){'+sLineBreak+ 364 | ' printf("Hello world %d\n",x);'+sLineBreak+ 365 | '}'+sLineBreak+ 366 | ''+sLineBreak+ 367 | '/* '+sLineBreak+ 368 | ' Multiline'+sLineBreak+ 369 | ' Comment'+sLineBreak+ 370 | '*/ '+sLineBreak+ 371 | 'int main(){'+sLineBreak+ 372 | ' for(int i=0;i<=10;i++){'+sLineBreak+ 373 | ' hello(i);'+sLineBreak+ 374 | ' } '+sLineBreak+ 375 | '}' 376 | ; 377 | 378 | 379 | DragAcceptFiles( Handle, True ) ; 380 | edCCodeChange(nil); 381 | end; 382 | 383 | procedure TfrmMain.FormDestroy(Sender: TObject); 384 | begin 385 | {$IFDEF USE_DWS} 386 | dws.Free; 387 | {$ENDIF} 388 | {$IFDEF USE_DELPHIAST} 389 | ex.Free; 390 | {$ENDIF} 391 | pas.Free; 392 | end; 393 | 394 | procedure TfrmMain.ListBox1DblClick(Sender: TObject); 395 | var line,Col:integer;m:TMatch; pos:TBufferCoord; 396 | begin 397 | if ListBox1.ItemIndex<0 then Exit; 398 | 399 | 400 | m := TRegEx.Match(ListBox1.Items[ListBox1.ItemIndex], '\[(?\d+)\,\s*(?\d+)\]\s*(?.*)'); 401 | if not m.Success then 402 | Exit; 403 | 404 | Line := StrToInt(m.Groups['Line'].Value)-1; 405 | Col := StrToInt(m.Groups['Col'].Value); 406 | 407 | pos.Char := Col; 408 | pos.Line := Line; 409 | 410 | edPascalCode.SelStart := edPascalCode.RowColToCharIndex(Pos); 411 | Pos.Char := Pos.Char + 1; 412 | edPascalCode.SelEnd := edPascalCode.RowColToCharIndex(Pos); 413 | 414 | edPascalCode.TopLine := Line - 3; 415 | edPascalCode.SetFocus; 416 | FocusControl(edPascalCode); 417 | 418 | end; 419 | 420 | {$IFDEF USE_DWS} 421 | procedure TfrmMain.Run; 422 | var s,code:string; 423 | begin 424 | code := edPascalCode.Text; 425 | 426 | // fix some common problems. 427 | 428 | // Somehow DWS uses PintLn instead of WriteLn 429 | code := code.Replace('WriteLn','PrintLn',[ rfIgnoreCase, rfReplaceAll ]); 430 | code := code.Replace('Write','Print',[ rfIgnoreCase, rfReplaceAll ]); 431 | 432 | // compile 433 | prog:=dws.Compile(code); 434 | 435 | ListBox1.Clear; 436 | ListBox1.Items.Add('Output:'); 437 | if prog.Msgs.Count=0 then 438 | begin 439 | try 440 | // run 441 | exec := prog.Execute; 442 | 443 | // show program output in listbox 444 | for s in exec.Result.ToString.Split([sLineBreak]) do 445 | ListBox1.Items.Add(s); 446 | except 447 | on E: Exception do 448 | ListBox1.Items.Add(E.ClassName+': '+E.Message); 449 | end; 450 | end 451 | else 452 | begin 453 | ListBox1.Items.Add(prog.Msgs.AsInfo); 454 | end; 455 | end; 456 | 457 | {$ELSE} 458 | procedure TfrmMain.Run; 459 | begin 460 | // include DWS to run the generated code 461 | end; 462 | {$ENDIF} 463 | 464 | 465 | function TfrmMain.ReadCCodeFromFile(cfn: string): string; 466 | var 467 | hfn: string; 468 | begin 469 | // try to open the header file too... 470 | 471 | Result := TFile.ReadAllText(cfn); 472 | if not SameText(ExtractFileExt(cfn), '.h') then 473 | begin 474 | hfn := ChangeFileExt(cfn, '.h'); 475 | if TFile.Exists(hfn) then 476 | Result := TFile.ReadAllText(hfn) + sLineBreak + Result; 477 | end; 478 | end; 479 | 480 | procedure TfrmMain.FindParent(var e: TPascalElement); 481 | begin 482 | repeat 483 | if e.Renderinfo.Length > 1 then 484 | break 485 | else 486 | e := e.Owner; 487 | until (e = nil) or (e.Owner = nil); 488 | end; 489 | 490 | procedure TfrmMain.ShowElement(Sender:TObject; el: TPascalElement); 491 | var 492 | p1,p3: TBufferCoord; 493 | begin 494 | StatusBar1.Panels[4].Text := Format('%s (%s)',[el.Name,el.Name.TrimLeft(['T'])]); 495 | 496 | e := el; 497 | FindParent(e); 498 | if e <> nil then 499 | begin 500 | p1 := getPosition(edCCode.Lines, e.Sourceinfo.Position); 501 | while edCCode.Lines[p1.Line].Trim = '' do 502 | begin 503 | p1.Line := p1.Line + 1; 504 | if p1.Line > edCCode.Lines.Count then 505 | Break; 506 | end; 507 | if Sender<>edCCode then 508 | begin 509 | edCCode.TopLine := p1.Line; 510 | edCCode.Refresh; 511 | end; 512 | end; 513 | 514 | e := el; 515 | FindParent(e); 516 | 517 | if e<>nil then 518 | begin 519 | p3 := getPosition(edPascalCode.Lines, e.Renderinfo.Position); 520 | if Sender<>edPascalCode then 521 | begin 522 | edPascalCode.TopLine := p3.Line - (p1.Line - edCCode.TopLine + 1); 523 | edPascalCode.Refresh; 524 | end; 525 | end; 526 | end; 527 | 528 | 529 | 530 | procedure TfrmMain.SearchBox1Change(Sender: TObject); 531 | begin 532 | edCCode.SearchEngine.FindAll(SearchBox1.Text); 533 | Caption := Format('Matches:%d', [edCCode.SearchEngine.ResultCount]);; 534 | end; 535 | 536 | procedure TfrmMain.TreeView1Change(Sender: TObject; Node: TTreeNode); 537 | var el:TPascalElement; 538 | begin 539 | if Node.Data=nil then 540 | Exit; 541 | 542 | el := Node.Data; 543 | if el=nil then 544 | Exit; 545 | ShowElement(Sender,el); 546 | end; 547 | 548 | procedure TfrmMain.TreeView1CustomDrawItem(Sender: TCustomTreeView; 549 | Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); 550 | var el:TPascalElement; 551 | begin 552 | el := TPascalElement(Node.Data); 553 | 554 | if el is TClassDef then Sender.Canvas.Font.Color := $FF9999; 555 | if el is TVariableList then Sender.Canvas.Font.Color := $99CC99; 556 | if el is TVariable then Sender.Canvas.Font.Color := $999999; 557 | if el is TPascalUnit then Sender.Canvas.Font.Color := $888888; 558 | if el is TRoutine then Sender.Canvas.Font.Color := $6666FF; 559 | if el is TUsesList then Sender.Canvas.Font.Color := $669999; 560 | if el is TUsesListItem then Sender.Canvas.Font.Color := $66cccc; 561 | if el is TEnumDef then Sender.Canvas.Font.Color := $66ffcc; 562 | if el is TArrayDef1D then Sender.Canvas.Font.Color := $ffffcc; 563 | if el is TArrayDef2D then Sender.Canvas.Font.Color := $ffccff; 564 | 565 | DefaultDraw := True; 566 | end; 567 | 568 | procedure TfrmMain.WMDROPFILES(var msg: TWMDropFiles); 569 | const 570 | MAXFILENAME = 255; 571 | var 572 | cnt, fileCount: integer; 573 | code,cfn,t:string; 574 | fileName : array [0 .. MAXFILENAME] of char; 575 | p:TPascalUnit; 576 | begin 577 | fileCount := DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAXFILENAME); 578 | for cnt := 0 to fileCount -1 do 579 | begin 580 | DragQueryFile(msg.Drop, cnt, fileName, MAXFILENAME); 581 | cfn := fileName; 582 | if fileCount>1 then 583 | begin 584 | p := TPascalUnit.Create(nil); 585 | try 586 | c_to_pas(ReadCCodeFromFile(cfn),t,changefileext(ExtractFilename(cfn),''), 587 | procedure(progress:double;const text:string) 588 | begin 589 | ProgressBar1.Position := round(Progress * 100); 590 | Statusbar1.Panels[2].Text := round(Progress * 100).toString+'% '+ Text; 591 | if ListBox1.Count>0 then 592 | ListBox1.Perform(lb_SetTopIndex,ListBox1.Count-1,0); 593 | end, 594 | p 595 | ); 596 | TFile.WriteAllText( ChangeFileExt(fileName,'.pas'), p.toPascal); 597 | finally 598 | p.Free; 599 | end; 600 | end; 601 | end; 602 | 603 | if fileCount>0 then 604 | begin 605 | code := ReadCCodeFromFile(cfn); 606 | if length(code)>1024*150 then 607 | begin 608 | edCCode.Highlighter := nil; 609 | end 610 | else 611 | begin 612 | edCCode.Highlighter := SynCppSyn1; 613 | edCCode.Color := $00222827; 614 | end; 615 | 616 | edCCode.Clear; 617 | edCCode.Text := code; 618 | edCCode.Hint := ChangeFileExt(ExtractFileName(cfn),''); 619 | CFileName := fileName; 620 | pas.Name := changefileext(ExtractFilename(cfn),''); 621 | edCCodeChange(nil); 622 | end; 623 | 624 | DragFinish(msg.Drop); 625 | end; 626 | 627 | procedure TfrmMain.UpdateTree; 628 | procedure AddNode(p:TPascalElement;t:TTreeNode); 629 | var i:integer;tn:TTreeNode; 630 | begin 631 | tn := TreeView1.Items.AddChild(t, p.ToString ); 632 | tn.Data := p; 633 | 634 | for I := 0 to p.Count-1 do 635 | if p.Children[I].Visible then 636 | begin 637 | AddNode(p.Children[I],tn); 638 | end; 639 | 640 | if (p is TRoutine) or (p is TVariableList) then 641 | tn.Collapse(True) 642 | else 643 | tn.Expand(false); 644 | end; 645 | begin 646 | TreeView1.Items.BeginUpdate; 647 | TreeView1.Items.Clear; 648 | AddNode(pas,nil); 649 | TreeView1.Items.EndUpdate; 650 | end; 651 | 652 | procedure TfrmMain.Action1Execute(Sender: TObject); 653 | begin 654 | edCCode.Lines.SaveToFile(ChangeFileExt(cFileName,'_prep_.c')); 655 | edPascalCode.Lines.SaveToFile(ChangeFileExt(cFileName,'.pas')); 656 | end; 657 | 658 | procedure TfrmMain.actRunExecute(Sender: TObject); 659 | begin 660 | Run; 661 | end; 662 | 663 | procedure TfrmMain.ApplicationEvents1Exception(Sender: TObject; E: Exception); 664 | begin 665 | ListBox1.Items.Add(E.Message) 666 | end; 667 | 668 | procedure TfrmMain.ApplicationEvents1Hint(Sender: TObject); 669 | begin 670 | StatusBar1.Panels[3].Text := Application.Hint; 671 | end; 672 | 673 | procedure TfrmMain.edCCodeCaretChanged(ASender: TObject; X, Y: Integer); 674 | var text:string; c:TClassDef; 675 | e:TPascalElement; p1,p2:TBufferCoord; 676 | 677 | begin 678 | if pas=nil then 679 | Exit; 680 | 681 | text := edCCode.Text; 682 | 683 | StatusBar3.Panels[0].Text := Format('[Line:%d,Col%d]', [Y,X]); 684 | 685 | 686 | for c in pas.Classes do 687 | for e in c.FMethods do 688 | begin 689 | GetRangeSource(edCCode.Lines, e, p1, p2); 690 | if InRange(Y,p1.Line, p2.Line) then 691 | begin 692 | ShowElement(ASender,e); 693 | Exit; 694 | end; 695 | end; 696 | 697 | for e in pas.GlobalArrays1D do 698 | begin 699 | GetRangeSource(edCCode.Lines, e, p1, p2); 700 | if InRange(Y,p1.Line, p2.Line) then 701 | begin 702 | ShowElement(ASender,e); 703 | Exit; 704 | end; 705 | end; 706 | 707 | for e in pas.GlobalArrays2D do 708 | begin 709 | GetRangeSource(edCCode.Lines, e, p1, p2); 710 | if InRange(Y,p1.Line, p2.Line) then 711 | begin 712 | ShowElement(ASender,e); 713 | Exit; 714 | end; 715 | end; 716 | 717 | for e in pas.Classes do 718 | begin 719 | GetRangeSource(edCCode.Lines, e, p1, p2); 720 | if InRange(Y,p1.Line, p2.Line) then 721 | begin 722 | ShowElement(ASender,e); 723 | Exit; 724 | end; 725 | end; 726 | 727 | end; 728 | 729 | procedure TfrmMain.edCCodeChange(Sender:TObjecT); 730 | var 731 | tl: Integer;t:string; 732 | c:string; 733 | 734 | begin 735 | tl := edPascalCode.TopLine; 736 | c := edCCode.Text; 737 | 738 | if task<>nil then 739 | if task.Status in [TTaskStatus.Running,TTaskStatus.WaitingToRun] then 740 | begin 741 | task.Cancel; 742 | task.Wait(300); 743 | end; 744 | 745 | ProgressBar1.Position := 0; 746 | ProgressBar1.Min := 0; 747 | ProgressBar1.Max := 100; 748 | 749 | StatusBar1.Panels[1].Text := 'Converting...'; 750 | edPascalCode.Enabled := False; 751 | edPascalCode.Color := $000033; 752 | ListBox1.Clear; 753 | 754 | task := TTask.Create( 755 | procedure 756 | var p:TPascalUnit; n:string; 757 | begin 758 | if pas<>nil then 759 | n:= pas.Name 760 | else 761 | n := 'tmp'; 762 | 763 | p := TPascalUnit.Create(nil); 764 | c_to_pas(c,t,n, 765 | // callback to report progress 766 | procedure(progress:double;const text:string) 767 | begin 768 | TThread.Synchronize(TThread.CurrentThread, 769 | procedure 770 | begin 771 | if progress < 1 then 772 | begin 773 | ProgressBar1.Position := round(Progress * 100); 774 | Statusbar1.Panels[2].Text := round(Progress * 100).toString+'% '+ Text 775 | end 776 | else 777 | begin 778 | ProgressBar1.Position := 0; 779 | Statusbar1.Panels[2].Text := ''; 780 | end; 781 | if ListBox1.Count>0 then 782 | ListBox1.Perform(lb_SetTopIndex,ListBox1.Count-1,0); 783 | end); 784 | end, 785 | p); 786 | 787 | 788 | TThread.Synchronize(TThread.CurrentThread, 789 | procedure 790 | begin 791 | Pas.Free; 792 | 793 | pas := p; 794 | frmMain.Caption := Application.Title; 795 | if pas.Name <> '' then 796 | frmMain.Caption := p.Name + ' - ' + Caption; 797 | 798 | UpdateTree; 799 | edPascalCode.Text := pas.toPascal; 800 | edPascalCode.TopLine := tl; 801 | edPascalCode.Enabled := True; 802 | //@@@ edPascalCode.OnChange(sender); 803 | edPascalCode.Color := $00222827; 804 | StatusBar1.Panels[1].Text := ''; 805 | p := nil; 806 | end); 807 | 808 | end); 809 | 810 | task.Start; 811 | end; 812 | 813 | 814 | end. 815 | -------------------------------------------------------------------------------- /C2Delphi.dpr: -------------------------------------------------------------------------------- 1 | program C2Delphi; 2 | 3 | uses 4 | FastMM4, 5 | Vcl.Forms, 6 | C2Delphi.Forms.Main in 'C2Delphi.Forms.Main.pas' {frmMain}, 7 | WvN.Pascal.Model in 'WvN.Pascal.Model.pas', 8 | Vcl.Themes, 9 | Vcl.Styles, 10 | WvN.Pascal.CReader in 'WvN.Pascal.CReader.pas', 11 | Vcl.PlatformVclStylesActnCtrls in '..\..\lib\vcl-styles-utils\Common\Vcl.PlatformVclStylesActnCtrls.pas', 12 | Vcl.Styles.ColorTabs in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.ColorTabs.pas', 13 | Vcl.Styles.ControlColor in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.ControlColor.pas', 14 | Vcl.Styles.Ext in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Ext.pas', 15 | Vcl.Styles.Fixes in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Fixes.pas', 16 | Vcl.Styles.FormStyleHooks in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.FormStyleHooks.pas', 17 | Vcl.Styles.Hooks in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Hooks.pas', 18 | Vcl.Styles.NC in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.NC.pas', 19 | Vcl.Styles.OwnerDrawFix in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.OwnerDrawFix.pas', 20 | Vcl.Styles.Utils in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.pas', 21 | Vcl.Styles.Utils.ComCtrls in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.ComCtrls.pas', 22 | Vcl.Styles.Utils.Forms in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.Forms.pas', 23 | Vcl.Styles.Utils.Graphics in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.Graphics.pas', 24 | Vcl.Styles.Utils.Menus in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.Menus.pas', 25 | Vcl.Styles.Utils.ScreenTips in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.ScreenTips.pas', 26 | Vcl.Styles.Utils.Shadow in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.Shadow.pas', 27 | Vcl.Styles.Utils.StdCtrls in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.StdCtrls.pas', 28 | Vcl.Styles.Utils.SysControls in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.SysControls.pas', 29 | Vcl.Styles.Utils.SysStyleHook in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.SysStyleHook.pas', 30 | Vcl.Styles.Utils.SystemMenu in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.Utils.SystemMenu.pas', 31 | Vcl.Styles.UxTheme in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.UxTheme.pas', 32 | Vcl.Styles.WebBrowser in '..\..\lib\vcl-styles-utils\Common\Vcl.Styles.WebBrowser.pas', 33 | DelphiAST in '..\DelphiAST\Source\DelphiAST.pas', 34 | DelphiAST.Classes in '..\DelphiAST\Source\DelphiAST.Classes.pas', 35 | DelphiAST.Consts in '..\DelphiAST\Source\DelphiAST.Consts.pas', 36 | SimpleParser in '..\DelphiAST\Source\SimpleParser\SimpleParser.pas', 37 | SimpleParser.Lexer in '..\DelphiAST\Source\SimpleParser\SimpleParser.Lexer.pas', 38 | SimpleParser.Lexer.Types in '..\DelphiAST\Source\SimpleParser\SimpleParser.Lexer.Types.pas', 39 | SimpleParser.Types in '..\DelphiAST\Source\SimpleParser\SimpleParser.Types.pas'; 40 | 41 | {$R *.res} 42 | 43 | begin 44 | Application.Initialize; 45 | Application.MainFormOnTaskbar := True; 46 | Application.Title := 'C to Delphi'; 47 | TStyleManager.TrySetStyle('Charcoal Dark Slate'); 48 | Application.CreateForm(TfrmMain, frmMain); 49 | Application.Run; 50 | end. 51 | -------------------------------------------------------------------------------- /C2Delphi.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {3A5D71F7-635F-4E30-A692-1E2E1EC8BE4F} 4 | C2Delphi.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 18.1 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Cfg_2 40 | true 41 | true 42 | 43 | 44 | false 45 | false 46 | false 47 | "Charcoal Dark Slate|VCLSTYLE|$(BDSCOMMONDIR)\Styles\CharcoalDarkSlate.vsf" 48 | false 49 | 00400000 50 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 51 | false 52 | C2Delphi 53 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 54 | 1043 55 | 56 | 57 | 1033 58 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 59 | true 60 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 61 | true 62 | $(BDS)\bin\default_app.manifest 63 | 64 | 65 | RELEASE;$(DCC_Define) 66 | 0 67 | 0 68 | false 69 | 70 | 71 | 1 72 | CompanyName=;FileDescription=;FileVersion=1.0.0.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 73 | true 74 | true 75 | 76 | 77 | DEBUG;$(DCC_Define) 78 | false 79 | true 80 | 81 | 82 | true 83 | true 84 | true 85 | 501 86 | true 87 | true 88 | 1033 89 | CompanyName=;FileDescription=;FileVersion=1.0.0.501;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 90 | true 91 | 92 | 93 | 94 | MainSource 95 | 96 | 97 |
frmMain
98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | Cfg_2 133 | Base 134 | 135 | 136 | Base 137 | 138 | 139 | Cfg_1 140 | Base 141 | 142 | 143 | 144 | Delphi.Personality.12 145 | 146 | 147 | 148 | 149 | C2Delphi.dpr 150 | 151 | 152 | Microsoft Office 2000 Sample Automation Server Wrapper Components 153 | Microsoft Office XP Sample Automation Server Wrapper Components 154 | 155 | 156 | 157 | True 158 | False 159 | 160 | 161 | 162 | 163 | C2Delphi.exe 164 | true 165 | 166 | 167 | 168 | 169 | C2Delphi.exe 170 | true 171 | 172 | 173 | 174 | 175 | .\ 176 | true 177 | 178 | 179 | 180 | 181 | 0 182 | .dll;.bpl 183 | 184 | 185 | 1 186 | .dylib 187 | 188 | 189 | Contents\MacOS 190 | 1 191 | .dylib 192 | 193 | 194 | 1 195 | .dylib 196 | 197 | 198 | 1 199 | .dylib 200 | 201 | 202 | 203 | 204 | Contents\Resources 205 | 1 206 | 207 | 208 | 209 | 210 | classes 211 | 1 212 | 213 | 214 | 215 | 216 | Contents\MacOS 217 | 0 218 | 219 | 220 | 1 221 | 222 | 223 | Contents\MacOS 224 | 1 225 | 226 | 227 | 228 | 229 | 1 230 | 231 | 232 | 1 233 | 234 | 235 | 1 236 | 237 | 238 | 239 | 240 | res\drawable-xxhdpi 241 | 1 242 | 243 | 244 | 245 | 246 | library\lib\mips 247 | 1 248 | 249 | 250 | 251 | 252 | 1 253 | 254 | 255 | 1 256 | 257 | 258 | 0 259 | 260 | 261 | 1 262 | 263 | 264 | Contents\MacOS 265 | 1 266 | 267 | 268 | library\lib\armeabi-v7a 269 | 1 270 | 271 | 272 | 1 273 | 274 | 275 | 276 | 277 | 0 278 | 279 | 280 | Contents\MacOS 281 | 1 282 | .framework 283 | 284 | 285 | 286 | 287 | 1 288 | 289 | 290 | 1 291 | 292 | 293 | 1 294 | 295 | 296 | 297 | 298 | 1 299 | 300 | 301 | 1 302 | 303 | 304 | 1 305 | 306 | 307 | 308 | 309 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 310 | 1 311 | 312 | 313 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 314 | 1 315 | 316 | 317 | 318 | 319 | 1 320 | 321 | 322 | 1 323 | 324 | 325 | 1 326 | 327 | 328 | 329 | 330 | 1 331 | 332 | 333 | 1 334 | 335 | 336 | 1 337 | 338 | 339 | 340 | 341 | library\lib\armeabi 342 | 1 343 | 344 | 345 | 346 | 347 | 0 348 | 349 | 350 | 1 351 | 352 | 353 | Contents\MacOS 354 | 1 355 | 356 | 357 | 358 | 359 | 1 360 | 361 | 362 | 1 363 | 364 | 365 | 1 366 | 367 | 368 | 369 | 370 | res\drawable-normal 371 | 1 372 | 373 | 374 | 375 | 376 | res\drawable-xhdpi 377 | 1 378 | 379 | 380 | 381 | 382 | res\drawable-large 383 | 1 384 | 385 | 386 | 387 | 388 | 1 389 | 390 | 391 | 1 392 | 393 | 394 | 1 395 | 396 | 397 | 398 | 399 | ..\ 400 | 1 401 | 402 | 403 | ..\ 404 | 1 405 | 406 | 407 | 408 | 409 | res\drawable-hdpi 410 | 1 411 | 412 | 413 | 414 | 415 | library\lib\armeabi-v7a 416 | 1 417 | 418 | 419 | 420 | 421 | Contents 422 | 1 423 | 424 | 425 | 426 | 427 | ..\ 428 | 1 429 | 430 | 431 | 432 | 433 | 1 434 | 435 | 436 | 1 437 | 438 | 439 | 1 440 | 441 | 442 | 443 | 444 | res\values 445 | 1 446 | 447 | 448 | 449 | 450 | res\drawable-small 451 | 1 452 | 453 | 454 | 455 | 456 | res\drawable 457 | 1 458 | 459 | 460 | 461 | 462 | 1 463 | 464 | 465 | 1 466 | 467 | 468 | 1 469 | 470 | 471 | 472 | 473 | 1 474 | 475 | 476 | 477 | 478 | res\drawable 479 | 1 480 | 481 | 482 | 483 | 484 | 0 485 | 486 | 487 | 0 488 | 489 | 490 | Contents\Resources\StartUp\ 491 | 0 492 | 493 | 494 | 0 495 | 496 | 497 | 0 498 | 499 | 500 | 0 501 | 502 | 503 | 504 | 505 | library\lib\armeabi-v7a 506 | 1 507 | 508 | 509 | 510 | 511 | 0 512 | .bpl 513 | 514 | 515 | 1 516 | .dylib 517 | 518 | 519 | Contents\MacOS 520 | 1 521 | .dylib 522 | 523 | 524 | 1 525 | .dylib 526 | 527 | 528 | 1 529 | .dylib 530 | 531 | 532 | 533 | 534 | res\drawable-mdpi 535 | 1 536 | 537 | 538 | 539 | 540 | res\drawable-xlarge 541 | 1 542 | 543 | 544 | 545 | 546 | res\drawable-ldpi 547 | 1 548 | 549 | 550 | 551 | 552 | 1 553 | 554 | 555 | 1 556 | 557 | 558 | 559 | 560 | 561 | 562 | 563 | 564 | 565 | 566 | 567 | 568 | 12 569 | 570 | 571 | 572 | 573 | 574 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Wouter van Nifterick 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # C-To-Delphi 2 | 3 | ## Description 4 | This tool will convert most of your standard C code. . 5 | 6 | [Download](https://github.com/WouterVanNifterick/C-To-Delphi/releases "Download") executable here. 7 | 8 | It contains a split view, with C on the left and Delphi on the right. 9 | The Delphi code gets updated in realtime when you edit the C code. 10 | The editors are kept in sync, so you can easily find how a specific piece of code was converted. 11 | 12 | * The **Syntax checks** of the generated code is verified. (uses DelphiAST) 13 | * You can even **run** the generated code by pressing F9 (uses DWS) 14 | 15 | * You can drag/drop multiple C files to the application. It'll find the .h files that belong to it, and convert all to .pas files in the same folder. 16 | 17 | ## Features: 18 | * If function main exists, a program will be generated. Otherwise a pascal unit with interface/implementation sections. 19 | * Converts routines and arguments 20 | * Converts for loops 21 | * Converts case statements 22 | * Converts structs 23 | * Converts enums 24 | * Converts 1 and 2 dimensional arrays 25 | * Converts many other common routines to Delphi equivalents (strcpy,strcat,strlen,printf,argv,argc,etc) 26 | * Converts classes 27 | 28 | ![Screenshot](https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/master/C-To-Delphi-0.9.0.png) 29 | -------------------------------------------------------------------------------- /Releases/C2Delphi-0.9.0.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/6658bfb38e8d37e4d2e9f42c845cd30412930b37/Releases/C2Delphi-0.9.0.zip -------------------------------------------------------------------------------- /Releases/C2Delphi-0.9.1.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/6658bfb38e8d37e4d2e9f42c845cd30412930b37/Releases/C2Delphi-0.9.1.zip -------------------------------------------------------------------------------- /Releases/C2Delphi-0.9.2.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/6658bfb38e8d37e4d2e9f42c845cd30412930b37/Releases/C2Delphi-0.9.2.zip -------------------------------------------------------------------------------- /Test/C2DelphiTests.dpr: -------------------------------------------------------------------------------- 1 | program C2DelphiTests; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF}{$STRONGLINKTYPES ON} 6 | uses 7 | System.SysUtils, 8 | {$IFDEF TESTINSIGHT} 9 | TestInsight.DUnitX, 10 | {$ENDIF } 11 | DUnitX.Loggers.Console, 12 | DUnitX.Loggers.Xml.NUnit, 13 | DUnitX.TestFramework, 14 | Test.CReader in 'Test.CReader.pas', 15 | WvN.Pascal.CReader in '..\WvN.Pascal.CReader.pas', 16 | WvN.Pascal.Model in '..\WvN.Pascal.Model.pas'; 17 | 18 | var 19 | runner : ITestRunner; 20 | results : IRunResults; 21 | logger : ITestLogger; 22 | nunitLogger : ITestLogger; 23 | begin 24 | {$IFDEF TESTINSIGHT} 25 | TestInsight.DUnitX.RunRegisteredTests; 26 | exit; 27 | {$ENDIF} 28 | try 29 | //Check command line options, will exit if invalid 30 | TDUnitX.CheckCommandLine; 31 | //Create the test runner 32 | runner := TDUnitX.CreateRunner; 33 | //Tell the runner to use RTTI to find Fixtures 34 | runner.UseRTTI := True; 35 | //tell the runner how we will log things 36 | //Log to the console window 37 | logger := TDUnitXConsoleLogger.Create(true); 38 | runner.AddLogger(logger); 39 | //Generate an NUnit compatible XML File 40 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 41 | runner.AddLogger(nunitLogger); 42 | runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests; 43 | 44 | //Run tests 45 | results := runner.Execute; 46 | if not results.AllPassed then 47 | System.ExitCode := EXIT_ERRORS; 48 | 49 | {$IFNDEF CI} 50 | //We don't want this happening when running under CI. 51 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 52 | begin 53 | System.Write('Done.. press key to quit.'); 54 | System.Readln; 55 | end; 56 | {$ENDIF} 57 | except 58 | on E: Exception do 59 | System.Writeln(E.ClassName, ': ', E.Message); 60 | end; 61 | end. 62 | -------------------------------------------------------------------------------- /Test/C2DelphiTests.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {83322A2F-A5CC-4570-ABEB-DD9FFA4E3793} 4 | 18.1 5 | C2DelphiTests.dpr 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Console 11 | None 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Base 39 | true 40 | 41 | 42 | true 43 | Cfg_1 44 | true 45 | true 46 | 47 | 48 | true 49 | Base 50 | true 51 | 52 | 53 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 54 | $(BDS)\bin\delphi_PROJECTICON.ico 55 | true 56 | $(DUnitX);$(DCC_UnitSearchPath) 57 | $(BDS)\bin\delphi_PROJECTICNS.icns 58 | C2DelphiTests 59 | .\$(Platform)\$(Config) 60 | .\$(Platform)\$(Config) 61 | false 62 | false 63 | false 64 | false 65 | false 66 | 67 | 68 | DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;DataSnapNativeClient;ibxbindings;FireDACDSDriver;soapmidas;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;DataSnapProviderClient;dsnapxml;dbrtl;IndyProtocols;$(DCC_UsePackage) 69 | 70 | 71 | DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;FireDACMSSQLDriver;bindcompfmx;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;DataSnapNativeClient;ibxbindings;fmxobj;FireDACDSDriver;soapmidas;rtl;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;bindcomp;DBXInformixDriver;IndyIPClient;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;dsnapxml;dbrtl;FireDACMongoDBDriver;IndyProtocols;inetdbxpress;fmxase;$(DCC_UsePackage) 72 | 73 | 74 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 75 | 1033 76 | DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;svnui;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;DAV_Modular_D23;vcldb;bindcompfmx;Intraweb;svn;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;vclib;VSTiGUI;FireDACDBXDriver;dbexpress;IndyCore;DAV_GUI_D23;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;GR32_DSGN_RSXE7;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;BCEditor.Delphi.Runtime;inet;DAV_DSP_D23;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;VirtualTreesR;FireDACMSAccDriver;FireDACInfxDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DAV_Common_D23;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;ibxbindings;fmxobj;FireDACDSDriver;soapmidas;rtl;vclwinx;DbxClientDriver;CnPack_D101B;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;SynEdit_R;DAV_VSTHost_D23;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;dsnapxml;dbrtl;FireDACMongoDBDriver;IndyProtocols;inetdbxpress;DAV_SEHost_D23;MidiComponents2010;GR32_RSXE7;DAV_ASIOHost_D23;fmxase;$(DCC_UsePackage) 77 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 78 | 79 | 80 | DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;VirtualTreesR;FireDACMSAccDriver;FireDACInfxDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;ibxbindings;fmxobj;FireDACDSDriver;soapmidas;rtl;vclwinx;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;SynEdit_R;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;dsnapxml;dbrtl;FireDACMongoDBDriver;IndyProtocols;inetdbxpress;fmxase;$(DCC_UsePackage) 81 | 82 | 83 | DEBUG;$(DCC_Define) 84 | true 85 | false 86 | true 87 | true 88 | true 89 | 90 | 91 | false 92 | 93 | 94 | false 95 | RELEASE;$(DCC_Define) 96 | 0 97 | 0 98 | 99 | 100 | 101 | MainSource 102 | 103 | 104 | 105 | 106 | 107 | Cfg_2 108 | Base 109 | 110 | 111 | Base 112 | 113 | 114 | Cfg_1 115 | Base 116 | 117 | 118 | 119 | Delphi.Personality.12 120 | Console 121 | 122 | 123 | 124 | C2DelphiTests.dpr 125 | 126 | 127 | 128 | 129 | 130 | true 131 | 132 | 133 | 134 | 135 | true 136 | 137 | 138 | 139 | 140 | true 141 | 142 | 143 | 144 | 145 | true 146 | 147 | 148 | 149 | 150 | C2DelphiTests.exe 151 | true 152 | 153 | 154 | 155 | 156 | 0 157 | .dll;.bpl 158 | 159 | 160 | 1 161 | .dylib 162 | 163 | 164 | 165 | 166 | Contents\Resources 167 | 1 168 | 169 | 170 | 171 | 172 | classes 173 | 1 174 | 175 | 176 | 177 | 178 | Contents\MacOS 179 | 0 180 | 181 | 182 | 1 183 | 184 | 185 | 186 | 187 | 1 188 | 189 | 190 | 1 191 | 192 | 193 | 1 194 | 195 | 196 | 197 | 198 | res\drawable-xxhdpi 199 | 1 200 | 201 | 202 | 203 | 204 | library\lib\mips 205 | 1 206 | 207 | 208 | 209 | 210 | 1 211 | 212 | 213 | 1 214 | 215 | 216 | 0 217 | 218 | 219 | 1 220 | 221 | 222 | 1 223 | 224 | 225 | library\lib\armeabi-v7a 226 | 1 227 | 228 | 229 | 1 230 | 231 | 232 | 233 | 234 | 0 235 | 236 | 237 | 1 238 | .framework 239 | 240 | 241 | 242 | 243 | 1 244 | 245 | 246 | 1 247 | 248 | 249 | 1 250 | 251 | 252 | 253 | 254 | 1 255 | 256 | 257 | 1 258 | 259 | 260 | 1 261 | 262 | 263 | 264 | 265 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 266 | 1 267 | 268 | 269 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 270 | 1 271 | 272 | 273 | 274 | 275 | 1 276 | 277 | 278 | 1 279 | 280 | 281 | 1 282 | 283 | 284 | 285 | 286 | 287 | library\lib\armeabi 288 | 1 289 | 290 | 291 | 292 | 293 | 0 294 | 295 | 296 | 1 297 | 298 | 299 | 1 300 | 301 | 302 | 303 | 304 | 1 305 | 306 | 307 | 1 308 | 309 | 310 | 1 311 | 312 | 313 | 314 | 315 | res\drawable-normal 316 | 1 317 | 318 | 319 | 320 | 321 | res\drawable-xhdpi 322 | 1 323 | 324 | 325 | 326 | 327 | res\drawable-large 328 | 1 329 | 330 | 331 | 332 | 333 | 1 334 | 335 | 336 | 1 337 | 338 | 339 | 1 340 | 341 | 342 | 343 | 344 | 345 | res\drawable-hdpi 346 | 1 347 | 348 | 349 | 350 | 351 | library\lib\armeabi-v7a 352 | 1 353 | 354 | 355 | 356 | 357 | 358 | 359 | 1 360 | 361 | 362 | 1 363 | 364 | 365 | 1 366 | 367 | 368 | 369 | 370 | res\values 371 | 1 372 | 373 | 374 | 375 | 376 | res\drawable-small 377 | 1 378 | 379 | 380 | 381 | 382 | res\drawable 383 | 1 384 | 385 | 386 | 387 | 388 | 1 389 | 390 | 391 | 1 392 | 393 | 394 | 1 395 | 396 | 397 | 398 | 399 | 1 400 | 401 | 402 | 403 | 404 | res\drawable 405 | 1 406 | 407 | 408 | 409 | 410 | 0 411 | 412 | 413 | 0 414 | 415 | 416 | 0 417 | 418 | 419 | 0 420 | 421 | 422 | 0 423 | 424 | 425 | 0 426 | 427 | 428 | 429 | 430 | library\lib\armeabi-v7a 431 | 1 432 | 433 | 434 | 435 | 436 | 0 437 | .bpl 438 | 439 | 440 | 1 441 | .dylib 442 | 443 | 444 | 1 445 | .dylib 446 | 447 | 448 | 1 449 | .dylib 450 | 451 | 452 | 1 453 | .dylib 454 | 455 | 456 | 457 | 458 | res\drawable-mdpi 459 | 1 460 | 461 | 462 | 463 | 464 | res\drawable-xlarge 465 | 1 466 | 467 | 468 | 469 | 470 | res\drawable-ldpi 471 | 1 472 | 473 | 474 | 475 | 476 | 477 | 478 | 479 | 480 | 481 | 482 | 483 | 484 | 485 | False 486 | False 487 | True 488 | False 489 | 490 | 491 | 12 492 | 493 | 494 | 495 | 496 | 497 | -------------------------------------------------------------------------------- /Test/C2DelphiTests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/C-To-Delphi/6658bfb38e8d37e4d2e9f42c845cd30412930b37/Test/C2DelphiTests.res -------------------------------------------------------------------------------- /Test/Test.CReader.pas: -------------------------------------------------------------------------------- 1 | unit Test.CReader; 2 | 3 | interface 4 | 5 | uses 6 | WvN.Pascal.CReader, 7 | WvN.Pascal.Model, 8 | DUnitX.TestFramework; 9 | 10 | type 11 | 12 | [TestFixture] 13 | CReaderTests = class(TObject) 14 | public 15 | onprogress:TOnProgress; 16 | PascalUnit:TPascalUnit; 17 | t:string; 18 | 19 | [Setup] 20 | procedure Setup; 21 | [TearDown] 22 | procedure TearDown; 23 | // Sample Methods 24 | // Simple single Test 25 | [Test] 26 | procedure TestThatNameIsUsed; 27 | // Test with TestCase Attribute to supply parameters. 28 | [Test] 29 | [TestCase('TestInt','int,Integer')] 30 | [TestCase('TestLongLong','long long,int64')] 31 | [TestCase('TestLongLong','char,Byte')] 32 | procedure Test2(CType:string;PascalType:string); 33 | end; 34 | 35 | implementation 36 | 37 | procedure CReaderTests.Setup; 38 | begin 39 | onprogress := procedure(progress:double;const text:string) 40 | begin 41 | System.WriteLn(progress:2:2, ' ',Text); 42 | end; 43 | PascalUnit := TPascalUnit.Create(nil); 44 | 45 | end; 46 | 47 | procedure CReaderTests.TearDown; 48 | begin 49 | PascalUnit.Free; 50 | end; 51 | 52 | procedure CReaderTests.TestThatNameIsUsed; 53 | var C:string; 54 | begin 55 | C := ''; 56 | WvN.Pascal.CReader.c_to_pas(C,t,'test',onProgress,PascalUnit); 57 | Assert.AreEqual('test',PascalUnit.Name); 58 | end; 59 | 60 | procedure CReaderTests.Test2(CType:string; PascalType:string); 61 | var C:string; 62 | begin 63 | C := CType +' xxx = 14;'; 64 | WvN.Pascal.CReader.c_to_pas(C,t,'',onProgress,PascalUnit); 65 | Assert.AreEqual(PascalType, TVariable(PascalUnit.GlobalVars[0]).&Type ); 66 | end; 67 | 68 | initialization 69 | TDUnitX.RegisterTestFixture(CReaderTests); 70 | end. 71 | -------------------------------------------------------------------------------- /Test/Win32/Debug/dunitx-results.xml: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /WvN.Pascal.Model.pas: -------------------------------------------------------------------------------- 1 | unit WvN.Pascal.Model; 2 | 3 | interface 4 | 5 | uses Generics.Collections, Generics.Defaults, Classes, Windows; 6 | 7 | const 8 | Keywords:array[0..65] of string= 9 | ('at','and','array','as','asm','begin','case','class','const','constructor', 10 | 'destructor','dispinterface','div','do','downto','else','end','except','exports', 11 | 'file','finalization','finally','for','function','goto','if','implementation', 12 | 'in','inherited','initialization','inline','interface','is','label','library', 13 | 'mod','nil','not','object','of','or','out','packed','procedure','program', 14 | 'property','raise','record','repeat','resourcestring','set','shl','shr', 15 | 'string','then','threadvar','to','try','type','unit','until','uses','var', 16 | 'while','with','xor'); 17 | 18 | type 19 | TLanguage = (Delphi,DWS); 20 | TDir = (none,&in,&out,inout); 21 | TVisibility = (&DefaultVisibility,&StrictPrivate,&Private,&Public,&Published); 22 | TRoutineType = (&function,&procedure,&constructor,&destructor); 23 | TClassKind = (&class,&record,&object,&unit); 24 | const 25 | cClassKind : array[TClassKind] of string = ('class','record','object','unit'); 26 | cDirPascal : array[TDir] of string=('','const','out','var'); 27 | cVisibility : array[TVisibility] of string=('','strict privateconst','private','public','published'); 28 | cRoutineType: array[TRoutineType] of string=('function','procedure','constructor','destructor'); 29 | 30 | type 31 | TPascalUnit=class; 32 | 33 | TSourceInfo=record 34 | Position:integer; 35 | Length:integer; 36 | constructor Create(aPosition:integer; aLength:integer); 37 | end; 38 | 39 | TPascalElement=class; 40 | { 41 | IPascalElement=interface 42 | procedure AddChild(const el:IPascalElement); 43 | function GetChildren(Index: integer): TPascalElement; 44 | function ChildIndexByName(const Name:string):integer; 45 | function ToString:string; 46 | function ToPascal:string; 47 | function Count:integer; 48 | procedure SetOwner(aOwner: IPascalElement); 49 | function GetName: string; 50 | property Children[Index:integer]:TPascalElement read GetChildren; 51 | property Name:string read GetName ; 52 | end; 53 | } 54 | TPascalElement=class 55 | private 56 | function GetName: string; 57 | procedure SetOwner(aOwner: TPascalElement); 58 | protected 59 | FChildren:TObjectList; 60 | FOwner:TPascalElement; 61 | FName : String; 62 | FVisible:Boolean; 63 | procedure AddChild(const el:TPascalElement); 64 | function GetChildren(Index: integer): TPascalElement; 65 | public 66 | Sourceinfo:TSourceInfo; 67 | Renderinfo:TSourceInfo; 68 | function ChildIndexByName(const Name:string):integer; 69 | function ToString:string;reintroduce;virtual; 70 | function ToPascal:string;virtual;abstract; 71 | function Count:integer; 72 | procedure SetDefaultVisible; 73 | property Owner:TPascalElement read FOwner; 74 | constructor Create(aOwner:TPascalElement);virtual; 75 | destructor Destroy; override; 76 | property Children[Index:integer]:TPascalElement read GetChildren; default; 77 | property Name:string read GetName write FName; 78 | property Visible:Boolean read FVisible write FVisible; 79 | end; 80 | 81 | TVariable=class(TPascalElement) 82 | strict private 83 | FHasValue:Boolean; 84 | FDir:TDir; 85 | FType:string; 86 | FValue:variant; 87 | FVisibility:TVisibility; 88 | FIsStatic:Boolean; 89 | FComment:string; 90 | public 91 | constructor Create(AOwner:TPascalElement; aName:string; aType:string;aDir:TDir=TDir.none; aIsStatic:Boolean=false; aHasValue:Boolean=false; aValue:string=''; aComment:string=''); reintroduce; 92 | function ToString:string;override; 93 | function ToPascal:String;override; 94 | 95 | property HasValue:Boolean read FHasValue; 96 | property Dir:TDir read FDir; 97 | property &Type:string read FType; 98 | property Value:variant read FValue; 99 | property Visibility:TVisibility read FVisibility write FVisibility; 100 | property IsStatic:Boolean read FIsStatic; 101 | property Comment:string read FComment; 102 | 103 | end; 104 | 105 | TVariableList=class(TPascalElement) 106 | public 107 | function getLongestName:integer; 108 | function ToPascal(Indent:Boolean):String;reintroduce; 109 | end; 110 | 111 | TArrayDef1D=class(TPascalElement) 112 | public 113 | itemType:string; 114 | rangeMin,rangeMax:string; 115 | Items:TArray; 116 | function ToPascal:string;override; 117 | function ToString:string;override; 118 | end; 119 | 120 | TArrayDef2D=class(TPascalElement) 121 | public 122 | itemType:string; 123 | ranges:array[0..1] of 124 | record 125 | rangeMin,rangeMax:string; 126 | end; 127 | Items:TArray>; 128 | function ToPascal:string;override; 129 | function ToString:string;override; 130 | end; 131 | 132 | TEnumItem = record 133 | Index, Value:integer; 134 | Name:string; 135 | Comment:string; 136 | MaxNameLen,MaxValueLen:integer; 137 | class operator implicit(const e:TEnumItem):string; 138 | end; 139 | 140 | TEnumDef=class(TPascalElement) 141 | public 142 | Items:TArray; 143 | function ToPascal:string;override; 144 | end; 145 | 146 | TCode=class(TPascalElement) 147 | private 148 | function GetLineCount: integer; 149 | public 150 | Lines:TList; 151 | procedure Add(const s:String); 152 | function ToPascal:String;override; 153 | procedure Cleanup; 154 | procedure Align; 155 | destructor Destroy; override; 156 | property LineCount:integer read GetLineCount; 157 | constructor Create(aOwner:TPascalElement; c:TArray);reintroduce; 158 | 159 | end; 160 | 161 | TRoutine=class(TPascalElement) 162 | public 163 | RoutineType:TRoutineType; 164 | ReturnType:string; 165 | Parameters:TVariableList; 166 | LocalVars:TVariableList; 167 | Code:TCode; 168 | &Override:Boolean; 169 | &Overload:Boolean; 170 | &Inline:Boolean; 171 | &Static:Boolean; 172 | &Virtual:Boolean; 173 | ClassName:string; 174 | Comment:string; 175 | Visibility:TVisibility; 176 | 177 | constructor Create( 178 | aOwner:TPascalElement; 179 | aName:String; 180 | aClassName:string; 181 | aRoutineType:TRoutineType; 182 | aReturnType:string; 183 | aParameters:TVariableList; 184 | aLocalVars:TVariableList; 185 | aCode:TCode; 186 | aOverride:Boolean=false; 187 | aOverload:Boolean=false; 188 | aInline:Boolean=false; 189 | aStatic:Boolean=false; 190 | aVirtual:Boolean=false; 191 | aComment:string='');reintroduce; 192 | procedure Cleanup; 193 | function ToString:string;override; 194 | function ToDeclarationPascal:String; 195 | function ToImplementationPascal(aClassName:string):String; 196 | function Equals(Obj: TObject): Boolean; override; 197 | 198 | end; 199 | 200 | TClassDef=class(TPascalElement) 201 | public 202 | FKind:TClassKind; 203 | FParentType:string; 204 | FConsts:TVariableList; 205 | FMembers:TVariableList; 206 | FMethods:TArray; 207 | FIsPacked:boolean; 208 | function AddRoutine(const m:TRoutine):boolean; 209 | function getMethodByName(const n:string):TRoutine; 210 | function ToPascalDeclaration:string; 211 | function ToPascalImplementation:string; 212 | function ToString:string;override; 213 | constructor Create(aOwner:TPascalElement;aTypename:string; aMembers:TVariableList; aKind:TClassKind);reintroduce; 214 | end; 215 | 216 | TUsesListItem=class(TPascalElement) 217 | 218 | end; 219 | 220 | TUsesList=class(TPascalElement) 221 | public 222 | &Unit:TPascalUnit; 223 | constructor Create(aOwner:TPascalElement);override; 224 | procedure AddUnit(const s: string); 225 | function ToPascal:string;override; 226 | end; 227 | 228 | TCase=class(TPascalElement) 229 | strict private 230 | FCode:TCode; 231 | procedure SetCode(const Value: TCode); 232 | public 233 | Id:string; 234 | function ToPascal(aIndent:integer=6; aAlign:integer=0):string;reintroduce; 235 | property Code:TCode read FCode write SetCode; 236 | 237 | end; 238 | 239 | TSwitch=class(TPascalElement) 240 | public 241 | Switch:string; 242 | Cases:TArray; 243 | Indent:integer; 244 | function ToPascal:string;override; 245 | end; 246 | 247 | TIfStatement=class(TPascalElement) 248 | private 249 | Condition, 250 | IfTrue, 251 | IfFalse : TCode; 252 | public 253 | constructor Create(aOwner:TPascalElement; aCondition, aIfTrue, aIfFalse : TCode);reintroduce; 254 | function ToPascal:string;override; 255 | end; 256 | 257 | TPascalUnit=class(TPascalElement) 258 | public 259 | usesListIntf:TUsesList; 260 | usesListImpl:TUsesList; 261 | Comments:TArray; 262 | GlobalVars:TVariableList; 263 | GlobalArrays1D:TArray; 264 | GlobalArrays2D:TArray; 265 | Enums:TArray; 266 | Classes:TArray; 267 | ImplementationVars:TVariableList; 268 | &Initialization:TCode; 269 | &Finalization:TCode; 270 | CaseStatements:TArray; 271 | Defines:TStringList; 272 | constructor Create(aOwner:TPascalElement);override; 273 | destructor Destroy;override; 274 | function getClassByName(s:string):TClassDef; 275 | function AddClass(c:TClassDef):TClassDef; 276 | function ToString:string; override; 277 | function ToPascal:string;override; 278 | end; 279 | 280 | TLoopOperator=(EQ,LT,LT_EQ,GT,GT_EQ); 281 | TLoop=class(TPascalElement) 282 | type 283 | TDir=(up,down); 284 | var 285 | IndexerVar:TVariable; 286 | Op:TLoopOperator; 287 | Dir:TLoop.TDir; 288 | StartVal,EndVal:string; 289 | function ToPascal:string;override; 290 | end; 291 | 292 | function Esc(Keyword:string):string; 293 | 294 | implementation 295 | 296 | uses System.RegularExpressions, SysUtils, Math; 297 | 298 | function Esc(Keyword:string):string; 299 | var 300 | I: Integer; 301 | begin 302 | Keyword := Keyword.Replace('*',''); 303 | 304 | for I := 0 to High(Keywords) do 305 | if SameText(Keywords[I],Keyword) then 306 | Exit('&'+Keyword); 307 | 308 | Exit(Keyword); 309 | end; 310 | 311 | function MakePascalCase(const aString:String):String; 312 | var 313 | I:Integer; 314 | const 315 | Chars=[' ','-','_','/','\','&','*','|','(',')','[',']','{','}','.',';',',','<','>']; 316 | begin 317 | if aString='' then 318 | Exit; 319 | 320 | Result := UpCase(aString[1]); 321 | 322 | for I := 2 to Length(aString) do 323 | if CharInSet(aString[I-1], Chars) then 324 | Result := Result + UpCase(aString[I]) 325 | else 326 | Result := Result + aString[I]; 327 | 328 | for I := Length(Result) downto 1 do 329 | if CharInSet(Result[I],Chars) then 330 | Delete(Result,I,1); 331 | end; 332 | 333 | 334 | 335 | constructor TVariable.Create(AOwner:TPascalElement; aName, aType: string;aDir:TDir=TDir.none;aIsStatic:Boolean=false; aHasValue:Boolean=false;aValue:string='';aComment:string=''); 336 | begin 337 | inherited Create(AOwner); 338 | 339 | FName := aName.Trim; 340 | FType := aType.Trim; 341 | FDir := aDir; 342 | FIsStatic := aIsStatic; 343 | FHasValue := aHasValue; 344 | FValue := aValue.Trim; 345 | FComment := aComment; 346 | 347 | 348 | if FHasValue then 349 | if FType<>'' then 350 | if FDir = TDir.&in then 351 | begin 352 | // found a const variable declaration, with a type. 353 | if FType = 'integer' then FType := '' else 354 | if FType = 'double' then FType := '' else 355 | if FType = 'float' then FType := '' else 356 | if FType = 'single' then FType := '' else 357 | if FType = 'byte' then FType := '' else 358 | if FType = 'int64' then FType := '' else 359 | if FType = 'cardinal' then FType := '' else 360 | FDir := TDir.inout; 361 | end; 362 | end; 363 | 364 | function TVariable.ToPascal: String; 365 | begin 366 | Result := Esc(FName); 367 | if FType<>'' then Result := Result + ':' + Esc(FType); 368 | if FHasValue then Result := Result + ' = '+ FValue; 369 | if FComment<>'' then Result := Result + '{ '+FComment+' }'; 370 | end; 371 | 372 | function TVariable.ToString: string; 373 | begin 374 | REsult := FName + ': ' + FType; 375 | end; 376 | 377 | { TVariableList } 378 | 379 | function TVariableList.getLongestName: integer; 380 | var 381 | I,l: Integer; 382 | begin 383 | Result := 0; 384 | for I := 0 to Count-1 do 385 | begin 386 | l := length(esc(FChildren[I].Name)); 387 | if l > Result then 388 | Result := l; 389 | end; 390 | 391 | end; 392 | 393 | function TVariableList.ToPascal(indent:Boolean): String; 394 | var longest,i:integer; 395 | align:boolean; 396 | Prev,Curr,Next:TVariable; 397 | begin 398 | Result := ''; 399 | longest := getLongestName; 400 | 401 | align := true; 402 | // don't align single row list (as used in function parameters) 403 | if not indent then 404 | align := false; 405 | 406 | // don't align if we only have really short names 407 | if getLongestName < 8 then 408 | Align := false; 409 | 410 | // if we have a single item, don't bother aligning.. 411 | if self.Count<2 then 412 | Align := false; 413 | 414 | Prev := nil; 415 | Next := nil; 416 | // combine consecutive parameters of the same type wherever possible 417 | for i := 0 to Count - 1 do 418 | begin 419 | if I > 0 then 420 | Prev := TVariable( FChildren[i - 1] ); 421 | Curr := TVariable( FChildren[i ] ); 422 | if I < Count-1 then 423 | Next := TVariable( FChildren[i + 1] ); 424 | 425 | 426 | if Indent then 427 | if (I=0) 428 | or (Prev.Visibility <> 429 | Curr.Visibility) then 430 | begin 431 | if Curr.Visibility<>TVisibility.DefaultVisibility then 432 | Result := Result + cVisibility[Curr.Visibility] + sLineBreak+ ' '; 433 | end; 434 | 435 | // for the first in a series, write the direction if given 436 | if (I = 0) 437 | or (Prev.Dir <> Curr.Dir) 438 | or (Prev.&Type <> Curr.&Type) then 439 | begin 440 | if Indent then 441 | if I = 0 then 442 | if Curr.Dir = TDir.none then 443 | if Result.Trim = '' then 444 | Result := cDirPascal[TDir.inout] + sLineBreak + ' ' 445 | else 446 | Result := Result + cDirPascal[TDir.inout] + sLineBreak + ' '; 447 | 448 | if (I=0) or (Prev.Dir <> Curr.Dir) then 449 | if (I=0) then 450 | Result := cDirPascal[Curr.Dir] 451 | else 452 | if Indent then 453 | // switched from list of consts to vars 454 | Result := Result.Trim + sLineBreak +sLineBreak +'' + cDirPascal[Curr.Dir] 455 | else 456 | Result := Result.Trim + cDirPascal[Curr.Dir]; 457 | 458 | 459 | if not Indent then 460 | Result := Result + ' ' 461 | else 462 | if cDirPascal[Curr.Dir] <> '' then 463 | Result := Result.TrimRight + sLineBreak + ' '; 464 | end; 465 | 466 | // if the next argument is of another type or direction, write the type 467 | if i < Count - 1 then 468 | if (Next.dir = Curr.dir) then 469 | if (Next.&Type = Curr.&Type) then 470 | if not Curr.HasValue then 471 | begin 472 | Result := Result + Esc(Curr.FName.Trim) + ', '; 473 | if align then 474 | Result := Result + sLineBreak+' '; 475 | continue; 476 | end; 477 | 478 | 479 | if Align then 480 | Result := Result +copy(Esc(Curr.FName)+ StringOfChar(' ',longest) ,1,longest) 481 | else 482 | Result := Result + Esc(Curr.FName); 483 | 484 | if Curr.&Type<>'' then 485 | begin 486 | Result := Result + ' : '; 487 | 488 | if Curr.&Type='^' then 489 | Result := Result + 'pointer' 490 | else 491 | begin 492 | if Curr.FName.StartsWith('*') then 493 | Result := Result + '^'; 494 | 495 | Result := Result + Esc(Curr.&Type); 496 | end; 497 | end; 498 | 499 | if Curr.HasValue then 500 | Result := Result + ' = '+ Curr.Value; 501 | 502 | if Curr.Comment<>'' then 503 | Result := Result + ' { '+ Curr.Comment + ' } '; 504 | 505 | // add a separator, unless it's the last argument 506 | if i < Count - 1 then 507 | begin 508 | Result := Result + ';'; 509 | if Align then 510 | Result := REsult+sLineBreak+' '; 511 | 512 | end; 513 | end; 514 | 515 | Result := Result.Replace(', ',', '); 516 | 517 | if Indent then 518 | begin 519 | if not Result.Trim.EndsWith(';') then 520 | Result := Result.Trim + ';'; 521 | 522 | Result := Result +sLineBreak; 523 | end; 524 | 525 | end; 526 | 527 | { TRoutine } 528 | 529 | procedure TRoutine.Cleanup; 530 | begin 531 | if Assigned(Code) then 532 | Code.Cleanup; 533 | end; 534 | 535 | constructor TRoutine.Create( 536 | aOwner:TPascalElement; 537 | aName:String; 538 | aClassName:string; 539 | aRoutineType:TRoutineType; 540 | aReturnType:string; 541 | aParameters:TVariableList; 542 | aLocalVars:TVariableList; 543 | aCode:TCode; 544 | aOverride:Boolean=false; 545 | aOverload:Boolean=false; 546 | aInline:Boolean=false; 547 | aStatic:Boolean=false; 548 | aVirtual:Boolean=false; 549 | aComment:string=''); 550 | begin 551 | inherited Create(aOwner); 552 | 553 | Sourceinfo := default(TSourceInfo); 554 | FName := aName ; 555 | ClassName := aclassName ; 556 | RoutineType := aRoutineType ; 557 | ReturnType := aReturnType ; 558 | if ReturnType='' then 559 | if RoutineType = TRoutineType.&function then 560 | RoutineType := TRoutineType.&procedure; 561 | if ReturnType='void' then 562 | RoutineType := TRoutineType.&procedure; 563 | 564 | Parameters := aParameters ; 565 | aParameters.SetOwner(self); 566 | LocalVars := aLocalVars ; 567 | LocalVars.SetOwner(self); 568 | Code := aCode ; 569 | Code.SetOwner(self); 570 | &Override := aOverride ; 571 | &Overload := aOverload ; 572 | &Inline := aInline ; 573 | &Static := aStatic ; 574 | &Virtual := aVirtual ; 575 | Comment := aComment ; 576 | Visibility := TVisibility.DefaultVisibility; 577 | end; 578 | 579 | function TRoutine.Equals(Obj: TObject): Boolean; 580 | var r:TRoutine; i:Integer; 581 | begin 582 | if not (Obj is TRoutine) then 583 | Exit(False); 584 | 585 | if Obj=self then 586 | Exit(True); 587 | 588 | r := TRoutine(Obj); 589 | if not SameText(r.Name,Self.Name) then 590 | Exit(False); 591 | 592 | if r.Parameters.Count<>Self.Parameters.Count then 593 | Exit(False); 594 | 595 | for I := 0 to self.Parameters.Count-1 do 596 | begin 597 | if not SameText(Parameters[I].Name, r.Parameters[I].Name) then 598 | Exit(False); 599 | if not SameText(TVariable(Parameters[I]).&Type, TVariable(r.Parameters[I]).&Type) then 600 | Exit(False); 601 | end; 602 | Exit(True); 603 | 604 | end; 605 | 606 | function TRoutine.ToDeclarationPascal: String; 607 | var sl:TStringBuilder; s:string; 608 | begin 609 | sl := TStringBuilder.Create; 610 | try 611 | if Trim(Comment) <> '' then 612 | begin 613 | sl.AppendLine(' /// '); 614 | for s in Comment.Split([sLineBreak]) do 615 | sl.AppendLine(' /// '+s); 616 | sl.AppendLine(' /// '); 617 | end; 618 | 619 | sl.Append(' '); 620 | if &Static then 621 | if (FOwner=nil) or (TClassDef(FOwner).FKind <> TClassKind.&unit) then 622 | sl.Append('class '); 623 | sl.Append(cRoutineType[RoutineType]); 624 | sl.Append(' '); 625 | sl.Append(Esc(self.FName)); 626 | if Parameters.Count > 0 then 627 | sl.Append( '(' + Parameters.ToPascal(false)+ ')' ); 628 | 629 | if Self.RoutineType=TRoutineType.&function then 630 | sl.Append(':'+Self.ReturnType); 631 | 632 | if sl.ToString.Trim<>';' then 633 | sl.Append(';'); 634 | 635 | if &Override then sl.Append('override;'); 636 | if &Overload then sl.Append('overload;'); 637 | if &Inline then sl.Append('inline;'); 638 | if &Static then 639 | if (FOwner=nil) or (TClassDef(FOwner).FKind <> TClassKind.&unit) then 640 | sl.Append('static;'); 641 | if &Virtual then sl.Append('virtual;'); 642 | 643 | Result := sl.ToString; 644 | finally 645 | sl.Free; 646 | end; 647 | end; 648 | 649 | 650 | function TRoutine.ToImplementationPascal(aClassName: string): String; 651 | var sl:TStringBuilder; s:string; 652 | // c: string; 653 | begin 654 | sl := TStringBuilder.Create; 655 | try 656 | 657 | if Comment.Trim<>'' then 658 | begin 659 | sl.AppendLine('/// '); 660 | for s in Comment.Split([sLineBreak]) do 661 | sl.AppendLine('/// '+s); 662 | sl.AppendLine('/// '); 663 | end; 664 | 665 | sl.Append(cRoutineType[RoutineType]); 666 | sl.Append(' '); 667 | 668 | if aClassName<>'' then 669 | if Esc(aClassName)<>'TGlobal' then 670 | sl.Append(Esc(aClassName) + '.'); 671 | sl.Append(Esc(self.FName)); 672 | if Parameters.Count > 0 then 673 | sl.Append( '(' + Parameters.ToPascal(false) + ')' ); 674 | 675 | if Self.RoutineType=TRoutineType.&function then 676 | sl.Append(':'+Self.ReturnType); 677 | 678 | sl.Append(';'); 679 | if &Overload then sl.Append('overload;'); 680 | if &Inline then sl.Append('inline;'); 681 | sl.AppendLine; 682 | 683 | if self.LocalVars.Count>0 then 684 | sl.Append( LocalVars.ToPascal(true) ); 685 | 686 | sl.AppendLine( 'begin'); 687 | 688 | Code.Cleanup; 689 | Code.Align; 690 | 691 | code.Renderinfo.Position := sl.Length+1; 692 | sl.AppendLine(code.ToPascal); 693 | code.Renderinfo.Length := sl.Length - code.Renderinfo.Position ; 694 | 695 | sl.AppendLine( 'end;'); 696 | Result := sl.ToString; 697 | finally 698 | sl.Free; 699 | end; 700 | end; 701 | 702 | function TRoutine.ToString: string; 703 | begin 704 | Result := FName+'( )'; 705 | end; 706 | 707 | { TClassDef } 708 | 709 | function TClassDef.AddRoutine(const m: TRoutine):Boolean; 710 | var i:integer; 711 | begin 712 | Result := True; 713 | for I := 0 to high(FMethods) do 714 | begin 715 | if SameText(FMethods[I].Name ,m.Name) then 716 | begin 717 | FMethods[I].Overload := True; 718 | m.Overload := True; 719 | end; 720 | 721 | if FMethods[I].Equals(m) then 722 | begin 723 | Result := False; 724 | Break; 725 | end; 726 | end; 727 | 728 | if Result then 729 | FMethods := FMethods + [m] 730 | else 731 | if FMethods[I].Visibility = DefaultVisibility then 732 | FMethods[I].Visibility := m.Visibility; 733 | end; 734 | 735 | 736 | constructor TClassDef.Create(aOwner:TPascalElement; aTypename: string; aMembers: TVariableList;aKind:TClassKind); 737 | begin 738 | inherited Create(aOwner); 739 | 740 | FKind := aKind; 741 | FIsPacked := false; 742 | 743 | FConsts := TVariableList.Create(self); 744 | FConsts.Name := 'Consts'; 745 | 746 | if aMembers=nil then 747 | FMembers := TVariableList.Create(self) 748 | else 749 | FMembers := aMembers; 750 | 751 | FMembers.Name := 'Members'; 752 | FMembers.FOwner := self; 753 | 754 | FName := aTypename; 755 | FIsPacked := false; 756 | 757 | end; 758 | 759 | function TClassDef.getMethodByName(const n: string): TRoutine; 760 | var 761 | r: TRoutine; 762 | begin 763 | Result := nil; 764 | for r in self.FMethods do 765 | if SameText(r.FName,n) then 766 | Exit(r); 767 | end; 768 | 769 | function TClassDef.ToPascalDeclaration: string; 770 | var sl:TStringList; 771 | m,n: TRoutine; 772 | begin 773 | sl := TStringList.Create; 774 | try 775 | 776 | if FKind <> TClassKind.&unit then 777 | sl.Add('type'); 778 | 779 | case FKind of 780 | &class : 781 | if FParentType='' then 782 | sl.Add(Esc(FName) + ' = class') 783 | else 784 | sl.Add(Esc(FName) + ' = class('+FParentType.Trim +')'); 785 | &record : 786 | begin 787 | if FIsPacked then 788 | sl.Add(Esc(FName) + ' = packed record') 789 | else 790 | sl.Add(Esc(FName) + ' = record'); 791 | end; 792 | &object : sl.Add(Esc(FName) + ' = object('+FParentType.Trim+')'); 793 | &unit : ; 794 | end; 795 | 796 | 797 | if FConsts.Count>0 then 798 | begin 799 | sl.Add('const'); 800 | sl.Add( FConsts.ToPascal(true) ); 801 | end; 802 | 803 | if FMembers.Count>0 then 804 | begin 805 | if FConsts.Count>0 then 806 | begin 807 | sl.Add(''); 808 | sl.Add('var'); 809 | end; 810 | sl.Add( FMembers.ToPascal(true).TrimRight ); 811 | end; 812 | 813 | for m in FMethods do 814 | for n in FMethods do 815 | if m <> n then 816 | if m.Name = n.Name then 817 | begin 818 | m.Overload := True; 819 | n.Override := True; 820 | end; 821 | 822 | for m in FMethods do 823 | sl.Add(m.ToDeclarationPascal); 824 | 825 | 826 | if self.FKind <> &unit then 827 | sl.Add( 'end;'); 828 | 829 | result := sl.Text; 830 | finally 831 | sl.Free; 832 | end; 833 | end; 834 | 835 | function TClassDef.ToPascalImplementation: string; 836 | var m:TRoutine; sl:TStringList; 837 | begin 838 | sl := TStringList.Create; 839 | try 840 | if length(FMethods)=0 then 841 | Exit(''); 842 | 843 | if self.FKind<>&unit then 844 | begin 845 | sl.Add( format('{ %s }',[self.FName]) ); 846 | sl.Add('' ); 847 | end; 848 | 849 | for m in FMethods do 850 | begin 851 | m.Renderinfo.Position := sl.Text.Length+1; 852 | sl.Add(m.ToImplementationPascal( FName )); 853 | m.Code.Renderinfo.Position := m.Code.Renderinfo.Position + m.Renderinfo.Position; 854 | m.Renderinfo.Length := sl.Text.Length - m.Renderinfo.Position-1; 855 | sl.Add(''); 856 | end; 857 | 858 | Result := sl.Text; 859 | finally 860 | sl.free; 861 | end; 862 | 863 | end; 864 | 865 | 866 | 867 | 868 | function TClassDef.ToString: string; 869 | begin 870 | if Self.FKind=&unit then 871 | Result := 'Global' 872 | else 873 | Result := cClassKind[ self.FKind ] + ' ' + FName; 874 | end; 875 | 876 | { TCode } 877 | 878 | 879 | procedure TCode.Add(const s: String); 880 | begin 881 | Lines.Add(s); 882 | end; 883 | 884 | procedure DoAlign(Lines:TList; var p:integer; aFirstLine,aLastLine,MaxPos:integer); 885 | var J,t: Integer; s,oldLine:string; 886 | begin 887 | if MaxPos>0 then 888 | begin 889 | for J := aFirstLine to aLastLine do 890 | begin 891 | oldLine := Lines[J]; 892 | t := Pos(':=',OldLine); 893 | s := StringOfChar(' ', MaxPos-t); 894 | if P>3 then 895 | Insert(s,OldLine,t); 896 | Lines[J] := OldLine; 897 | end; 898 | end; 899 | end; 900 | 901 | procedure TCode.Align; 902 | var 903 | Line:string; i,First,Last:integer; 904 | p,maxPos:integer; 905 | begin 906 | First := -1; 907 | Last := -1; 908 | MaxPos := -1; 909 | for I := 0 to Lines.Count-1 do 910 | begin 911 | Line := Lines[I]; 912 | P := Pos(':=',Line); 913 | if (P>0) and (not Line.Contains('for')) then 914 | begin 915 | if maxPos<0 then 916 | First := i; 917 | MaxPos := Max(maxPos,P); 918 | Last := i; 919 | end 920 | else 921 | begin 922 | DoAlign(Lines,P,First,last,maxPos); 923 | P := -1; 924 | First := -1; 925 | MaxPos := -1; 926 | end; 927 | end; 928 | if MaxPos>0 then 929 | DoAlign(Lines,p,First,last,maxPos); 930 | end; 931 | 932 | procedure TCode.Cleanup; 933 | var i,j:integer; 934 | line:string; 935 | begin 936 | // clean code 937 | j := 0; 938 | for I := 0 to Lines.Count-1 do 939 | begin 940 | line := Lines[I]; 941 | if line='' then 942 | Continue; 943 | 944 | line := line.Replace(#9,' '); 945 | if line.Trim<>'' then 946 | begin 947 | if lines.Count>1 then 948 | begin 949 | if I=0 then 950 | if line.Trim='begin' then 951 | Continue; 952 | 953 | if I=lines.Count-1 then 954 | if line.StartsWith('end') then 955 | Continue; 956 | end; 957 | 958 | lines[J] := line; 959 | inc(J); 960 | end; 961 | end; 962 | for I := Lines.Count-1 downto J do 963 | Lines.Delete(I); 964 | end; 965 | 966 | procedure TPascalElement.SetDefaultVisible; 967 | procedure SetVisible(const el:TPascalElement); 968 | var i:integer; 969 | begin 970 | if el = nil then 971 | Exit; 972 | 973 | if el is TVariableList then 974 | if el.Count=0 then 975 | el.Visible := False; 976 | 977 | if el is TCode then 978 | if el.Count=0 then 979 | el.Visible := False; 980 | 981 | if el is TUsesList then 982 | if el.Count=0 then 983 | el.Visible := False; 984 | 985 | if el.Owner<>nil then 986 | if not el.Owner.Visible then 987 | el.Visible := False; 988 | 989 | for I := 0 to el.Count-1 do 990 | SetVisible(el.FChildren[i]); 991 | end; 992 | 993 | begin 994 | SetVisible(self); 995 | end; 996 | 997 | constructor TCode.Create(aOwner:TPascalElement;c: TArray); 998 | begin 999 | inherited Create(aOwner); 1000 | 1001 | Lines := TList.Create; 1002 | Lines.InsertRange(0,c); 1003 | end; 1004 | 1005 | destructor TCode.Destroy; 1006 | begin 1007 | Lines.Free; 1008 | inherited; 1009 | end; 1010 | 1011 | function TCode.GetLineCount: integer; 1012 | begin 1013 | Result := Lines.Count 1014 | end; 1015 | 1016 | function TCode.ToPascal: String; 1017 | begin 1018 | Result := string.join(sLineBreak, Lines.ToArray ); 1019 | end; 1020 | 1021 | 1022 | 1023 | { TPascalUnit } 1024 | 1025 | function TPascalUnit.AddClass(c: TClassDef):TClassDef; 1026 | begin 1027 | Classes := Classes + [c]; 1028 | Result := c; 1029 | end; 1030 | 1031 | constructor TPascalUnit.Create(aOwner:TPascalElement); 1032 | begin 1033 | inherited Create(aOwner); 1034 | 1035 | Defines := TStringList.Create; 1036 | 1037 | usesListIntf := TUsesList.Create(self); 1038 | usesListImpl := TUsesList.Create(self); 1039 | 1040 | &Initialization := TCode.Create(self,[]); 1041 | &Initialization.FName := 'Initialization'; 1042 | &Finalization := TCode.Create(self,[]); 1043 | &Finalization.FName := 'Finalization'; 1044 | 1045 | GlobalVars := TVariableList.Create(self); 1046 | GlobalVars.FName := 'Global vars'; 1047 | ImplementationVars := TVariableList.Create(self); 1048 | ImplementationVars.FName := 'Impl vars'; 1049 | end; 1050 | 1051 | 1052 | 1053 | destructor TPascalUnit.Destroy; 1054 | begin 1055 | Defines.Free; 1056 | inherited; 1057 | end; 1058 | 1059 | function TPascalUnit.getClassByName(s: string): TClassDef; 1060 | var I:Integer; 1061 | begin 1062 | for I := 0 to high(self.Classes) do 1063 | if SameText( Classes[i].FName, s) then 1064 | Exit( classes[I] ); 1065 | 1066 | if SameText(s,'TGlobal') then 1067 | Result := TClassDef.Create(Self,s,nil,TClassKind.&unit) 1068 | else 1069 | if s.ToLower.EndsWith('rec') then 1070 | Result := TClassDef.Create(Self,s,nil,TClassKind.&record) 1071 | else 1072 | Result := TClassDef.Create(Self,s,nil,TClassKind.&class); 1073 | 1074 | Self.AddClass(Result); 1075 | end; 1076 | 1077 | function TPascalUnit.toPascal: string; 1078 | var 1079 | sl:TStringList; 1080 | c:TClassDef; 1081 | ar: TArrayDef1D; 1082 | ar2: TArrayDef2D; 1083 | e: TEnumDef; 1084 | isProgram:Boolean; 1085 | g:TClassDef; 1086 | o:Integer; 1087 | m:TRoutine; 1088 | begin 1089 | sl := TStringList.Create; 1090 | 1091 | g := Self.getClassByName('TGlobal'); 1092 | 1093 | // if the code contains a 'main' function, we probably want to generate 1094 | // a program instead of a unit. 1095 | isProgram := (g <> nil) and (g.getMethodByName('main') <> nil); 1096 | 1097 | // if no name is set, try to base it on a class name in the unit. 1098 | if FName='' then 1099 | begin 1100 | FName := 'tmp'; 1101 | for c in classes do 1102 | if c.FName<>'TGlobal' then 1103 | begin 1104 | FName := c.FName; 1105 | if string(FName).StartsWith('T') then 1106 | FName:= string(FName).TrimLeft(['T']); 1107 | break; 1108 | end; 1109 | end; 1110 | 1111 | if isProgram then 1112 | sl.Add('program '+MakePascalCase(FName)+';') 1113 | else 1114 | sl.Add('unit '+MakePascalCase(FName)+';'); 1115 | 1116 | sl.Add(''); 1117 | 1118 | if not isProgram then 1119 | begin 1120 | sl.Add('interface'); 1121 | sl.Add(''); 1122 | end; 1123 | 1124 | sl.Add(usesListIntf.ToPascal); 1125 | 1126 | for e in enums do 1127 | sl.Add( e.ToPascal ); 1128 | 1129 | for c in classes do 1130 | if ((not isProgram) or (g.FKind<>&unit)) or (c.FKind=TClassKind.&record) then 1131 | begin 1132 | assert(assigned(c)); 1133 | c.Renderinfo.Position := length(sl.Text)+1; 1134 | sl.Add(c.ToPascalDeclaration); 1135 | c.Renderinfo.Length := length(sl.Text)-c.Renderinfo.Position; 1136 | end; 1137 | 1138 | 1139 | if GlobalVars.Count>0 then 1140 | sl.Add(GlobalVars.ToPascal(true)); 1141 | 1142 | 1143 | if length(self.GlobalArrays1D)>0 then 1144 | begin 1145 | sl.Add('const'); 1146 | for ar in self.GlobalArrays1D do 1147 | begin 1148 | ar.Renderinfo.Position := sl.Text.Length+1; 1149 | sl.Add(ar.ToPascal); 1150 | ar.Renderinfo.Length := sl.Text.Length - ar.Renderinfo.Position ; 1151 | end; 1152 | end; 1153 | 1154 | if length(self.GlobalArrays2D)>0 then 1155 | begin 1156 | sl.Add('const'); 1157 | for ar2 in self.GlobalArrays2D do 1158 | begin 1159 | ar2.Renderinfo.Position := sl.Text.Length+1; 1160 | sl.Add(ar2.ToPascal); 1161 | ar2.Renderinfo.Length := sl.Text.Length - ar2.Renderinfo.Position ; 1162 | end; 1163 | end; 1164 | 1165 | if not isProgram then 1166 | begin 1167 | sl.Add('implementation'); 1168 | sl.Add(''); 1169 | end; 1170 | 1171 | sl.Add(usesListImpl.ToPascal); 1172 | 1173 | for c in classes do 1174 | begin 1175 | o := sl.Text.Length; 1176 | sl.Add(c.ToPascalImplementation); 1177 | for m in c.FMethods do 1178 | m.Renderinfo.Position := m.Renderinfo.Position + o; 1179 | end; 1180 | sl.Add(''); 1181 | 1182 | if not isProgram then 1183 | if (Self.&Initialization.Count > 0) or (Self.&Finalization.Count > 0) then 1184 | begin 1185 | sl.Add('initialization'); 1186 | sl.Add(Self.&Initialization.ToPascal); 1187 | sl.Add(''); 1188 | sl.Add('finalization'); 1189 | sl.Add(Self.&Finalization.ToPascal); 1190 | sl.Add(''); 1191 | end; 1192 | 1193 | if isProgram then 1194 | begin 1195 | sl.Add('begin'); 1196 | sl.Add(' try'); 1197 | sl.Add(' Main;'); 1198 | sl.Add(' except'); 1199 | sl.Add(' on e:Exception do'); 1200 | sl.Add(' WriteLn(e.Message);'); 1201 | sl.Add(' end;'); 1202 | end; 1203 | 1204 | sl.Add('end.'); 1205 | result := sl.Text; 1206 | sl.Free; 1207 | end; 1208 | 1209 | 1210 | 1211 | 1212 | 1213 | function TPascalUnit.ToString: string; 1214 | begin 1215 | if FName='TGlobal' then 1216 | Exit('{global}'); 1217 | 1218 | Result := 'Unit '+ FName 1219 | end; 1220 | 1221 | { TArrayDef } 1222 | 1223 | function TArrayDef1D.ToPascal: string; 1224 | var elms : string; i:integer; it:TArray; 1225 | begin 1226 | setlength(it,length(items)); 1227 | for i := 0 to high(items) do 1228 | begin 1229 | it[i] := items[i]; 1230 | if it[i].EndsWith('.') then 1231 | it[i] := it[i] + '0'; 1232 | if it[i].StartsWith('.') then 1233 | it[i] := '0'+it[i]; 1234 | 1235 | end; 1236 | 1237 | elms := ''.Join(', ', it); // concat all elements into a comma separated string 1238 | elms := TRegEx.Replace(elms,'0[xX]([\da-fA-F]+)' ,'\$\1',[ roMultiLine ]); // convert possible hex to pascal hex 1239 | elms := elms.Replace('/*','{').Replace('*/','}'); 1240 | elms := WrapText(elms,sLineBreak+' ',[','],70); // wrap long lines 1241 | 1242 | Result := 1243 | format( ' %s : array[0..%d] of %s = ('+sLineBreak+' %s );'+sLineBreak,[ 1244 | FName, 1245 | length(Items)-1, 1246 | itemType, 1247 | elms 1248 | ]); 1249 | 1250 | end; 1251 | 1252 | { TLoop } 1253 | 1254 | function TLoop.toPascal: string; 1255 | var v:string;t:integer; 1256 | const cLoopDir:array[TLoop.TDir] of string=('to','downto'); 1257 | begin 1258 | case Op of 1259 | LT : if TryStrToInt(EndVal, t) then 1260 | v := IntToStr(t - 1) 1261 | else 1262 | v := EndVal + '-1'; 1263 | 1264 | LT_EQ : v := EndVal; 1265 | 1266 | GT : if TryStrToInt(EndVal, t) then 1267 | v := IntToStr(t + 1) 1268 | else 1269 | v := EndVal + '+1'; 1270 | 1271 | GT_EQ : v := EndVal; 1272 | 1273 | EQ : v := EndVal; 1274 | end; 1275 | 1276 | Result := Format('for %s := %s %s %s do', [ 1277 | IndexerVar.FName, // for XX 1278 | StartVal, // := XX 1279 | cloopDir[self.Dir], // to/downto 1280 | v // XX 1281 | ]); 1282 | 1283 | end; 1284 | 1285 | 1286 | { TUsesList } 1287 | 1288 | constructor TUsesList.Create(aOwner:TPascalElement); 1289 | begin 1290 | inherited Create(aOwner); 1291 | self.&Unit := aOwner as TPascalUnit; 1292 | end; 1293 | 1294 | procedure TUsesList.AddUnit(const s: string); 1295 | var el:TPascalElement; 1296 | begin 1297 | if &unit<>nil then 1298 | if SameText(s,&Unit.FName) then 1299 | exit; 1300 | 1301 | for el in FChildren do 1302 | if SameText(s,el.Name) then 1303 | Exit; 1304 | 1305 | el := TUsesListItem.Create(self); 1306 | el.Name := s; 1307 | end; 1308 | 1309 | function TUsesList.ToPascal: string; 1310 | var units:TArray; el:TPascalElement; 1311 | begin 1312 | Result := ''; 1313 | Units := []; 1314 | for el in FChildren do 1315 | Units := Units + [el.Name]; 1316 | 1317 | if Count>0 then 1318 | begin 1319 | Result := 'uses '+string.join(', ', Units)+';'; 1320 | Result := WrapText(Result, sLineBreak + ' ', [',',' ',#13,#10], 80 )+sLineBreak; 1321 | end; 1322 | end; 1323 | 1324 | { TEnumDef } 1325 | 1326 | 1327 | function FormatInt(i:int64):string; 1328 | var h,d:string; 1329 | begin 1330 | h := IntToHex(i,1); 1331 | d := IntToStr(i); 1332 | if h.TrimRight(['0']).Length < 1333 | d.TrimRight(['0']).Length then 1334 | Result := HexDisplayPrefix + h 1335 | else 1336 | Result := d; 1337 | end; 1338 | 1339 | 1340 | function TEnumDef.ToPascal: string; 1341 | var 1342 | a:TArray; nl,vl,i:integer; 1343 | begin 1344 | nl := 0; vl := 0; 1345 | for I := 0 to high(Items) do 1346 | begin 1347 | if Items[I].Name.Length > nl then 1348 | nl := Items[I].Name.Length; 1349 | 1350 | if FormatInt( Items[I].Value ).Length > vl then 1351 | vl := FormatInt( Items[I].Value ).length; 1352 | end; 1353 | 1354 | for I := 0 to high(Items) do 1355 | begin 1356 | Items[I].MaxNameLen := nl; 1357 | Items[I].MaxValueLen := vl; 1358 | end; 1359 | 1360 | // we could get an anonymous enum type 1361 | // we'll convert it to a list of consts 1362 | if FName='' then 1363 | begin 1364 | setlength(a,length(Items)); 1365 | for I := 0 to high(Items) do 1366 | a[I] := Items[I]; 1367 | 1368 | Exit(' '+''.Join(';'+sLineBreak+' ',a )+sLineBreak); 1369 | end; 1370 | 1371 | 1372 | setlength(a,length(Items)); 1373 | for I := 0 to high(Items) do 1374 | a[I] := Items[I]; 1375 | 1376 | Result := ' '+ Esc(FName) +' = (' + sLineBreak + 1377 | ' '+ ''.Join(','+sLineBreak+' ',a ) + 1378 | ');'+sLineBreak; 1379 | end; 1380 | 1381 | { TEnumItem } 1382 | 1383 | class operator TEnumItem.implicit(const e: TEnumItem): string; 1384 | var v:string; 1385 | begin 1386 | Result := copy(Esc(e.Name)+StringOfChar(' ',e.MaxNameLen),1,e.MaxNameLen); 1387 | // if e.Index<>e.Value then 1388 | begin 1389 | v := FormatInt( e.Value ); 1390 | Result:= Result + ' = ' + StringOfChar(' ',e.MaxValueLen - v.Length) + v; 1391 | end; 1392 | 1393 | if e.Comment <> '' then 1394 | Result := Result + ' { ' + e.Comment +' }'; 1395 | end; 1396 | 1397 | { TSourceInfo } 1398 | 1399 | constructor TSourceInfo.Create(aPosition, aLength: integer); 1400 | begin 1401 | Position := aPosition; 1402 | Length := aLength ; 1403 | end; 1404 | 1405 | { TArrayDef2D } 1406 | 1407 | function TArrayDef2D.ToPascal: string; 1408 | var elms : string;a,b:TArray; 1409 | begin 1410 | b := []; 1411 | for a in Items do 1412 | begin 1413 | elms := ''.Join(', ', a); // concat all elements into a comma separated string 1414 | elms := TRegEx.Replace(elms,'0[xX]([\da-fA-F]+)' ,'\$\1',[ roMultiLine ]); // convert possible hex to pascal hex 1415 | elms := elms.Replace('/*','{').Replace('*/','}'); 1416 | elms := WrapText(elms,sLineBreak+' ',[','],200); // wrap long lines 1417 | b := b + ['('+elms+')']; 1418 | end; 1419 | 1420 | if length(items)>0 then 1421 | Result := 1422 | format( ' %s : array[0..%d,0..%d] of %s = ('+sLineBreak+' ',[ 1423 | FName, 1424 | length(Items)-1, 1425 | length(Items[0])-1, 1426 | itemType 1427 | ]); 1428 | 1429 | Result := Result + ''.join(','+sLineBreak+' ',b); 1430 | 1431 | Result := Result + ');'+sLineBreak; 1432 | end; 1433 | 1434 | procedure TCase.SetCode(const Value: TCode); 1435 | begin 1436 | FCode := Value; 1437 | FCode.SetOwner(self); 1438 | end; 1439 | 1440 | function TCase.ToPascal(aIndent:integer=6; aAlign:integer=0):string; 1441 | var codelines:TArray; 1442 | I: Integer; 1443 | indent:string; 1444 | const 1445 | MaxAlign=15; 1446 | begin 1447 | Indent := StringOfChar(' ',aindent); 1448 | // remove break if it's the last statement: 1449 | codeLines := code.Lines.ToArray; 1450 | // remove break.. not needed in pascal 1451 | if length(codelines)>0 then 1452 | if codelines[high(codelines)].startswith('break') then 1453 | setlength(codelines,length(codelines)-1); 1454 | 1455 | codeLines := string.Join(';',codelines).Trim.Split([sLineBreak]); 1456 | 1457 | 1458 | aAlign := min(MaxAlign, aAlign); 1459 | if Id.Length>MaxAlign then 1460 | Result := Indent + ' '+self.Id 1461 | else 1462 | Result := Indent + ' '+copy(Id+ StringOfChar(' ',50) ,1, aAlign); 1463 | 1464 | if not SameText(id,'else') then 1465 | Result := Result + ':'; 1466 | 1467 | Result := Result + ' '; 1468 | 1469 | case Length(codelines) of 1470 | 0: Result := Result + ';' + sLineBreak; 1471 | 1: Result := Result + codelines[0] + ';' + sLineBreak; 1472 | else 1473 | begin 1474 | Result := Result + sLineBreak + 1475 | Indent+' begin' + sLineBreak; 1476 | 1477 | for I := 0 to high(codelines) do 1478 | Result := Result + Indent + ' '+codelines[I].Trim+ sLineBreak; 1479 | 1480 | Result := Result + Indent+' end;' + sLineBreak; 1481 | end; 1482 | end; 1483 | end; 1484 | 1485 | function TSwitch.ToPascal; 1486 | var 1487 | i:integer; 1488 | indentStr:string; 1489 | align:integer; 1490 | begin 1491 | align := 0; 1492 | for I := 0 to high(Cases) do 1493 | if cases[I].Id.Length > align then 1494 | align := cases[I].Id.Length; 1495 | 1496 | indentStr:=StringOfChar(' ',indent); 1497 | Result := indentStr+'case '+ Switch.Trim + ' of' + sLineBreak; 1498 | for I := 0 to high(Cases) do 1499 | Result := Result + cases[I].ToPascal(Indent, Align); 1500 | Result := Result + sLineBreak + indentStr+ 'end; // case' + sLineBreak; 1501 | 1502 | end; 1503 | 1504 | 1505 | 1506 | function TArrayDef2D.ToString: string; 1507 | begin 1508 | if Length(Items)<1 then 1509 | Result := 1510 | format( '%s : array[0..%d] of %s',[ 1511 | FName, 1512 | length(Items)-1, 1513 | itemType 1514 | ]) 1515 | else 1516 | Result := 1517 | format( '%s : array[0..%d,0..%d] of %s',[ 1518 | FName, 1519 | length(Items)-1, 1520 | length(Items[0])-1, 1521 | itemType 1522 | ]); 1523 | end; 1524 | 1525 | { TPascalElement } 1526 | 1527 | procedure TPascalElement.AddChild(const el: TPascalElement); 1528 | begin 1529 | if not Assigned(el) then 1530 | Exit; 1531 | 1532 | if not (el is TPascalElement) then 1533 | Exit; 1534 | 1535 | TPascalElement(el).FOwner := self; 1536 | FChildren.Add(el); 1537 | end; 1538 | 1539 | 1540 | function TPascalElement.ChildIndexByName(const Name: string): integer; 1541 | var I:Integer; 1542 | begin 1543 | Result := -1; 1544 | for I := 0 to Count-1 do 1545 | if SameText(FChildren[I].FName,Name) then 1546 | Exit(I); 1547 | end; 1548 | 1549 | function TPascalElement.Count: integer; 1550 | begin 1551 | Result := FChildren.Count; 1552 | end; 1553 | 1554 | constructor TPascalElement.Create(aOwner: TPascalElement); 1555 | begin 1556 | FVisible := True; 1557 | FChildren := TObjectList.Create; 1558 | 1559 | self.Sourceinfo := default(TSourceInfo); 1560 | self.Renderinfo := default(TSourceInfo); 1561 | 1562 | SetOwner(aOwner); 1563 | end; 1564 | 1565 | 1566 | destructor TPascalElement.Destroy; 1567 | begin 1568 | FreeAndNil(FChildren); 1569 | inherited; 1570 | end; 1571 | 1572 | 1573 | function TPascalElement.GetChildren(Index: integer): TPascalElement; 1574 | begin 1575 | Result := FChildren[Index] 1576 | end; 1577 | 1578 | function TPascalElement.GetName: string; 1579 | begin 1580 | Result := FName; 1581 | end; 1582 | 1583 | procedure TPascalElement.SetOwner(aOwner: TPascalElement); 1584 | var I:integer; 1585 | begin 1586 | if FOwner <> nil then 1587 | if FOwner<>aOwner as TPascalElement then 1588 | raise Exception.CreateFmt('Cannot reassign owner (%s) for %s. Owner already set to %s ',[ AOwner.ToString, Self.ToString, FOwner.ToString ] ); 1589 | 1590 | // if AOwner = nil then raise Exception.Create('Owner cannot be set to nil'); 1591 | 1592 | if aOwner = nil then 1593 | Exit; 1594 | 1595 | for I := 0 to AOwner.Count-1 do 1596 | if AOwner.FChildren[I] as TPascalElement = self then 1597 | exit; 1598 | // raise Exception.Create('Cannot add same element twice'+sLineBreak+aOwner.ToString); 1599 | 1600 | FOwner := aOwner as TPascalElement; 1601 | FOwner.AddChild(self); 1602 | end; 1603 | 1604 | function TPascalElement.ToString: string; 1605 | begin 1606 | Result := ClassName.Substring(1) + ': ' + FName 1607 | end; 1608 | 1609 | 1610 | constructor TIfStatement.Create(aOwner:TPascalElement; aCondition, aIfTrue, aIfFalse: TCode); 1611 | begin 1612 | inherited Create(aOwner); 1613 | 1614 | Condition := aCondition; 1615 | aIfTrue := aIfTrue; 1616 | aIfFalse := aIfFalse; 1617 | 1618 | Condition.SetOwner(self); 1619 | aIfTrue.SetOwner(self); 1620 | aIfFalse.SetOwner(self); 1621 | end; 1622 | 1623 | function TIfStatement.ToPascal: string; 1624 | begin 1625 | Result := ' if '+ Condition.ToPascal + ' then'+sLineBreak+ IfTrue.ToPascal; 1626 | 1627 | if IfFalse.Count>0 then 1628 | Result := Result + ' else '+sLineBreak + ifFalse.ToPascal; 1629 | end; 1630 | 1631 | function TArrayDef1D.ToString: string; 1632 | begin 1633 | Result := 1634 | format( '%s : array[0..%d] of %s',[ 1635 | FName, 1636 | length(Items)-1, 1637 | itemType 1638 | ]); 1639 | 1640 | end; 1641 | 1642 | end. 1643 | --------------------------------------------------------------------------------