1 unit FormPrincipal; 2 3 {$mode objfpc}{$H+} 4 5 interface 6 7 uses 8 Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, Dialogs, 9 ComCtrls, Menus, ActnList, StdActns, ExtCtrls, SynFacilUtils, 10 SynFacilHighlighter, Parser, Globales, FormConfig, FormOut; 11 12 type 13 14 { TfrmPrincipal } 15 16 TfrmPrincipal = class(TForm) 17 acArcAbrir: TAction; 18 acArcGuaCom: TAction; 19 acArcGuardar: TAction; 20 acArcNueVent: TAction; 21 acArcNuevo: TAction; 22 acArcSalir: TAction; 23 acBusBuscar: TAction; 24 acBusBusSig: TAction; 25 acBusRem: TAction; 26 acEdiCopy: TEditCopy; 27 acEdiCut: TEditCut; 28 acEdiModCol: TAction; 29 acEdiPaste: TEditPaste; 30 acEdiRedo: TAction; 31 acEdiSelecAll: TAction; 32 acEdiUndo: TAction; 33 acHerConfig: TAction; 34 acHerDetener: TAction; 35 acHerEjecutar: TAction; 36 acPArcAbrir: TAction; 37 acPArcAbrNue: TAction; 38 acPArcCamNom: TAction; 39 acPArcElim: TAction; 40 acPArcNueCar: TAction; 41 acPArcNueCon: TAction; 42 acPArcNueEnc: TAction; 43 acPArcRefres: TAction; 44 acHerComp: TAction; 45 acEdiRecSyn: TAction; 46 acHerGenTemCom: TAction; 47 acVerConsol: TAction; 48 ActionList: TActionList; 49 acVerPanArc: TAction; 50 ImageList1: TImageList; 51 MainMenu1: TMainMenu; 52 MenuItem1: TMenuItem; 53 MenuItem10: TMenuItem; 54 MenuItem11: TMenuItem; 55 MenuItem12: TMenuItem; 56 MenuItem13: TMenuItem; 57 MenuItem14: TMenuItem; 58 MenuItem15: TMenuItem; 59 MenuItem16: TMenuItem; 60 MenuItem17: TMenuItem; 61 MenuItem18: TMenuItem; 62 MenuItem19: TMenuItem; 63 MenuItem20: TMenuItem; 64 MenuItem21: TMenuItem; 65 MenuItem22: TMenuItem; 66 MenuItem23: TMenuItem; 67 MenuItem24: TMenuItem; 68 MenuItem25: TMenuItem; 69 mnRecientes: TMenuItem; 70 MenuItem2: TMenuItem; 71 MenuItem3: TMenuItem; 72 MenuItem4: TMenuItem; 73 MenuItem5: TMenuItem; 74 MenuItem6: TMenuItem; 75 MenuItem7: TMenuItem; 76 MenuItem8: TMenuItem; 77 MenuItem9: TMenuItem; 78 OpenDialog1: TOpenDialog; 79 SaveDialog1: TSaveDialog; 80 Splitter1: TSplitter; 81 StatusBar1: TStatusBar; 82 edXpr: TSynEdit; 83 edAsm: TSynEdit; 84 ToolBar1: TToolBar; 85 ToolButton1: TToolButton; 86 ToolButton10: TToolButton; 87 ToolButton11: TToolButton; 88 ToolButton12: TToolButton; 89 ToolButton13: TToolButton; 90 ToolButton14: TToolButton; 91 ToolButton2: TToolButton; 92 ToolButton3: TToolButton; 93 ToolButton4: TToolButton; 94 ToolButton5: TToolButton; 95 ToolButton6: TToolButton; 96 ToolButton7: TToolButton; 97 ToolButton8: TToolButton; 98 ToolButton9: TToolButton; 99 VerBarEst1: TAction; 100 procedure acArcAbrirExecute(Sender: TObject); 101 procedure acArcGuaComExecute(Sender: TObject); 102 procedure acArcGuardarExecute(Sender: TObject); 103 procedure acArcNuevoExecute(Sender: TObject); 104 procedure acArcSalirExecute(Sender: TObject); 105 procedure acEdiCopyExecute(Sender: TObject); 106 procedure acEdiCutExecute(Sender: TObject); 107 procedure acEdiPasteExecute(Sender: TObject); 108 procedure acEdiRecSynExecute(Sender: TObject); 109 procedure acEdiRedoExecute(Sender: TObject); 110 procedure acEdiUndoExecute(Sender: TObject); 111 procedure acHerCompExecute(Sender: TObject); 112 procedure acHerConfigExecute(Sender: TObject); 113 procedure acHerEjecutarExecute(Sender: TObject); 114 procedure acHerGenTemComExecute(Sender: TObject); 115 procedure acVerConsolExecute(Sender: TObject); 116 procedure eArchivoCargado; 117 procedure eCambiaInfArchivo; 118 procedure eCambiaEstArchivo; 119 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 120 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 121 procedure FormCreate(Sender: TObject); 122 procedure FormDestroy(Sender: TObject); 123 procedure FormDropFiles(Sender: TObject; const FileNames: array of String); 124 procedure FormShow(Sender: TObject); 125 private 126 procedure MarcarError(nLin, nCol: integer); 127 procedure PreparaEditor; 128 procedure VerificarError; 129 { private declarations } 130 public 131 e : TSynFacilEditor; 132 { public declarations } 133 end; 134 135 var 136 frmPrincipal: TfrmPrincipal; 137 138 implementation 139 {$R *.lfm} 140 var 141 hlAsm: TSynFacilSyn; 142 143 { TfrmPrincipal } 144 145 procedure TfrmPrincipal.FormCreate(Sender: TObject); 146 begin 147 e := TSynFacilEditor.Create(edXpr, 'SinNombre','xpr'); 148 edXpr.Align:=alLeft; 149 splitter1.Align:=alLeft; 150 edAsm.Align:=alClient; 151 PreparaEditor; 152 end; 153 154 procedure TfrmPrincipal.FormDestroy(Sender: TObject); 155 begin 156 e.Destroy; 157 end; 158 159 procedure TfrmPrincipal.PreparaEditor; 160 //Configura el editor para empezar a trabajar 161 begin 162 //configura editor de ASM 163 hlAsm := TSynFacilSyn.Create(self); 164 hlAsm.LoadFromFile('lang_8086asm.xml'); 165 edAsm.Highlighter:=hlAsm; 166 167 //configura editor de Xpres 168 InicEditorC1(edXpr); //inicia editor 169 // edXpr.OnSpecialLineMarkup:=@edSpecialLineMarkup; 170 e.LoadSyntaxFromFile('lang_Xpres.xml'); 171 172 //configura paneles 173 e.PanFileSaved := StatusBar1.Panels[0]; //panel para mensaje "Guardado" 174 e.PanCursorPos := StatusBar1.Panels[1]; //panel para la posición del cursor 175 176 e.OnChangeFileInform:=@eCambiaInfArchivo; 177 e.OnChangeEditorState:=@eCambiaEstArchivo; 178 e.OnFileOpened:=@eArchivoCargado; 179 end; 180 181 procedure TfrmPrincipal.FormCloseQuery(Sender: TObject; var CanClose: boolean); 182 begin 183 if e.SaveQuery then CanClose := false; //cancela 184 end; 185 procedure TfrmPrincipal.FormDropFiles(Sender: TObject; const FileNames: array of String); 186 begin 187 //Carga archivo arrastrados 188 if e.SaveQuery then Exit; //Verifica cambios 189 e.LoadFile(FileNames[0]); 190 end; 191 procedure TfrmPrincipal.FormShow(Sender: TObject); 192 begin 193 Config.Iniciar(edXpr); 194 //inicia el menú "Recientes". Se debe hacer después de iniciar "Config", para poder 195 //acceder a "Config.Edit.ArcRecientes". 196 e.InitMenuRecents(mnRecientes, Config.Edit.ArcRecientes); 197 end; 198 procedure TfrmPrincipal.FormClose(Sender: TObject; var CloseAction: TCloseAction 199 ); 200 begin 201 Config.escribirArchivoIni; //guarda la configuración actual 202 end; 203 204 procedure TfrmPrincipal.eCambiaInfArchivo; 205 begin 206 //actualiza barra de título 207 Caption:= 'XpresI - ' + SysToUTF8(e.NomArc); 208 end; 209 procedure TfrmPrincipal.eCambiaEstArchivo; 210 begin 211 acArcGuardar.Enabled:=e.Modified; 212 acEdiUndo.Enabled:=e.CanUndo; 213 acEdiRedo.Enabled:=e.CanRedo; 214 // acEdiPaste.Enabled:=e.CanPaste; 215 end; 216 217 procedure TfrmPrincipal.eArchivoCargado; 218 begin 219 // if Panel1.Visible then UbicarArchivoArbol(arc8); //ubica ruta 220 // frmConfig.fraCfgEdit1.AgregArcReciente(arc8); //agrega a lista de recientes 221 // frmConfig.escribirArchivoIni; //guarda registro 222 end; 223 224 procedure TfrmPrincipal.acArcNuevoExecute(Sender: TObject); 225 begin 226 e.NewFile; 227 end; 228 229 procedure TfrmPrincipal.acArcAbrirExecute(Sender: TObject); 230 //Abre archivo 231 begin 232 OpenDialog1.Filter:='Programa Xpres|*.xpr;*.txt|Todos los archivos|*.*'; 233 e.OpenDialog(OpenDialog1); 234 end; 235 236 procedure TfrmPrincipal.acArcGuaComExecute(Sender: TObject); 237 begin 238 e.SaveAsDialog(SaveDialog1); 239 end; 240 241 procedure TfrmPrincipal.acArcGuardarExecute(Sender: TObject); 242 begin 243 e.SaveFile; 244 end; 245 procedure TfrmPrincipal.acArcSalirExecute(Sender: TObject); 246 begin 247 self.Close; 248 end; 249 250 procedure TfrmPrincipal.acEdiCopyExecute(Sender: TObject); 251 begin 252 e.Copy; 253 end; 254 procedure TfrmPrincipal.acEdiCutExecute(Sender: TObject); 255 begin 256 e.Cut; 257 end; 258 procedure TfrmPrincipal.acEdiPasteExecute(Sender: TObject); 259 begin 260 e.Paste; 261 end; 262 procedure TfrmPrincipal.acEdiRecSynExecute(Sender: TObject); 263 //Recarga el archivo de sintaxis 264 begin 265 // hlXpr.LoadFromFile('lang_Xpres.xml'); 266 // edXpr.Invalidate; 267 e.LoadSyntaxFromFile('lang_Xpres.xml'); 268 end; 269 270 procedure TfrmPrincipal.acEdiRedoExecute(Sender: TObject); 271 begin 272 e.Redo; 273 end; 274 procedure TfrmPrincipal.acEdiUndoExecute(Sender: TObject); 275 begin 276 e.Undo; 277 end; 278 procedure TfrmPrincipal.acHerCompExecute(Sender: TObject); 279 begin 280 frmOut.Show; //muestra consola 281 self.SetFocus; 282 cxp.Compilar(e.NomArc, edXpr.Lines); 283 edAsm.ClearAll; 284 edAsm.Lines.AddStrings(cxp.mem); 285 if cxp.HayError then begin 286 VerificarError; 287 // MsgErr(c.PErr.TxtError); 288 exit; 289 end; 290 end; 291 292 procedure TfrmPrincipal.acHerConfigExecute(Sender: TObject); 293 begin 294 Config.Mostrar; 295 end; 296 procedure TfrmPrincipal.MarcarError(nLin, nCol: integer); 297 begin 298 //posiciona curosr 299 edXpr.CaretX := nCol; 300 edXpr.CaretY := nLin; 301 //define línea con error 302 e.linErr := nLin; 303 edXpr.Invalidate; //refresca 304 end; 305 procedure TfrmPrincipal.VerificarError; 306 //Verifica si se ha producido algún error en el preprocesamiento y si lo hay 307 //Ve la mejor forma de msotrarlo 308 begin 309 If not cxp.HayError Then exit; //verificación 310 //Selecciona posición de error en el Editor 311 If cxp.ErrorFile <> '' Then begin 312 //Se ha identificado el archivo con el error 313 If e.NomArc = '' Then begin 314 //Tenemos el editor libre para mostrar el archivo 315 e.LoadFile(cxp.ErrorFile); 316 //Ubicamos número de línea, si hay 317 MarcarError(cxp.ErrorLine, cxp.ErrorCol); 318 {If MostrarError Then }cxp.ShowError; 319 end Else begin 320 //Hay un archivo cargado 321 If cxp.ErrorFile = e.NomArc Then begin 322 //El error está en el mismo archivo, lo mostramos 323 If cxp.ErrorLine <> 0 Then begin 324 MarcarError(cxp.ErrorLine,cxp.ErrorCol); 325 edXpr.Invalidate; 326 end; 327 {If MostrarError Then }cxp.ShowError; 328 end Else begin 329 //Es otro archivo. Lo abre en otra ventana 330 // AbrirPreSQL(cxp.ArcError, cxp.TxtError); 331 end; 332 end; 333 End else begin //no hay archivo de error 334 {If MostrarError Then }cxp.ShowError; 335 end; 336 End; 337 procedure TfrmPrincipal.acHerEjecutarExecute(Sender: TObject); 338 begin 339 edAsm.Lines.SaveToFile('code.asm'); //guarda 340 //compila 341 Shell('.\pas32v25\BIN\PASS32.EXE code.asm'); 342 //ejecuta 343 Shell('cmd /c code.exe'); 344 end; 345 346 procedure TfrmPrincipal.acHerGenTemComExecute(Sender: TObject); 347 //Genera plantilla de código para el compilador, de acuerdo a los tipos definidos 348 begin 349 350 end; 351 procedure TfrmPrincipal.acVerConsolExecute(Sender: TObject); 352 //Muestra la consola 353 begin 354 frmOut.Show; 355 end; 356 357 end. 358 359