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