1 unit fRadioMemories; 2 3 {$mode objfpc}{$H+} 4 5 interface 6 7 uses 8 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, 9 Grids, ExtCtrls, StdCtrls, ActnList, Menus, LCLType; 10 11 type 12 13 { TfrmRadioMemories } 14 15 TfrmRadioMemories = class(TForm) 16 acAdd: TAction; 17 acEdit: TAction; 18 acDelete: TAction; 19 acDown: TAction; 20 acImport: TAction; 21 acExport: TAction; 22 acSortByFreq: TAction; 23 acUp: TAction; 24 acMem: TActionList; 25 btnCancel: TButton; 26 btnAdd: TButton; 27 btnEdit: TButton; 28 btnDelete: TButton; 29 btnMore: TButton; 30 btnOK: TButton; 31 btnDelAll: TButton; 32 MenuItem1: TMenuItem; 33 MenuItem2: TMenuItem; 34 MenuItem3: TMenuItem; 35 MenuItem4: TMenuItem; 36 dlgOpen: TOpenDialog; 37 Panel1: TPanel; 38 popMem: TPopupMenu; 39 dlgSave: TSaveDialog; 40 sgrdMem: TStringGrid; 41 procedure acAddExecute(Sender: TObject); 42 procedure acDeleteExecute(Sender: TObject); 43 procedure acEditExecute(Sender: TObject); 44 procedure acExportExecute(Sender: TObject); 45 procedure acImportExecute(Sender: TObject); 46 procedure acSortByFreqExecute(Sender: TObject); 47 procedure btnDelAllClick(Sender: TObject); 48 procedure btnMoreClick(Sender: TObject); 49 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 50 procedure FormShow(Sender: TObject); 51 procedure sgrdMemCompareCells(Sender: TObject; ACol, ARow, BCol, 52 BRow: Integer; var Result: integer); 53 procedure sgrdMemDblClick(Sender: TObject); 54 procedure sgrdMemSelectCell(Sender: TObject; aCol, aRow: Integer; 55 var CanSelect: Boolean); 56 private 57 58 procedure AddToGrid(freq,mode,bandwidth,info : String); 59 60 public 61 { public declarations } 62 ShowMode : Boolean; 63 end; 64 65 var 66 frmRadioMemories: TfrmRadioMemories; 67 68 dcRow : integer; 69 dcRowOk : boolean ; 70 implementation 71 {$R *.lfm} 72 { TfrmRadioMemories } 73 74 uses dUtils, fAddRadioMemory, fTRXControl; 75 76 procedure TfrmRadioMemories.AddToGrid(freq,mode,bandwidth,info : String); 77 begin 78 sgrdMem.RowCount := sgrdMem.RowCount + 1; 79 sgrdMem.Cells[0,sgrdMem.RowCount-1] := FloatToStrF(StrToFloat(freq),ffFixed,15,3); 80 sgrdMem.Cells[1,sgrdMem.RowCount-1] := mode; 81 sgrdMem.Cells[2,sgrdMem.RowCount-1] := bandwidth; 82 sgrdMem.Cells[3,sgrdMem.RowCount-1] := info; 83 end; 84 85 procedure TfrmRadioMemories.acAddExecute(Sender: TObject); 86 begin 87 frmAddRadioMemory := TfrmAddRadioMemory.Create(frmRadioMemories); 88 try 89 if frmAddRadioMemory.ShowModal = mrOK then 90 begin 91 AddToGrid(frmAddRadioMemory.edtFreq.Text,frmAddRadioMemory.cmbMode.Text,frmAddRadioMemory.edtWidth.Text,frmAddRadioMemory.edtInfo.Text) 92 end 93 finally 94 FreeAndNil(frmAddRadioMemory) 95 end 96 end; 97 98 procedure TfrmRadioMemories.acDeleteExecute(Sender: TObject); 99 begin 100 if (sgrdMem.RowCount < 2) then 101 Application.MessageBox('There is nothing to delete','Info...',mb_ok+mb_IconInformation) 102 else 103 sgrdMem.DeleteRow(sgrdMem.Row) 104 end; 105 106 procedure TfrmRadioMemories.btnDelAllClick(Sender: TObject); 107 begin 108 if (sgrdMem.RowCount < 2) then 109 Application.MessageBox('There is nothing to delete','Info...',mb_ok+mb_IconInformation) 110 else 111 begin 112 repeat 113 sgrdMem.DeleteRow(sgrdMem.Row) 114 until (sgrdMem.RowCount < 2) ; 115 end; 116 end; 117 118 procedure TfrmRadioMemories.acEditExecute(Sender: TObject); 119 begin 120 frmAddRadioMemory := TfrmAddRadioMemory.Create(frmRadioMemories); 121 try 122 frmAddRadioMemory.edtFreq.Text := sgrdMem.Cells[0,sgrdMem.Row]; 123 frmAddRadioMemory.cmbMode.Text := sgrdMem.Cells[1,sgrdMem.Row]; 124 frmAddRadioMemory.edtWidth.Text := sgrdMem.Cells[2,sgrdMem.Row]; 125 frmAddRadioMemory.edtInfo.Text := sgrdMem.Cells[3,sgrdMem.Row]; 126 if frmAddRadioMemory.ShowModal = mrOK then 127 begin 128 sgrdMem.Cells[0,sgrdMem.Row] := FloatToStrF(StrToFloat(frmAddRadioMemory.edtFreq.Text),ffFixed,15,6); 129 sgrdMem.Cells[1,sgrdMem.Row] := frmAddRadioMemory.cmbMode.Text; 130 sgrdMem.Cells[2,sgrdMem.Row] := frmAddRadioMemory.edtWidth.Text; 131 sgrdMem.Cells[3,sgrdMem.Row] := frmAddRadioMemory.edtInfo.Text 132 end 133 finally 134 FreeAndNil(frmAddRadioMemory) 135 end 136 end; 137 138 procedure TfrmRadioMemories.acExportExecute(Sender: TObject); 139 var 140 l : TStringList; 141 i : Integer; 142 begin 143 if dlgSave.Execute then 144 begin 145 l := TStringList.Create; 146 try 147 for i:=1 to sgrdMem.RowCount-1 do 148 l.Add(sgrdMem.Cells[0,i]+';'+sgrdMem.Cells[1,i]+';'+sgrdMem.Cells[2,i]+';'+sgrdMem.Cells[3,i]); 149 150 l.SaveToFile(dlgSave.FileName); 151 ShowMessage('File saved to '+dlgSave.FileName) 152 finally 153 FreeAndNil(l) 154 end 155 end 156 end; 157 158 procedure TfrmRadioMemories.acImportExecute(Sender: TObject); 159 const 160 C_ERR = 'File has wrong format at line %d'+LineEnding+LineEnding+ 161 'Right format is freq(in kHz);mode;bandwidth,info' +LineEnding+LineEnding+ 'e.g.'+LineEnding+LineEnding+ 162 '10120.0;CW;300.text'; 163 164 type TFreq = record 165 freq : String[20]; 166 mode : String[10]; 167 width : String[8]; 168 info : String[25]; 169 end; 170 171 var 172 f : TextFile; 173 l : String; 174 a : TExplodeArray; 175 i : Integer=0; 176 d : Array of TFreq; 177 n : Double; 178 b : Integer; 179 begin 180 if dlgOpen.Execute then 181 begin 182 try 183 SetLength(d,0); 184 AssignFile(f,dlgOpen.FileName); 185 Reset(f); 186 while not Eof(f) do 187 begin 188 ReadLn(f,l); 189 inc(i); 190 a := dmUtils.Explode(';',l); 191 192 if (Length(a)<>4) then 193 begin 194 Application.MessageBox(PChar(Format(C_ERR,[i])),'Error...',mb_OK+mb_IconError); 195 exit 196 end; 197 198 if not TryStrToFloat(a[0],n) then 199 begin 200 Application.MessageBox(PChar(Format(C_ERR,[i])),'Error...',mb_OK+mb_IconError); 201 exit 202 end; 203 204 if a[1]='' then 205 begin 206 Application.MessageBox(PChar(Format(C_ERR,[i])),'Error...',mb_OK+mb_IconError); 207 exit 208 end; 209 210 if not TryStrToInt(a[2],b) then 211 begin 212 Application.MessageBox(PChar(Format(C_ERR,[i])),'Error...',mb_OK+mb_IconError); 213 exit 214 end; 215 216 SetLength(d,i); 217 d[i-1].freq := a[0]; 218 d[i-1].mode := a[1]; 219 d[i-1].width := a[2]; 220 d[i-1].info := a[3]; 221 end; 222 223 for i:= 0 to Length(d)-1 do 224 begin 225 AddToGrid(d[i].freq, d[i].mode, d[i].width,d[i].info) 226 end; 227 228 ShowMessage('File has been imported') 229 finally 230 CloseFile(f) 231 end 232 end 233 end; 234 235 procedure TfrmRadioMemories.acSortByFreqExecute(Sender: TObject); 236 begin 237 sgrdMem.SortColRow(true, 0, sgrdMem.FixedRows, sgrdMem.RowCount-1) 238 end; 239 240 procedure TfrmRadioMemories.btnMoreClick(Sender: TObject); 241 var 242 p : TPoint; 243 begin 244 p.x := 10; 245 p.y := 10; 246 p := btnMore.ClientToScreen(p); 247 popMem.PopUp(p.x, p.y) 248 end; 249 250 procedure TfrmRadioMemories.FormClose(Sender: TObject; 251 var CloseAction: TCloseAction); 252 begin 253 dmUtils.SaveWindowPos(frmRadioMemories); 254 end; 255 256 procedure TfrmRadioMemories.FormShow(Sender: TObject); 257 begin 258 dmUtils.LoadWindowPos(frmRadioMemories); 259 ShowMode := False; 260 end; 261 262 procedure TfrmRadioMemories.sgrdMemCompareCells(Sender: TObject; ACol, ARow, 263 BCol, BRow: Integer; var Result: integer); 264 begin 265 result := round(StrToFloat(sgrdMem.Cells[ACol,ARow])*1000-StrToFloat(sgrdMem.Cells[BCol,BRow])*1000); 266 if sgrdMem.SortOrder = soDescending then 267 result := -result 268 end; 269 270 procedure TfrmRadioMemories.sgrdMemDblClick(Sender: TObject); 271 var //set rig frequeny from memory table with doubleclick 272 freq :Double; 273 mode :String; 274 bandwidth :Integer; 275 info :String; 276 begin 277 if dcRowOk then 278 begin 279 freq := StrToFloat(sgrdMem.Cells[0,dcRow]); 280 mode := sgrdMem.Cells[1,dcRow]; 281 bandwidth := StrToInt(sgrdMem.Cells[2,dcRow]); 282 info := sgrdMem.Cells[3,dcRow]; 283 if freq > 0 then 284 Begin 285 frmTRXControl.SetFreqModeBandWidth(freq,mode,bandwidth); 286 if (dcRow = sgrdMem.RowCount-1) then 287 frmTRXControl.edtMemNr.Font.Color:= clFuchsia 288 else 289 frmTRXControl.edtMemNr.Font.Color:= clDefault; 290 if info='' then frmTRXControl.edtMemNr.Text := 'M '+IntToStr(dcRow+1) 291 else frmTRXControl.edtMemNr.Text := info; 292 frmTRXControl.infosetstage :=1; 293 end; 294 dcRowOk :=false; //we handeld this one 295 end; 296 end; 297 298 procedure TfrmRadioMemories.sgrdMemSelectCell(Sender: TObject; aCol, 299 aRow: Integer; var CanSelect: Boolean); 300 begin 301 dcRow:=aRow; //remember clicked row and handle it with ondblclick 302 dcRowOk :=true; 303 end; 304 305 end. 306 307