1 unit FramePicAsm;
2 {$mode objfpc}{$H+}
3 interface
4 uses
5 Classes, SysUtils, Types, FileUtil, Forms, Controls, StdCtrls, Grids, Graphics,
6 ExtCtrls, Buttons, Menus, LCLType, Parser, PicCore, MisUtils;
7 type
8
9 { TfraPicAsm }
10
11 TfraPicAsm = class(TFrame)
12 ImageList16: TImageList;
13 Label2: TLabel;
14 MenuItem1: TMenuItem;
15 MenuItem2: TMenuItem;
16 MenuItem3: TMenuItem;
17 MenuItem4: TMenuItem;
18 MenuItem5: TMenuItem;
19 MenuItem6: TMenuItem;
20 MenuItem8: TMenuItem;
21 mnSetPCHere: TMenuItem;
22 panTitle: TPanel;
23 PopupMenu1: TPopupMenu;
24 SpeedButton1: TSpeedButton;
25 StringGrid1: TStringGrid;
26 procedure PopupMenu1Popup(Sender: TObject);
27 procedure StringGrid1DblClick(Sender: TObject);
28 procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
29 Shift: TShiftState; X, Y: Integer);
30 private
31 pic: TPicCore;
32 defHeight : LongInt; //Altura por defecto de fila
33 defHeightFold: Integer; //Altura de fila plegada
34 margInstrc: Integer;
35 curVarName: string;
FindNextLabelnull36 function FindNextLabel(row: integer): integer;
FindPrevLabelnull37 function FindPrevLabel(row: integer): integer;
38 procedure Fold(row1, row2: integer);
RowFoldednull39 function RowFolded(row: integer): boolean;
40 procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
41 aRect: TRect; aState: TGridDrawState);
42 procedure Unfold(row1, row2: integer);
43 public
44 procedure Refrescar(SetGridRow: boolean);
45 procedure ResizeRow(i: integer);
46 procedure SetCompiler(cxp0: TCompilerBase);
47 constructor Create(AOwner: TComponent) ; override;
48 end;
49
50 implementation
51
52 {$R *.lfm}
53
54 { TfraPicAsm }
55 procedure TfraPicAsm.StringGrid1DrawCell(Sender: TObject; aCol,
56 aRow: Integer; aRect: TRect; aState: TGridDrawState);
57 var
58 txt, comm, lab: String; //Texto de la celda
59 cv: TCanvas; //Referencia al lienzo
60 ramCell: ^TPICFlashCell; //Referencia a la celda RAM
61 PC: Word;
62 rowHeight: LongInt;
63 begin
64 cv := StringGrid1.Canvas; //referencia al Lienzo
65 ramCell := @pic.flash[aRow];
66 //Fija color de texto y relleno
67 if gdFixed in aState then begin
68 //Es una celda fija
69 cv.Brush.Color := clMenu; // le ponemos azul de fondo
70 cv.Font.Color := clBlack; // fuente blanca
71 cv.Font.Style := []; // y negrita
72 end else begin
73 //Es una celda común
74 if aRow = StringGrid1.Row then begin
75 //Fila seleccionada
76 cv.Brush.Color := clMenu; // fondo marrón
77 cv.Font.Color := clBlack; // letra negra
78 cv.Font.Style := [fsBold]; // negrita
79 end else begin
80 //Fila sin selección
81 if ramCell^.used then begin
82 cv.Brush.Color := clWhite; //fondo blanco
83 end else begin //Dirección no usada
84 cv.Brush.Color := $E0E0E0;
85 end;
86 cv.Font.Style := [fsBold]; //negrita
87 end;
88 end;
89 //Dibuja contenido de celda
90 cv.FillRect(aRect); //fondo
91 if ACol = 0 then begin
92 txt := '$'+IntToHex(aRow,3);
93 cv.TextOut(aRect.Left + 2, aRect.Top + 2, txt);
94 end else if ACol = 1 then begin
95 //Celda normal
96 txt := pic.DisassemblerAt(aRow, true); //desensambla
97 PC := pic.ReadPC;
98 //Escribe texto con alineación
99 rowHeight := StringGrid1.RowHeights[Arow];
100 if rowHeight = defHeight*3 then begin
101 //Celda con comentario superior y etiqueta
102 lab := trim(ramCell^.topLabel)+':';
103 comm := trim(ramCell^.topComment);
104 cv.Font.Color := clGray;
105 cv.TextOut(aRect.Left + 2, aRect.Top + 2, lab); //comentario
106 cv.Font.Color := clBlue;
107 cv.TextOut(aRect.Left + 2 + margInstrc, aRect.Top + defHeight+ 2, comm); //comentario
108 //Escribe instrucción
109 cv.Font.Color := clGreen; //letra verde
110 cv.TextOut(aRect.Left + 2 + margInstrc, aRect.Top + defHeight*2 + 2, txt);
111 if ramCell^.breakPnt then begin
112 ImageList16.Draw(cv, aRect.Left + 1, aRect.Top+2 + defHeight*2, 9);
113 end;
114 if aRow = PC then begin //marca
115 ImageList16.Draw(cv, aRect.Left + 10, aRect.Top+2 + defHeight*2, 3);
116 end;
117 end else if rowHeight = defHeight*2 then begin
118 //Celda con comentario superior o etiqueta
119 comm := trim(ramCell^.topComment);
120 if comm<>'' then begin
121 cv.Font.Color := clBlue; //letra verde
122 cv.TextOut(aRect.Left + 2 + margInstrc, aRect.Top + 2, comm); //comentario
123 end else begin
124 //Hay etiqueta
125 lab := trim(ramCell^.topLabel)+':';
126 cv.Font.Color := clGray;
127 cv.TextOut(aRect.Left + 2, aRect.Top + 2, lab); //comentario
128 end;
129 //Escribe instrucción
130 cv.Font.Color := clGreen; //letra verde
131 cv.TextOut(aRect.Left + 2 + margInstrc, aRect.Top+2 + defHeight, txt);
132 if ramCell^.breakPnt then begin
133 ImageList16.Draw(cv, aRect.Left + 1, aRect.Top+2 + defHeight, 9);
134 end;
135 if aRow = PC then begin //marca
136 ImageList16.Draw(cv, aRect.Left + 10, aRect.Top+2 + defHeight, 3);
137 end;
138 end else if rowHeight = defHeightFold then begin
139 //Fila plegada. Se supone que hay etiqueta
140 lab := trim(ramCell^.topLabel)+': ...';
141 cv.Font.Color := clGray;
142 cv.TextOut(aRect.Left + 2, aRect.Top + 2, lab); //comentario
143 end else begin
144 //Escribe instrucción
145 cv.Font.Color := clGreen; //letra verde
146 cv.TextOut(aRect.Left + 2 + margInstrc, aRect.Top + 2, txt);
147 if ramCell^.breakPnt then begin
148 ImageList16.Draw(cv, aRect.Left + 1, aRect.Top+2, 9);
149 end;
150 if aRow = PC then begin //marca
151 ImageList16.Draw(cv, aRect.Left + 10, aRect.Top+2, 3);
152 end;
153 end;
154 end else if ACol = 2 then begin
155 //Celda normal
156 cv.Font.Color := clBlue; //letra verde
157 txt := ramCell^.sideComment; //comentario
158 // if ramCell^.idFile=-1 then begin
159 // txt := '';
160 // end else begin
161 // txt := 'IdFil=' + IntToStr(ramCell^.idFile) +
162 // 'row=' + IntToStr(ramCell^.rowSrc) +
163 // 'col=' + IntToStr(ramCell^.colSrc) ;
164 // end;
165 //Escribe texto con alineación
166 cv.TextOut(aRect.Left + 2, aRect.Top + 2, txt);
167 end;
168 end;
169 procedure TfraPicAsm.PopupMenu1Popup(Sender: TObject);
170 var
171 txt: String;
172 a: TStringDynArray;
173 begin
174 if StringGrid1.Row=-1 then begin
175 //acGenAddWatch.Visible := false;
176 MenuItem8.Visible := false;
177 exit;
178 end;
179 //Obtiene instrucción seleccionada
180 txt := pic.DisassemblerAt(StringGrid1.Row, true);
181 //Valida si es instrucción
182 a := Explode(' ', trim(txt));
183 if (high(a)<>1) and (high(a)<>2) then begin
184 //acGenAddWatch.Visible := false;
185 MenuItem8.Visible := false;
186 exit;
187 end;
188 //Puede ser una instrucción
189 curVarName := a[1]; //toma la segunda parte
190 if pos(',', curVarName)<>0 then begin
191 //Toma hasta antes de la coma
192 curVarName := copy(curVarName, 1, pos(',', curVarName)-1);
193 end;
194 curVarName := trim(curVarName);
195 //acGenAddWatch.Caption := 'Add Watch on ' + curVarName;
196 MenuItem8.Visible := true;
197 MenuItem8.Caption := 'Add Watch on ' + curVarName;
198 end;
FindPrevLabelnull199 function TfraPicAsm.FindPrevLabel(row: integer): integer;
200 {Busca la fila anterior de la grilla que contenga una etiqueta.
201 La búsqued ase hace a partir de l amisma fila "row".
202 Si no encuentra. Deuvelve -1.}
203 begin
204 while row > 0 do begin
205 if pic.flash[row].topLabel<>'' then exit(row);
206 Dec(row); //Mira siguiente fila
207 end;
208 exit(-1);
209 end;
FindNextLabelnull210 function TfraPicAsm.FindNextLabel(row: integer): integer;
211 {Busca la siguiente fila de la grilla que contenga una etiqueta.
212 La búsqued ase hace a partir de la siguiente fila de "row".
213 Si no encuentra. Deuvelve -1.}
214 begin
215 while row < StringGrid1.RowCount-1 do begin
216 Inc(row); //Mira siguiente fila
217 if pic.flash[row].topLabel<>'' then exit(row);
218 end;
219 exit(-1);
220 end;
221 procedure TfraPicAsm.Fold(row1, row2: integer);
222 //Pliega el rango de filas indicadas. No incluye a la última.
223 var
224 i: Integer;
225 begin
226 StringGrid1.BeginUpdate;
227 StringGrid1.RowHeights[row1] := defHeightFold; //fija altura
228 for i := row1+1 to row2-1 do begin
229 StringGrid1.RowHeights[i] := 0; //oculta
230 end;
231 StringGrid1.EndUpdate();
232 end;
233 procedure TfraPicAsm.Unfold(row1, row2: integer);
234 //Despliega el rango de filas indicadas. No incluye a la última.
235 var
236 i: Integer;
237 begin
238 StringGrid1.BeginUpdate;
239 for i := row1 to row2-1 do begin
240 ResizeRow(i);
241 end;
242 StringGrid1.EndUpdate();
243 end;
244 procedure TfraPicAsm.StringGrid1DblClick(Sender: TObject);
245 var
246 i1, i2: Integer;
247 begin
248 //Toma fila actual
249 i1 := StringGrid1.Row;
250 if StringGrid1.RowHeights[i1] = defHeightFold then begin
251 //Fila plegada. Expande
252 i2 := FindNextLabel(i1);
253 if i2 = -1 then exit; //No debería pasar porque un blqoeu así no debería haberse plegado
254 Unfold(i1, i2);
255 end else begin
256 //Fila sin plegar. Plega si es inicio de subrutina (tiene etiqueta).
257 if pic.flash[i1].topLabel <> '' then begin
258 i2 := FindNextLabel(i1); //Busca fin de subrutina
259 if i2 = -1 then exit; //Es el último bloque
260 Fold(i1, i2);
261 end;
262 end;
263 end;
264 procedure TfraPicAsm.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
265 Shift: TShiftState; X, Y: Integer);
266 var
267 ACol, ARow: Longint;
268 begin
269 if Button = mbRight then begin
270 StringGrid1.MouseToCell(X, Y, ACol, ARow);
271 if ACol>0 then begin
272 StringGrid1.Row := ARow;
273 PopupMenu1.PopUp;
274 end;
275 end;
276 end;
277 procedure TfraPicAsm.Refrescar(SetGridRow: boolean);
278 var
279 pc: DWord;
280 i1, i2: Integer;
281 begin
282 if SetGridRow then begin
283 pc := pic.ReadPC;
284 //Verifica si está plegada
285 if RowFolded(pc) then begin
286 i1 := FindPrevLabel(pc);
287 i2 := FindNextLabel(pc);
288 if (i1 = -1) or (i2 = -1) then exit;
289 Unfold(i1, i2);
290 end;
291 StringGrid1.Row := pc;
292 end;
293 StringGrid1.Invalidate;
294 end;
TfraPicAsm.RowFoldednull295 function TfraPicAsm.RowFolded(row: integer): boolean;
296 var
297 h: LongInt;
298 begin
299 h := StringGrid1.RowHeights[row];
300 if (h = 0) or (h = defHeightFold) then exit(true);
301 exit(false);
302 end;
303 procedure TfraPicAsm.ResizeRow(i: integer);
304 {Redimensiona la fila "i" de la grilla para que pueda contener las etiquetas que
305 incluye.}
306 begin
307 if not pic.flash[i].used then begin
308 StringGrid1.RowHeights[i] := defHeight;
309 exit;
310 end;
311 //Es celda usada
312 if (pic.flash[i].topComment<>'') and (pic.flash[i].topLabel<>'') then begin
313 //Tiene comentario arriba y etiqueta
314 StringGrid1.RowHeights[i] := 3*defHeight;
315 end else if (pic.flash[i].topComment<>'') or (pic.flash[i].topLabel<>'') then begin
316 //Tiene comentario arriba
317 StringGrid1.RowHeights[i] := 2*defHeight;
318 end else begin
319 //Deja con la misma altura
320 StringGrid1.RowHeights[i] := defHeight;
321 end;
322 end;
323 procedure TfraPicAsm.SetCompiler(cxp0: TCompilerBase);
324 var
325 i: Integer;
326 begin
327 pic := cxp0.picCore;
328 StringGrid1.DefaultDrawing:=false;
329 StringGrid1.OnDrawCell := @StringGrid1DrawCell;
330 //Dimensiona la grilla para que pueda mostrar las etIquetas
331 StringGrid1.RowCount := high(pic.flash)+1;
332 StringGrid1.BeginUpdate;
333 for i:=0 to high(pic.flash) do ResizeRow(i);
334 StringGrid1.EndUpdate();
335 end;
336 constructor TfraPicAsm.Create(AOwner: TComponent);
337 begin
338 inherited Create(AOwner);
339 //Altura de fila de la grilla por defecto
340 defHeight := 20;
341 defHeightFold := 21;
342 //Margen para mostrar las instrucciones en la grilla
343 margInstrc := 32;
344 //Configura Toolbar
345 // ToolBar1.ButtonHeight:=38;
346 // ToolBar1.ButtonWidth:=38;
347 // ToolBar1.Height:=42;
348 // ToolBar1.Images:=ImgActions32;
349 end;
350
351 end.
352
353