mirror of
https://github.com/ok2cqr/cqrlog.git
synced 2024-09-21 02:17:19 +00:00
code formating, rename files, fixed resource load
resource is loaded from imgages/world_borders.png when program is compiled from source code, later it's loaded from internal resources
This commit is contained in:
ok2cqr
parent
5b6cc3d3b6
commit
e651f9e36f
BIN
images/world_borders.png
Normal file
BIN
images/world_borders.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 12 KiB |
@ -1,7 +1,7 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="10"/>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
@ -11,12 +11,15 @@
|
||||
<AutoCreateForms Value="False"/>
|
||||
<Title Value="cqrlog"/>
|
||||
<Icon Value="0"/>
|
||||
<Resources Count="1">
|
||||
<Resource_0 FileName="../images/world_borders.png" Type="RCDATA" ResourceName="WORLD_BORDERS"/>
|
||||
</Resources>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<AutoIncrementBuild Value="True"/>
|
||||
<MinorVersionNr Value="3"/>
|
||||
<RevisionNr Value="1"/>
|
||||
<BuildNr Value="2112"/>
|
||||
<BuildNr Value="2138"/>
|
||||
<StringTable ProductVersion="0.3.1.2026"/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
@ -82,7 +85,7 @@
|
||||
<MinVersion Major="1" Minor="2" Release="1" Valid="True"/>
|
||||
</Item10>
|
||||
</RequiredPackages>
|
||||
<Units Count="98">
|
||||
<Units Count="100">
|
||||
<Unit0>
|
||||
<Filename Value="cqrlog.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -716,21 +719,33 @@
|
||||
<UnitName Value="fMoniWsjtx"/>
|
||||
</Unit95>
|
||||
<Unit96>
|
||||
<Filename Value="fwkd1.pas"/>
|
||||
<Filename Value="fWorkedGrids.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmWorked_grids"/>
|
||||
<ComponentName Value="frmWorkedGrids"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="fWkd1"/>
|
||||
</Unit96>
|
||||
<Unit97>
|
||||
<Filename Value="fprop_dk0wcy.pas"/>
|
||||
<Filename Value="fPropDK0WCY.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmProp_DK0WCY"/>
|
||||
<ComponentName Value="frmPropDK0WCY"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="fProp_DK0WCY"/>
|
||||
</Unit97>
|
||||
<Unit98>
|
||||
<Filename Value="fContest.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmContest"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit98>
|
||||
<Unit99>
|
||||
<Filename Value="fMonWsjtx.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmMonWsjtx"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit99>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -21,8 +21,8 @@ uses
|
||||
fQSLExpPref, fRotControl, dLogUpload, fLogUploadStatus, frCWKeys, fCallAlert,
|
||||
fNewCallAlert, fConfigStorage, fRbnFilter, fRbnMonitor, fRbnServer,
|
||||
fRadioMemories, fAddRadioMemory, fException, fDbError, fCommentToCall,
|
||||
fNewCommentToCall, fFindCommentToCall, frExportPref, fExportPref, fMoniWsjtx,
|
||||
fWkd1, fProp_DK0WCY, fRemind, fContest;
|
||||
fNewCommentToCall, fFindCommentToCall, frExportPref, fExportPref,
|
||||
fWorkedGrids, fPropDK0WCY, fRemind, fContest, fMonWsjtx;
|
||||
var
|
||||
Splash : TfrmSplash;
|
||||
|
||||
@ -64,10 +64,10 @@ begin
|
||||
Application.CreateForm(TfrmCWType, frmCWType);
|
||||
Application.CreateForm(TfrmRbnMonitor, frmRbnMonitor);
|
||||
Application.CreateForm(TfrmMonWsjtx, frmMonWsjtx);
|
||||
Application.CreateForm(TfrmWorked_grids, frmWorked_grids);
|
||||
Application.CreateForm(TfrmProp_DK0WCY , frmProp_DK0WCY );
|
||||
Application.CreateForm(TfrmReminder , frmReminder );
|
||||
Application.CreateForm(TfrmContest , frmContest );
|
||||
Application.CreateForm(TfrmWorkedGrids, frmWorkedGrids);
|
||||
Application.CreateForm(TfrmPropDK0WCY, frmPropDK0WCY);
|
||||
Application.CreateForm(TfrmReminder, frmReminder);
|
||||
Application.CreateForm(TfrmContest, frmContest);
|
||||
|
||||
Splash.Update;
|
||||
application.ProcessMessages;
|
||||
|
||||
BIN
src/cqrlog.res
BIN
src/cqrlog.res
Binary file not shown.
@ -754,7 +754,8 @@ end;
|
||||
procedure TdmUtils.FileCopy(const FileFrom, FileTo: string);
|
||||
var
|
||||
FromF, ToF: file;
|
||||
NumRead, NumWritten: word;
|
||||
NumRead : Word = 0;
|
||||
NumWritten: Word = 0;
|
||||
Buffer: array[1..2048] of byte;
|
||||
begin
|
||||
AssignFile(FromF, FileFrom);
|
||||
|
||||
@ -1,20 +1,20 @@
|
||||
object frmContest: TfrmContest
|
||||
Left = 1889
|
||||
Height = 99
|
||||
Top = 115
|
||||
Left = 663
|
||||
Height = 98
|
||||
Top = 426
|
||||
Width = 696
|
||||
Caption = 'Contest'
|
||||
ClientHeight = 99
|
||||
ClientHeight = 98
|
||||
ClientWidth = 696
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnHide = FormHide
|
||||
OnKeyDown = FormKeyDown
|
||||
OnShow = FormShow
|
||||
LCLVersion = '1.6.4.0'
|
||||
LCLVersion = '1.6.0.4'
|
||||
object edtCall: TEdit
|
||||
Left = 10
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 140
|
||||
CharCase = ecUppercase
|
||||
@ -25,7 +25,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtRSTs: TEdit
|
||||
Left = 151
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 50
|
||||
OnKeyDown = edtCallKeyDown
|
||||
@ -33,7 +33,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtSTX: TEdit
|
||||
Left = 202
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 50
|
||||
OnExit = edtSTXExit
|
||||
@ -43,7 +43,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtSTX2: TEdit
|
||||
Left = 253
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 100
|
||||
OnExit = edtSTX2Exit
|
||||
@ -52,7 +52,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtRSTr: TEdit
|
||||
Left = 370
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 50
|
||||
OnKeyDown = edtCallKeyDown
|
||||
@ -60,7 +60,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtSRX: TEdit
|
||||
Left = 421
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 50
|
||||
OnExit = edtSRXExit
|
||||
@ -79,7 +79,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object edtSRX2: TEdit
|
||||
Left = 472
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 27
|
||||
Width = 100
|
||||
OnKeyDown = edtCallKeyDown
|
||||
@ -87,7 +87,7 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object lblCall: TLabel
|
||||
Left = 16
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 25
|
||||
Caption = 'Call'
|
||||
@ -95,23 +95,23 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object lblRSTs: TLabel
|
||||
Left = 160
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 36
|
||||
Width = 35
|
||||
Caption = 'RST s'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblMSGs: TLabel
|
||||
Left = 256
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 40
|
||||
Width = 41
|
||||
Caption = 'MSG s'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblRSTr: TLabel
|
||||
Left = 376
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 34
|
||||
Caption = 'RST r'
|
||||
@ -119,31 +119,31 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object lblNRr: TLabel
|
||||
Left = 424
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 28
|
||||
Width = 29
|
||||
Caption = 'NR r'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblMSGr: TLabel
|
||||
Left = 480
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 38
|
||||
Width = 40
|
||||
Caption = 'MSG r'
|
||||
ParentColor = False
|
||||
end
|
||||
object chNRInc: TCheckBox
|
||||
Left = 202
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 56
|
||||
Width = 45
|
||||
Width = 46
|
||||
Caption = 'Inc'
|
||||
TabOrder = 8
|
||||
end
|
||||
object lblNRs: TLabel
|
||||
Left = 208
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 30
|
||||
Caption = 'NR s'
|
||||
@ -151,34 +151,34 @@ object frmContest: TfrmContest
|
||||
end
|
||||
object chLoc: TCheckBox
|
||||
Left = 472
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 56
|
||||
Width = 100
|
||||
Width = 102
|
||||
Caption = 'MSG is LOC'
|
||||
TabOrder = 9
|
||||
end
|
||||
object chSpace: TCheckBox
|
||||
Left = 16
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 56
|
||||
Width = 111
|
||||
Width = 114
|
||||
Caption = 'SPACE is TAB'
|
||||
TabOrder = 10
|
||||
end
|
||||
object chNoNr: TCheckBox
|
||||
Left = 424
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 56
|
||||
Width = 44
|
||||
Width = 46
|
||||
Caption = 'No'
|
||||
OnChange = chNoNrChange
|
||||
TabOrder = 11
|
||||
end
|
||||
object chTrueRST: TCheckBox
|
||||
Left = 153
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 56
|
||||
Width = 45
|
||||
Width = 48
|
||||
Caption = 'Tru'
|
||||
OnChange = chTrueRSTChange
|
||||
TabOrder = 12
|
||||
@ -186,7 +186,7 @@ object frmContest: TfrmContest
|
||||
object tmrESC2: TTimer
|
||||
Enabled = False
|
||||
OnTimer = tmrESC2Timer
|
||||
left = 632
|
||||
top = 64
|
||||
left = 616
|
||||
top = 8
|
||||
end
|
||||
end
|
||||
364
src/fContest.pas
Normal file
364
src/fContest.pas
Normal file
@ -0,0 +1,364 @@
|
||||
unit fContest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmContest }
|
||||
|
||||
TfrmContest = class(TForm)
|
||||
btSave: TButton;
|
||||
chTrueRST: TCheckBox;
|
||||
chNoNr: TCheckBox;
|
||||
chSpace: TCheckBox;
|
||||
chLoc: TCheckBox;
|
||||
chNRInc: TCheckBox;
|
||||
edtCall: TEdit;
|
||||
edtRSTs: TEdit;
|
||||
edtSTX: TEdit;
|
||||
edtSTX2: TEdit;
|
||||
edtRSTr: TEdit;
|
||||
edtSRX: TEdit;
|
||||
edtSRX2: TEdit;
|
||||
lblCall: TLabel;
|
||||
lblRSTs: TLabel;
|
||||
lblMSGs: TLabel;
|
||||
lblRSTr: TLabel;
|
||||
lblNRr: TLabel;
|
||||
lblMSGr: TLabel;
|
||||
lblNRs: TLabel;
|
||||
tmrESC2: TTimer;
|
||||
procedure btSaveClick(Sender: TObject);
|
||||
procedure chNoNrChange(Sender: TObject);
|
||||
procedure chTrueRSTChange(Sender: TObject);
|
||||
procedure edtCallExit(Sender: TObject);
|
||||
procedure edtCallKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
procedure edtCallKeyPress(Sender: TObject; var Key: char);
|
||||
procedure edtSRXExit(Sender: TObject);
|
||||
procedure edtSTX2Exit(Sender: TObject);
|
||||
procedure edtSTXExit(Sender: TObject);
|
||||
procedure edtSTXKeyPress(Sender: TObject; var Key: char);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormHide(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure tmrESC2Timer(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure InitInput;
|
||||
procedure ChkSerialNrUpd(IncNr: boolean);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmContest: TfrmContest;
|
||||
RSTstx: string = ''; //contest mode serial numbers store
|
||||
RSTstxAdd: string = ''; //contest mode additional string store
|
||||
//RSTsrx :string = '';
|
||||
EscFirstTime: boolean = False;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses dData, dUtils, fNewQSO;
|
||||
|
||||
procedure TfrmContest.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
var
|
||||
tmp: string;
|
||||
speed: integer = 0;
|
||||
i: integer = 0;
|
||||
|
||||
begin
|
||||
// enter anywhere
|
||||
if key = VK_RETURN then
|
||||
begin
|
||||
if (length(edtCall.Text) > 2) then //must be some kind of call
|
||||
btSave.Click;
|
||||
key := 0;
|
||||
end;
|
||||
|
||||
//esc and double esc
|
||||
if key = VK_ESCAPE then
|
||||
begin
|
||||
if EscFirstTime then
|
||||
begin
|
||||
if edtCall.Text = '' then
|
||||
edtCall.SetFocus
|
||||
else
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
frmNewQSO.CWint.StopSending;
|
||||
EscFirstTime := False;
|
||||
tmrESC2.Enabled := True;
|
||||
end
|
||||
else begin // esc second time
|
||||
frmNewQSO.ClearAll;
|
||||
writeln('Clear all done nex focus');
|
||||
initInput;
|
||||
tmrESC2Timer(nil);
|
||||
end;
|
||||
key := 0;
|
||||
end;
|
||||
|
||||
//cw memories
|
||||
if (Key >= VK_F1) and (Key <= VK_F10) and (Shift = []) then
|
||||
begin
|
||||
if (frmNewQSO.cmbMode.Text = 'SSB') then
|
||||
frmNewQSO.RunVK(dmUtils.GetDescKeyFromCode(Key))
|
||||
else
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
frmNewQSO.CWint.SendText(dmUtils.GetCWMessage(
|
||||
dmUtils.GetDescKeyFromCode(Key), frmNewQSO.edtCall.Text, frmNewQSO.edtHisRST.Text,
|
||||
frmNewQSO.edtName.Text, frmNewQSO.lblGreeting.Caption, ''));
|
||||
key := 0;
|
||||
end;
|
||||
|
||||
if (key = 33) then//pgup
|
||||
begin
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
begin
|
||||
speed := frmNewQSO.CWint.GetSpeed + 2;
|
||||
frmNewQSO.CWint.SetSpeed(speed);
|
||||
frmNewQSO.sbNewQSO.Panels[2].Text := IntToStr(speed) + 'WPM';
|
||||
end;
|
||||
key := 0;
|
||||
end;
|
||||
|
||||
if (key = 34) then//pgup
|
||||
begin
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
begin
|
||||
speed := frmNewQSO.CWint.GetSpeed - 2;
|
||||
frmNewQSO.CWint.SetSpeed(speed);
|
||||
frmNewQSO.sbNewQSO.Panels[2].Text := IntToStr(speed) + 'WPM';
|
||||
end;
|
||||
key := 0;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmContest.edtCallExit(Sender: TObject);
|
||||
begin
|
||||
frmNewQSO.edtCall.Text := edtCall.Text;
|
||||
frmNewQSO.edtHisRST.Text := edtRSTs.Text + ' ' + edtSTX.Text + ' ' + edtSTX2.Text;
|
||||
//so that CW macros work
|
||||
frmNewQSO.edtCallExit(nil);
|
||||
frmContest.ShowOnTop;
|
||||
frmContest.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.btSaveClick(Sender: TObject);
|
||||
begin
|
||||
frmNewQSO.edtHisRST.Text := edtRSTs.Text + ' ' + edtSTX.Text + ' ' + edtSTX2.Text;
|
||||
//this should be ok before
|
||||
if chLoc.Checked then
|
||||
begin
|
||||
frmNewQSO.edtMyRST.Text := edtRSTr.Text + ' ' + edtSRX.Text;
|
||||
frmNewQSO.edtGrid.Text := edtSRX2.Text;
|
||||
end
|
||||
else
|
||||
frmNewQSO.edtMyRST.Text := edtRSTr.Text + ' ' + edtSRX.Text + ' ' + edtSRX2.Text;
|
||||
|
||||
frmNewQSO.btnSave.Click;
|
||||
writeln('input finale');
|
||||
ChkSerialNrUpd(chNRInc.Checked);
|
||||
initInput;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.chNoNrChange(Sender: TObject);
|
||||
var
|
||||
n, m, s, c: integer;
|
||||
|
||||
procedure swapTab;
|
||||
begin //swap
|
||||
c := n;
|
||||
n := m;
|
||||
m := c;
|
||||
if (m < n) and (s > n) then //must change n and s
|
||||
begin
|
||||
c := n;
|
||||
n := s;
|
||||
s := c;
|
||||
end;
|
||||
if (n < m) and (s < m) then //must change m and s
|
||||
begin
|
||||
c := m;
|
||||
m := s;
|
||||
s := c;
|
||||
end
|
||||
end;
|
||||
begin
|
||||
n := edtSRX.TabOrder;
|
||||
m := edtSRX2.TabOrder;
|
||||
s := btSave.TabOrder;
|
||||
|
||||
if (chNoNr.Checked) and (n < m) then //msg always gets smaller tab order
|
||||
swapTab;
|
||||
|
||||
if (not chNoNr.Checked) and (m < n) then //msg always gets higher tab order
|
||||
swapTab;
|
||||
edtSRX.TabOrder := n;
|
||||
edtSRX2.TabOrder := m;
|
||||
btSave.TabOrder := s
|
||||
end;
|
||||
|
||||
procedure TfrmContest.chTrueRSTChange(Sender: TObject);
|
||||
begin
|
||||
if chTrueRST.Checked then
|
||||
begin //true RST order
|
||||
edtRSTs.TabOrder := 1;
|
||||
edtRSTr.TabOrder := 2;
|
||||
edtSRX.TabOrder := 3;
|
||||
edtSRX2.TabOrder := 4;
|
||||
btSave.TabOrder := 5;
|
||||
end
|
||||
else begin //contest order
|
||||
edtSRX.TabOrder := 1;
|
||||
edtSRX2.TabOrder := 2;
|
||||
btSave.TabOrder := 3;
|
||||
edtRSTr.TabOrder := 4;
|
||||
edtRSTs.TabOrder := 5;
|
||||
end;
|
||||
frmContest.chNoNrChange(nil); //finally check Nr/MSG order
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtCallKeyDown(Sender: TObject; var Key: word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if ((Key = VK_SPACE) and (chSpace.Checked)) then
|
||||
begin
|
||||
Key := 0;
|
||||
SelectNext(Sender as TWinControl, True, True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtCallKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if not (key in ['a'..'z', 'A'..'Z', '0'..'9',
|
||||
'/', chr(VK_DELETE), chr(VK_BACK), chr(VK_RIGHT), chr(VK_LEFT)]) then
|
||||
key := #0;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSRXExit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(False); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTX2Exit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(False); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTXExit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(False); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTXKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if not (key in ['0'..'9', chr(VK_SPACE), chr(VK_DELETE), chr(VK_BACK),
|
||||
chr(VK_RIGHT), chr(VK_LEFT)]) then
|
||||
key := #0;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormCreate(Sender: TObject);
|
||||
begin
|
||||
frmContest.KeyPreview := True;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
dmUtils.SaveWindowPos(frmContest);
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormHide(Sender: TObject);
|
||||
begin
|
||||
dmUtils.SaveWindowPos(frmContest);
|
||||
frmContest.Hide;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormShow(Sender: TObject);
|
||||
begin
|
||||
dmUtils.LoadWindowPos(frmContest);
|
||||
InitInput;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.tmrESC2Timer(Sender: TObject);
|
||||
begin
|
||||
EscFirstTime := True; //time for double esc passed
|
||||
tmrESC2.Enabled := False;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.InitInput;
|
||||
begin
|
||||
edtRSTs.Text := trim(copy(frmNewQSO.edtHisRST.Text, 0, 3));
|
||||
//just pick '599' or '59 ' if there happens to be more
|
||||
edtRSTr.Text := trim(copy(frmNewQSO.edtMyRST.Text, 0, 3));
|
||||
edtSTX.Text := RSTstx;
|
||||
edtSTX2.Text := RSTstxAdd;
|
||||
edtSRX.Text := '';
|
||||
edtSRX2.Text := '';
|
||||
edtCall.Clear;
|
||||
frmContest.ShowOnTop;
|
||||
frmContest.SetFocus;
|
||||
edtCall.SetFocus;
|
||||
EscFirstTime := True;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.ChkSerialNrUpd(IncNr: boolean); // do we need serial nr inc
|
||||
var //otherwise just update memos
|
||||
stxLen, stxInt: integer;
|
||||
lZero: boolean;
|
||||
stx: string;
|
||||
|
||||
begin
|
||||
stx := trim(edtSTX.Text);
|
||||
|
||||
if IncNr then
|
||||
begin
|
||||
stxlen := length(stx);
|
||||
if chNRInc.Checked then //inc of number requested
|
||||
begin
|
||||
lZero := stx[1] = '0'; //do we have leading zero(es)
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Need inc number:', stx, ' Has leading zero:', lZero, ' len:', stxlen);
|
||||
if TryStrToInt(stx, stxint) then
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Integer is:', stxInt);
|
||||
Inc(stxInt);
|
||||
stx := IntToStr(stxInt);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('New number is:', stx);
|
||||
if (length(stx) < stxLen) and lZero then //pad with zero(es)
|
||||
begin
|
||||
//AddChar('0',stx,stxLen); // why does this NOT work???
|
||||
while length(stx) < stxlen do
|
||||
stx := '0' + stx;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('After leading zero(es) added:', stx);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
RSTstx := stx;
|
||||
RSTstxAdd := edtSTX2.Text;
|
||||
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(' Inc number is: ', IncNr);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
@ -1,4 +1,4 @@
|
||||
unit fMoniWsjtx;
|
||||
unit fMonWsjtx;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
@ -55,10 +55,11 @@ var
|
||||
MonitorLine : string; // complete line as printed to monitor
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfrmMonWsjtx }
|
||||
|
||||
Uses fNewQSO,dData,dUtils,dDXCC,fWkd1,uMyini;
|
||||
Uses fNewQSO,dData,dUtils,dDXCC,fWorkedGrids,uMyini;
|
||||
|
||||
|
||||
|
||||
@ -330,7 +331,7 @@ Begin //TfrmMonWsjtx.AddDecodedMessage
|
||||
if length(msgLoc)<4 then //no locator if less than 4, may be "DX" or something
|
||||
msgLoc:='----';
|
||||
if length(msgLoc)=4 then
|
||||
if (not frmWorked_grids.GridOK(msgLoc)) or (msgLoc = 'RR73') then //disble false used "RR73" being a loc
|
||||
if (not frmWorkedGrids.GridOK(msgLoc)) or (msgLoc = 'RR73') then //disble false used "RR73" being a loc
|
||||
msgLoc:='----';
|
||||
|
||||
if not ( (msgLoc='----') and isMyCall ) then //if mycall: line must have locator to print(I.E. Answer to my CQ)
|
||||
@ -345,7 +346,7 @@ Begin //TfrmMonWsjtx.AddDecodedMessage
|
||||
else
|
||||
AddColorStr(' '+msgMode+' ',clPurple);
|
||||
if isMyCall then AddColorStr('=',clGreen) else AddColorStr(' ',clGreen); //answer to me
|
||||
if frmWorked_grids.WkdCall(msgCall,band,mode) then
|
||||
if frmWorkedGrids.WkdCall(msgCall,band,mode) then
|
||||
AddColorStr(PadRight(LowerCase(msgCall),9)+' ',clRed)
|
||||
else
|
||||
AddColorStr(PadRight(UpperCase(msgCall),9)+' ',clGreen);
|
||||
@ -353,7 +354,7 @@ Begin //TfrmMonWsjtx.AddDecodedMessage
|
||||
AddColorStr(msgLoc,clDefault) //no loc
|
||||
else
|
||||
Begin
|
||||
i:=frmWorked_grids.WkdGrid(msgLoc,band,mode);
|
||||
i:= frmWorkedGrids.WkdGrid(msgLoc,band,mode);
|
||||
case i of
|
||||
0 : Begin
|
||||
AddColorStr(UpperCase(msgLoc),clGreen); //not wkd
|
||||
@ -408,7 +409,6 @@ end;
|
||||
|
||||
|
||||
initialization
|
||||
{$I fMoniWsjtx.lrs}
|
||||
|
||||
end.
|
||||
|
||||
263
src/fNewQSO.lfm
263
src/fNewQSO.lfm
@ -6,7 +6,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
HelpType = htKeyword
|
||||
HelpKeyword = 'help/index.html'
|
||||
Caption = 'New QSO ... (CQRLOG for Linux)'
|
||||
ClientHeight = 628
|
||||
ClientHeight = 651
|
||||
ClientWidth = 807
|
||||
Font.Height = 8
|
||||
Icon.Data = {
|
||||
@ -2135,11 +2135,11 @@ object frmNewQSO: TfrmNewQSO
|
||||
OnKeyPress = FormKeyPress
|
||||
OnShow = FormShow
|
||||
OnWindowStateChange = FormWindowStateChange
|
||||
LCLVersion = '1.6.4.0'
|
||||
LCLVersion = '1.6.0.4'
|
||||
object sbNewQSO: TStatusBar
|
||||
Left = 0
|
||||
Height = 17
|
||||
Top = 611
|
||||
Height = 21
|
||||
Top = 630
|
||||
Width = 807
|
||||
Panels = <
|
||||
item
|
||||
@ -2159,7 +2159,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 499
|
||||
Top = 112
|
||||
Top = 131
|
||||
Width = 807
|
||||
Align = alBottom
|
||||
Caption = 'Panel1'
|
||||
@ -2189,52 +2189,52 @@ object frmNewQSO: TfrmNewQSO
|
||||
TabOrder = 0
|
||||
object Label11: TLabel
|
||||
Left = 256
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 194
|
||||
Width = 139
|
||||
Width = 144
|
||||
Caption = 'Comment to callsign:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label10: TLabel
|
||||
Left = 112
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 32
|
||||
Width = 35
|
||||
Caption = 'QTH:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label9: TLabel
|
||||
Left = 16
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 43
|
||||
Width = 44
|
||||
Caption = 'Name:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label8: TLabel
|
||||
Left = 448
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 57
|
||||
Width = 58
|
||||
Caption = 'RST rcvd'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label7: TLabel
|
||||
Left = 343
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 57
|
||||
Width = 58
|
||||
Caption = 'RST sent'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblCall: TLabel
|
||||
Left = 16
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 29
|
||||
Caption = 'Call:'
|
||||
@ -2243,88 +2243,88 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 136
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 69
|
||||
Width = 75
|
||||
Caption = 'Frequency:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 234
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 39
|
||||
Width = 43
|
||||
Caption = 'Mode:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 172
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 248
|
||||
Width = 62
|
||||
Width = 65
|
||||
Caption = 'End time:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 103
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 248
|
||||
Width = 69
|
||||
Width = 72
|
||||
Caption = 'Start time:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 16
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 248
|
||||
Width = 35
|
||||
Width = 37
|
||||
Caption = 'Date:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label15: TLabel
|
||||
Left = 258
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 33
|
||||
Width = 34
|
||||
Caption = 'GRID'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label12: TLabel
|
||||
Left = 338
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 30
|
||||
Width = 32
|
||||
Caption = 'PWR'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label18: TLabel
|
||||
Left = 405
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 40
|
||||
Width = 43
|
||||
Caption = 'QSL_S'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label19: TLabel
|
||||
Left = 468
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 55
|
||||
Width = 41
|
||||
Width = 44
|
||||
Caption = 'QSL_R'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label13: TLabel
|
||||
Left = 16
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 22
|
||||
Caption = 'ITU'
|
||||
@ -2333,72 +2333,72 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label20: TLabel
|
||||
Left = 397
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 40
|
||||
Width = 45
|
||||
Caption = 'Award'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label21: TLabel
|
||||
Left = 12
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 147
|
||||
Width = 61
|
||||
Width = 64
|
||||
Caption = 'DXCC ref.'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label22: TLabel
|
||||
Left = 60
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 30
|
||||
Width = 33
|
||||
Caption = 'WAZ'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblIOTA: TLabel
|
||||
Left = 127
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 30
|
||||
Width = 33
|
||||
Caption = 'IOTA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label17: TLabel
|
||||
Left = 261
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 46
|
||||
Width = 49
|
||||
Caption = 'County'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label23: TLabel
|
||||
Left = 111
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 147
|
||||
Width = 117
|
||||
Width = 124
|
||||
Caption = 'Comment to QSO:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblQSLVia: TLabel
|
||||
Left = 419
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 147
|
||||
Width = 51
|
||||
Width = 55
|
||||
Caption = 'QSL VIA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblQSOTakes: TLabel
|
||||
Left = 12
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 303
|
||||
Width = 72
|
||||
Width = 75
|
||||
Caption = 'QSO takes '
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -2406,9 +2406,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object lblQSLMgr: TLabel
|
||||
Left = 406
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 194
|
||||
Width = 133
|
||||
Width = 141
|
||||
Caption = 'QSL manager found!'
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
@ -2417,18 +2417,18 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label25: TLabel
|
||||
Left = 210
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 99
|
||||
Width = 34
|
||||
Width = 36
|
||||
Caption = 'State'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblCfmLoTW: TLabel
|
||||
Left = 12
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 199
|
||||
Width = 157
|
||||
Width = 167
|
||||
Caption = 'QSO confirmed by LoTW'
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
@ -2437,9 +2437,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object lblQSLRcvdDate: TLabel
|
||||
Left = 95
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 226
|
||||
Width = 81
|
||||
Width = 85
|
||||
Caption = 'QSL rcvd on '
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
@ -2992,9 +2992,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
TabOrder = 26
|
||||
object cbOffline: TCheckBox
|
||||
Left = -3
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 4
|
||||
Width = 69
|
||||
Width = 75
|
||||
Caption = 'Offline'
|
||||
OnChange = cbOfflineChange
|
||||
TabOrder = 0
|
||||
@ -3084,9 +3084,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object chkAutoMode: TCheckBox
|
||||
Left = 277
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 4
|
||||
Width = 63
|
||||
Width = 66
|
||||
Caption = 'AUTO'
|
||||
Checked = True
|
||||
OnChange = chkAutoModeChange
|
||||
@ -3201,15 +3201,15 @@ object frmNewQSO: TfrmNewQSO
|
||||
Width = 548
|
||||
Align = alBottom
|
||||
Caption = 'DXCC stat.'
|
||||
ClientHeight = 125
|
||||
ClientWidth = 546
|
||||
ClientHeight = 122
|
||||
ClientWidth = 544
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
object sgrdStatistic: TStringGrid
|
||||
Left = 0
|
||||
Height = 125
|
||||
Height = 122
|
||||
Top = 0
|
||||
Width = 546
|
||||
Width = 544
|
||||
Align = alClient
|
||||
ColCount = 2
|
||||
DefaultColWidth = 35
|
||||
@ -3242,8 +3242,8 @@ object frmNewQSO: TfrmNewQSO
|
||||
Top = 274
|
||||
Width = 240
|
||||
Caption = ' Callbook (qrz.com) '
|
||||
ClientHeight = 138
|
||||
ClientWidth = 238
|
||||
ClientHeight = 135
|
||||
ClientWidth = 236
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
object mCallBook: TMemo
|
||||
@ -3262,39 +3262,39 @@ object frmNewQSO: TfrmNewQSO
|
||||
Top = 0
|
||||
Width = 240
|
||||
Caption = 'DXCC info'
|
||||
ClientHeight = 253
|
||||
ClientWidth = 238
|
||||
ClientHeight = 250
|
||||
ClientWidth = 236
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
object Label26: TLabel
|
||||
Left = 1
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 3
|
||||
Width = 54
|
||||
Width = 59
|
||||
Caption = 'Country:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label27: TLabel
|
||||
Left = 126
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 95
|
||||
Width = 40
|
||||
Width = 42
|
||||
Caption = 'DXCC:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label28: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 78
|
||||
Width = 34
|
||||
Width = 37
|
||||
Caption = 'WAZ:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label29: TLabel
|
||||
Left = 19
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 95
|
||||
Width = 26
|
||||
Caption = 'ITU:'
|
||||
@ -3303,98 +3303,98 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label30: TLabel
|
||||
Left = 126
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 78
|
||||
Width = 34
|
||||
Width = 37
|
||||
Caption = 'Cont:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblWAZ: TLabel
|
||||
Left = 48
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 78
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblITU: TLabel
|
||||
Left = 48
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 95
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblDXCC: TLabel
|
||||
Left = 169
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 95
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblCont: TLabel
|
||||
Left = 168
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 80
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label31: TLabel
|
||||
Left = 18
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 113
|
||||
Width = 26
|
||||
Width = 28
|
||||
Caption = 'LAT:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label32: TLabel
|
||||
Left = 126
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 113
|
||||
Width = 41
|
||||
Width = 44
|
||||
Caption = 'LONG:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblLat: TLabel
|
||||
Left = 48
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 113
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblLong: TLabel
|
||||
Left = 169
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 113
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label33: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 132
|
||||
Width = 36
|
||||
Width = 38
|
||||
Caption = 'DIST.:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblQRA: TLabel
|
||||
Left = 48
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 132
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -3402,17 +3402,17 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label34: TLabel
|
||||
Left = 126
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 132
|
||||
Width = 37
|
||||
Width = 40
|
||||
Caption = 'AZIM:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblAzi: TLabel
|
||||
Left = 169
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 132
|
||||
Width = 27
|
||||
Width = 30
|
||||
Caption = 'AAA'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -3430,9 +3430,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object lblGreeting: TLabel
|
||||
Left = 189
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 179
|
||||
Width = 43
|
||||
Width = 48
|
||||
Caption = 'GE/GM'
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
@ -3593,45 +3593,45 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object lblLocSunRise: TLabel
|
||||
Left = 38
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 227
|
||||
Width = 90
|
||||
Width = 95
|
||||
Caption = 'lblLocSunRise'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblLocSunSet: TLabel
|
||||
Left = 156
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 227
|
||||
Width = 83
|
||||
Width = 89
|
||||
Caption = 'lblLocSunSet'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblTarSunRise: TLabel
|
||||
Left = 28
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 155
|
||||
Width = 87
|
||||
Width = 92
|
||||
Caption = 'lblTarSunRise'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblTarSunSet: TLabel
|
||||
Left = 149
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 155
|
||||
Width = 80
|
||||
Width = 86
|
||||
Caption = 'lblTarSunSet'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label14: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 202
|
||||
Width = 38
|
||||
Width = 40
|
||||
Caption = 'Local:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -3679,7 +3679,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
TabOrder = 2
|
||||
object lblQSONr: TLabel
|
||||
Left = 63
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 9
|
||||
Width = 8
|
||||
Caption = '0'
|
||||
@ -3688,16 +3688,16 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label24: TLabel
|
||||
Left = 7
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 9
|
||||
Width = 48
|
||||
Width = 53
|
||||
Caption = 'QSO nr.'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblCountryInfo: TLabel
|
||||
Left = 480
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 24
|
||||
Alignment = taRightJustify
|
||||
@ -3708,9 +3708,9 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object lblAmbiguous: TLabel
|
||||
Left = 656
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 114
|
||||
Width = 123
|
||||
Caption = 'Ambiguous prefix'
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
@ -3719,16 +3719,16 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 99
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 9
|
||||
Width = 85
|
||||
Width = 90
|
||||
Caption = 'QTH profile: '
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object cmbProfiles: TComboBox
|
||||
Left = 187
|
||||
Height = 32
|
||||
Height = 29
|
||||
Top = 3
|
||||
Width = 281
|
||||
ItemHeight = 0
|
||||
@ -3741,7 +3741,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object dbgrdQSOBefore: TDBGrid
|
||||
Left = 0
|
||||
Height = 112
|
||||
Height = 131
|
||||
Top = 0
|
||||
Width = 807
|
||||
Align = alClient
|
||||
@ -4089,14 +4089,13 @@ object frmNewQSO: TfrmNewQSO
|
||||
object MenuItem52: TMenuItem
|
||||
Action = acLogUploadStatus
|
||||
end
|
||||
object mnuDK0WCY: TMenuItem
|
||||
Action = acpDK0WCY
|
||||
Caption = 'Prop_DK0WCY'
|
||||
end
|
||||
object MenuItem74: TMenuItem
|
||||
Action = acProp
|
||||
Caption = 'Propgation'
|
||||
end
|
||||
object MenuItem94: TMenuItem
|
||||
Action = acpDK0WCY
|
||||
end
|
||||
object MenuItem38: TMenuItem
|
||||
Action = acQSOList
|
||||
end
|
||||
@ -4121,7 +4120,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object mnuLocatorMap: TMenuItem
|
||||
Action = acLocatorMap
|
||||
Caption = 'Wkd locators'
|
||||
Caption = 'Grid map'
|
||||
end
|
||||
object MenuItem75: TMenuItem
|
||||
Action = acXplanet
|
||||
@ -4828,7 +4827,7 @@ object frmNewQSO: TfrmNewQSO
|
||||
end
|
||||
object acpDK0WCY: TAction
|
||||
Category = 'Window'
|
||||
Caption = 'acpDK0WCY'
|
||||
Caption = 'Propagation DK0WCY'
|
||||
OnExecute = acpDK0WCYExecute
|
||||
end
|
||||
object acReminder: TAction
|
||||
|
||||
@ -20,7 +20,7 @@ uses
|
||||
DBGrids, StdCtrls, Buttons, ComCtrls, Grids, inifiles,
|
||||
LCLType, RTTICtrls, httpsend, Menus, ActnList, process, db,
|
||||
uCWKeying, ipc, baseunix, dLogUpload, blcksock, dateutils,
|
||||
fMoniWsjtx, fWkd1,fProp_DK0WCY;
|
||||
fMonWsjtx, fWorkedGrids,fPropDK0WCY;
|
||||
|
||||
const
|
||||
cRefCall = 'Ref. call (to change press CTRL+R) ';
|
||||
@ -101,6 +101,7 @@ type
|
||||
MenuItem57: TMenuItem;
|
||||
MenuItem58: TMenuItem;
|
||||
MenuItem63: TMenuItem;
|
||||
MenuItem94 : TMenuItem;
|
||||
mnuReminder: TMenuItem;
|
||||
MenuItem86: TMenuItem;
|
||||
MenuItem87: TMenuItem;
|
||||
@ -110,7 +111,6 @@ type
|
||||
MenuItem91: TMenuItem;
|
||||
MenuItem92 : TMenuItem;
|
||||
MenuItem93 : TMenuItem;
|
||||
mnuDK0WCY: TMenuItem;
|
||||
mnuWsjtxmonitor: TMenuItem;
|
||||
mnuLocatorMap: TMenuItem;
|
||||
mnuRemoteModeWsjt: TMenuItem;
|
||||
@ -1255,10 +1255,10 @@ begin
|
||||
frmPropagation.Show;
|
||||
|
||||
if cqrini.ReadBool('Window','pDK0WCY',False) then
|
||||
frmProp_DK0WCY.Show;
|
||||
frmPropDK0WCY.Show;
|
||||
|
||||
if cqrini.ReadBool('Window','Worked_grids',False) then
|
||||
frmWorked_grids.Show;
|
||||
if cqrini.ReadBool('Window','WorkedGrids',False) then
|
||||
frmWorkedGrids.Show;
|
||||
|
||||
if cqrini.ReadBool('Window','CWKeys',False) then
|
||||
acCWFKey.Execute;
|
||||
@ -1389,21 +1389,21 @@ begin
|
||||
else
|
||||
cqrini.WriteBool('Window','Prop',False);
|
||||
|
||||
if frmProp_DK0WCY.Showing then
|
||||
if frmPropDK0WCY.Showing then
|
||||
begin
|
||||
frmProp_DK0WCY.Close;
|
||||
frmPropDK0WCY.Close;
|
||||
cqrini.WriteBool('Window','pDK0WCY',True)
|
||||
end
|
||||
else
|
||||
cqrini.WriteBool('Window','pDK0WCY',False);
|
||||
|
||||
if frmWorked_grids.Showing then
|
||||
if frmWorkedGrids.Showing then
|
||||
begin
|
||||
frmWorked_grids.Close;
|
||||
cqrini.WriteBool('Window','Worked_grids',True)
|
||||
frmWorkedGrids.Close;
|
||||
cqrini.WriteBool('Window','WorkedGrids',True)
|
||||
end
|
||||
else
|
||||
cqrini.WriteBool('Window','Worked_grids',False);
|
||||
cqrini.WriteBool('Window','WorkedGrids',False);
|
||||
|
||||
if frmMonWsjtx.Showing then
|
||||
begin
|
||||
@ -2838,7 +2838,7 @@ begin
|
||||
if (not mnuRemoteMode.Checked) and (not mnuRemoteModeWsjt.Checked) then
|
||||
edtCall.SetFocus;
|
||||
UploadAllQSOOnline;
|
||||
if frmWorked_grids.Showing then frmWorked_grids.UpdateMap;
|
||||
if frmWorkedGrids.Showing then frmWorkedGrids.UpdateMap
|
||||
end;
|
||||
|
||||
procedure TfrmNewQSO.btnCancelClick(Sender: TObject);
|
||||
@ -3946,7 +3946,7 @@ end;
|
||||
|
||||
procedure TfrmNewQSO.acLocatorMapExecute(Sender: TObject);
|
||||
begin
|
||||
frmWorked_grids.Show;
|
||||
frmWorkedGrids.Show
|
||||
end;
|
||||
|
||||
procedure TfrmNewQSO.acLogUploadStatusExecute(Sender: TObject);
|
||||
@ -4022,7 +4022,7 @@ end;
|
||||
|
||||
procedure TfrmNewQSO.acpDK0WCYExecute(Sender: TObject);
|
||||
begin
|
||||
frmProp_DK0WCY.Show
|
||||
frmPropDK0WCY.Show
|
||||
end;
|
||||
|
||||
procedure TfrmNewQSO.chkAutoModeChange(Sender: TObject);
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
object frmPropDK0WCY: TfrmPropDK0WCY
|
||||
Left = 978
|
||||
Height = 312
|
||||
Top = 169
|
||||
@ -12,18 +12,18 @@ object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
OnDblClick = FormDblClick
|
||||
OnKeyUp = FormKeyUp
|
||||
OnShow = FormShow
|
||||
LCLVersion = '1.6.4.0'
|
||||
LCLVersion = '1.6.0.4'
|
||||
object lblBoulAidx: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 80
|
||||
Width = 92
|
||||
Width = 97
|
||||
Caption = 'Boulder A-idx:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblCurKidx: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 140
|
||||
Width = 90
|
||||
Caption = 'Kiel cur K-idx:'
|
||||
@ -31,74 +31,74 @@ object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
end
|
||||
object lblSolarFlx: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 180
|
||||
Width = 65
|
||||
Width = 69
|
||||
Caption = 'Solar flux:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblSunSNr: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 200
|
||||
Width = 73
|
||||
Width = 79
|
||||
Caption = 'Sunspot nr:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblGeomFi: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 240
|
||||
Width = 91
|
||||
Width = 95
|
||||
Caption = 'Geomag field:'
|
||||
ParentColor = False
|
||||
end
|
||||
object DBoulAidx: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 80
|
||||
Width = 68
|
||||
Width = 74
|
||||
Caption = 'DBoulAidx'
|
||||
ParentColor = False
|
||||
end
|
||||
object DCurKidx: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 140
|
||||
Width = 61
|
||||
Width = 65
|
||||
Caption = 'DCurKidx'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object DSolarFlx: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 180
|
||||
Width = 62
|
||||
Width = 66
|
||||
Caption = 'DSolarFlx'
|
||||
ParentColor = False
|
||||
end
|
||||
object DSunSNr: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 200
|
||||
Width = 57
|
||||
Width = 62
|
||||
Caption = 'DSunSNr'
|
||||
ParentColor = False
|
||||
end
|
||||
object DGeomFi: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 240
|
||||
Width = 59
|
||||
Width = 63
|
||||
Caption = 'DGeomFi'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblInfo: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 60
|
||||
Width = 41
|
||||
Width = 45
|
||||
Caption = 'lblInfo'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -154,15 +154,15 @@ object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
end
|
||||
object lblSolAct: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 220
|
||||
Width = 89
|
||||
Width = 92
|
||||
Caption = 'Solar activity:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblKielAidx: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 100
|
||||
Width = 67
|
||||
Caption = 'Kiel A-idx:'
|
||||
@ -170,66 +170,66 @@ object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
end
|
||||
object lblAurora: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 260
|
||||
Width = 47
|
||||
Width = 52
|
||||
Caption = 'Aurora:'
|
||||
ParentColor = False
|
||||
end
|
||||
object DKielAidx: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 100
|
||||
Width = 64
|
||||
Width = 67
|
||||
Caption = 'DKielAidx'
|
||||
ParentColor = False
|
||||
end
|
||||
object DSolAct: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 220
|
||||
Width = 51
|
||||
Width = 55
|
||||
Caption = 'DSolAct'
|
||||
ParentColor = False
|
||||
end
|
||||
object DAurora: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 260
|
||||
Width = 53
|
||||
Width = 59
|
||||
Caption = 'DAurora'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblKiel3K: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 120
|
||||
Width = 88
|
||||
Width = 89
|
||||
Caption = 'Kiel 3-hour K:'
|
||||
ParentColor = False
|
||||
end
|
||||
object DKiel3K: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 120
|
||||
Width = 52
|
||||
Width = 53
|
||||
Caption = 'DKiel3K'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object lblInfoUTC: TLabel
|
||||
Left = 120
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 5
|
||||
Width = 67
|
||||
Width = 72
|
||||
Caption = 'lblInfoUTC'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblInfoFrom: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 25
|
||||
Width = 73
|
||||
Width = 81
|
||||
Caption = 'lblInfoFrom'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -245,17 +245,17 @@ object frmProp_DK0WCY: TfrmProp_DK0WCY
|
||||
end
|
||||
object lblKidxG: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 160
|
||||
Width = 98
|
||||
Width = 101
|
||||
Caption = 'K-idx graph 3h:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblInfoDate: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Height = 17
|
||||
Top = 5
|
||||
Width = 72
|
||||
Width = 78
|
||||
Caption = 'lblInfoDate'
|
||||
ParentColor = False
|
||||
end
|
||||
491
src/fPropDK0WCY.pas
Normal file
491
src/fPropDK0WCY.pas
Normal file
@ -0,0 +1,491 @@
|
||||
unit fPropDK0WCY;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls, ComCtrls, Buttons, httpsend, LCLType, ftpsend,
|
||||
lazutf8sysutils, lclintf;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmPropDK0WCY }
|
||||
|
||||
TfrmPropDK0WCY = class(TForm)
|
||||
ImageKidx: TImage;
|
||||
lblInfoDate: TLabel;
|
||||
lblBoulAidx: TLabel;
|
||||
lblKidxG: TLabel;
|
||||
lblInfoFrom: TLabel;
|
||||
lblInfoUTC: TLabel;
|
||||
DKiel3K: TLabel;
|
||||
lblCurKidx: TLabel;
|
||||
lblSolarFlx: TLabel;
|
||||
lblSunSNr: TLabel;
|
||||
lblGeomFi: TLabel;
|
||||
lblSolAct: TLabel;
|
||||
lblKielAidx: TLabel;
|
||||
lblAurora: TLabel;
|
||||
lblKiel3K: TLabel;
|
||||
DKielAidx: TLabel;
|
||||
DAurora: TLabel;
|
||||
lblInfo: TLabel;
|
||||
DGeomFi: TLabel;
|
||||
DSunSNr: TLabel;
|
||||
DSolarFlx: TLabel;
|
||||
DSolAct: TLabel;
|
||||
DCurKidx: TLabel;
|
||||
DBoulAidx: TLabel;
|
||||
Panel1: TPanel;
|
||||
sbtnRefresh: TSpeedButton;
|
||||
tmrProp: TTimer;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDblClick(Sender: TObject);
|
||||
procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure lblInfoFromMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: integer);
|
||||
procedure lblInfoFromMouseEnter(Sender: TObject);
|
||||
procedure lblInfoFromMouseLeave(Sender: TObject);
|
||||
procedure sbtnRefreshClick(Sender: TObject);
|
||||
procedure tmrPropTimer(Sender: TObject);
|
||||
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
ak: string;
|
||||
ab: string;
|
||||
k: string;
|
||||
k3h: string;
|
||||
sfi: string;
|
||||
ssn: string;
|
||||
sa: string;
|
||||
gf: string;
|
||||
au: string;
|
||||
time: string;
|
||||
date: string;
|
||||
UTC: string;
|
||||
HttpFrm: string;
|
||||
running: boolean;
|
||||
|
||||
dbc: integer; // debug colors
|
||||
|
||||
procedure SyncProp;
|
||||
procedure KidxGraph;
|
||||
function getKindexColor(kIndex: integer): TColor;
|
||||
end;
|
||||
|
||||
type
|
||||
KData = array [0..35] of integer; //stores 3h K-idx data
|
||||
|
||||
TPropThread = class(TThread)
|
||||
protected
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
frmPropDK0WCY: TfrmPropDK0WCY;
|
||||
KValues: KData;
|
||||
BkColor: TColor = clGray; //background and borderline in KidxGraph
|
||||
FrColor: TColor = clBlack;
|
||||
|
||||
tstcolor: integer; // for color testing
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfrmPropDK0WCY }
|
||||
uses dData, dUtils, uMyIni, fNewQSO;
|
||||
|
||||
procedure TPropThread.Execute;
|
||||
var
|
||||
HTTP: THTTPSend;
|
||||
tmp: string;
|
||||
m: TStringList;
|
||||
p: integer;
|
||||
ki: integer;
|
||||
t: string;
|
||||
|
||||
begin
|
||||
if frmPropDK0WCY.running then
|
||||
exit;
|
||||
frmPropDK0WCY.running := True;
|
||||
frmPropDK0WCY.ak := '';
|
||||
frmPropDK0WCY.ab := '';
|
||||
frmPropDK0WCY.k := '';
|
||||
frmPropDK0WCY.sfi := '';
|
||||
frmPropDK0WCY.ssn := '';
|
||||
frmPropDK0WCY.sa := '';
|
||||
frmPropDK0WCY.gf := '';
|
||||
frmPropDK0WCY.au := '';
|
||||
frmPropDK0WCY.time := '';
|
||||
frmPropDK0WCY.date := '';
|
||||
frmPropDK0WCY.UTC := '';
|
||||
frmPropDK0WCY.HttpFrm := '';
|
||||
frmPropDK0WCY.k3h := '';
|
||||
|
||||
FreeOnTerminate := True;
|
||||
http := THTTPSend.Create;
|
||||
m := TStringList.Create;
|
||||
try
|
||||
HTTP.ProxyHost := cqrini.ReadString('Program', 'Proxy', '');
|
||||
HTTP.ProxyPort := cqrini.ReadString('Program', 'Port', '');
|
||||
HTTP.UserName := cqrini.ReadString('Program', 'User', '');
|
||||
HTTP.Password := cqrini.ReadString('Program', 'Passwd', '');
|
||||
frmPropDK0WCY.HttpFrm := 'http://dk0wcy.de/magnetogram/';
|
||||
//fetch address
|
||||
if HTTP.HTTPMethod('GET', frmPropDK0WCY.HttpFrm) then
|
||||
begin
|
||||
m.LoadFromStream(HTTP.Document);
|
||||
tmp := m.Text;
|
||||
|
||||
if dmData.DebugLevel >= 1 then
|
||||
begin
|
||||
Writeln('TMP: ', tmp);
|
||||
end;
|
||||
|
||||
p := Pos('>Indices of', tmp);
|
||||
frmPropDK0WCY.time := trim(copy(tmp, p + 1, 30));
|
||||
frmPropDK0WCY.time :=
|
||||
copy(frmPropDK0WCY.time, 1, Pos('</th>', frmPropDK0WCY.time) - 1);
|
||||
frmPropDK0WCY.time := frmPropDK0WCY.time;
|
||||
frmPropDK0WCY.UTC := TimeToStr(nowUTC());
|
||||
frmPropDK0WCY.date := DateToStr(nowUTC());
|
||||
|
||||
p := Pos('>Boulder A', tmp);
|
||||
frmPropDK0WCY.ab := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.ab := copy(frmPropDK0WCY.ab, 1, Pos('</b>', frmPropDK0WCY.ab) - 1);
|
||||
|
||||
p := Pos('>Solar Activity', tmp);
|
||||
frmPropDK0WCY.sa := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.sa := copy(frmPropDK0WCY.sa, 1, Pos('</b>', frmPropDK0WCY.sa) - 1);
|
||||
|
||||
p := Pos('>Kiel A', tmp);
|
||||
frmPropDK0WCY.ak := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.ak := copy(frmPropDK0WCY.ak, 1, Pos('</b>', frmPropDK0WCY.ak) - 1);
|
||||
|
||||
p := Pos('>Kiel current k', tmp);
|
||||
frmPropDK0WCY.k := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.k := copy(frmPropDK0WCY.k, 1, Pos('</b>', frmPropDK0WCY.k) - 1);
|
||||
|
||||
p := Pos('>Geomagnetic Field', tmp);
|
||||
frmPropDK0WCY.gf := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.gf := copy(frmPropDK0WCY.gf, 1, Pos('</b>', frmPropDK0WCY.gf) - 1);
|
||||
|
||||
p := Pos('>Sunspot Number', tmp);
|
||||
frmPropDK0WCY.ssn := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.ssn := copy(frmPropDK0WCY.ssn, 1, Pos('</b>', frmPropDK0WCY.ssn) - 1);
|
||||
|
||||
p := Pos('>Aurora', tmp);
|
||||
frmPropDK0WCY.au := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.au := copy(frmPropDK0WCY.au, 1, Pos('</b>', frmPropDK0WCY.au) - 1);
|
||||
|
||||
p := Pos('>Solar Flux', tmp);
|
||||
frmPropDK0WCY.sfi := trim(copy(tmp, p + 30, 18));
|
||||
frmPropDK0WCY.sfi := copy(frmPropDK0WCY.sfi, 1, Pos('</b>', frmPropDK0WCY.sfi) - 1);
|
||||
|
||||
p := Pos('>Kiel 3-hour k', tmp);
|
||||
frmPropDK0WCY.k3h := trim(copy(tmp, p + 44, 18));
|
||||
frmPropDK0WCY.k3h := copy(frmPropDK0WCY.k3h, 1, Pos('</b>', frmPropDK0WCY.k3h) - 1);
|
||||
end;
|
||||
|
||||
if dmData.DebugLevel >= 1 then
|
||||
begin
|
||||
Writeln('Time: ', frmPropDK0WCY.time);
|
||||
Writeln('UTC: ', frmPropDK0WCY.UTC);
|
||||
Writeln('Boulder A:', frmPropDK0WCY.ab);
|
||||
Writeln('Solar Act:', frmPropDK0WCY.sa);
|
||||
Writeln('Kiel A:', frmPropDK0WCY.ak);
|
||||
Writeln('Kiel K: ', frmPropDK0WCY.k);
|
||||
Writeln('Kiel 3h ', frmPropDK0WCY.k3h);
|
||||
Writeln('GF: ', frmPropDK0WCY.gf);
|
||||
Writeln('SSN: ', frmPropDK0WCY.ssn);
|
||||
Writeln('Aurora: ', frmPropDK0WCY.au);
|
||||
Writeln('SFI: ', frmPropDK0WCY.sfi);
|
||||
end;
|
||||
|
||||
Synchronize(@frmPropDK0WCY.SyncProp);
|
||||
finally
|
||||
http.Free;
|
||||
m.Free;
|
||||
frmPropDK0WCY.running := False
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmPropDK0WCY.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
tmrProp.Enabled := False;
|
||||
dmUtils.SaveWindowPos(frmPropDK0WCY);
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.FormCreate(Sender: TObject);
|
||||
var
|
||||
kloop: integer;
|
||||
|
||||
begin
|
||||
//clear K-idx image and data
|
||||
ImageKidx.Canvas.brush.style := bsSolid;
|
||||
ImageKidx.Canvas.brush.Color := BkColor;
|
||||
ImageKidx.Canvas.pen.Color := BkColor;
|
||||
ImageKidx.Canvas.Rectangle(0, 0, ImageKidx.Width, ImageKidx.Height);
|
||||
ImageKidx.Canvas.pen.Width := 1;
|
||||
for kloop := 0 to 35 do
|
||||
begin
|
||||
KValues[kloop] := -1;
|
||||
end;
|
||||
|
||||
{ if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
tstcolor :=0;
|
||||
end; }
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.FormDblClick(Sender: TObject);
|
||||
begin
|
||||
tmrPropTimer(nil);
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
begin
|
||||
if (key = VK_ESCAPE) then
|
||||
begin
|
||||
frmNewQSO.ReturnToNewQSO;
|
||||
key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.FormShow(Sender: TObject);
|
||||
const
|
||||
C_LOADING = 'Loading...';
|
||||
begin
|
||||
running := False;
|
||||
dmUtils.LoadWindowPos(frmPropDK0WCY);
|
||||
DBoulAidx.Caption := C_LOADING;
|
||||
DKielAidx.Caption := C_LOADING;
|
||||
DCurKidx.Caption := C_LOADING;
|
||||
DKiel3K.Caption := C_LOADING;
|
||||
DAurora.Caption := C_LOADING;
|
||||
DSolarFlx.Caption := C_LOADING;
|
||||
DSunSNr.Caption := C_LOADING;
|
||||
DSolAct.Caption := C_LOADING;
|
||||
DGeomFi.Caption := C_LOADING;
|
||||
lblInfo.Caption := '';
|
||||
lblInfoUTC.Caption := '';
|
||||
lblInfoDate.Caption := '';
|
||||
lblInfoFrom.Caption := frmPropDK0WCY.HttpFrm;
|
||||
tmrProp.Enabled := False;
|
||||
tmrProp.Interval := 1000 * 60 * 5; //every 5 minutes do refresh
|
||||
tmrProp.Enabled := True;
|
||||
tmrPropTimer(nil);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmPropDK0WCY.lblInfoFromMouseDown(Sender: TObject;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
||||
begin
|
||||
OpenURL(frmPropDK0WCY.HttpFrm);
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.lblInfoFromMouseEnter(Sender: TObject);
|
||||
begin
|
||||
TLabel(Sender).Font.Style := [fsUnderLine];
|
||||
TLabel(Sender).Font.Color := clBlue;
|
||||
TLabel(Sender).Cursor := crHandPoint;
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.lblInfoFromMouseLeave(Sender: TObject);
|
||||
begin
|
||||
TLabel(Sender).Font.Style := [];
|
||||
TLabel(Sender).Font.Color := clDefault;
|
||||
TLabel(Sender).Cursor := crDefault;
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.sbtnRefreshClick(Sender: TObject);
|
||||
begin
|
||||
tmrPropTimer(nil);
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.tmrPropTimer(Sender: TObject);
|
||||
var
|
||||
T: TPropThread;
|
||||
begin
|
||||
T := TPropThread.Create(True);
|
||||
T.Start;
|
||||
end;
|
||||
|
||||
function TfrmPropDK0WCY.getKindexColor(kIndex: integer): TColor;
|
||||
begin
|
||||
|
||||
{ if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
kIndex := tstcolor;
|
||||
Writeln('Color selection by: ',kIndex)
|
||||
end;}
|
||||
|
||||
case kIndex of
|
||||
0 .. 133: Result := RGBToColor(0, 180, 0); //Green
|
||||
134 .. 266: Result := RGBToColor(0, 222, 0); //lGreen
|
||||
267 .. 399: Result := RGBToColor(96, 240, 96); //llGreen
|
||||
400 .. 499: Result := RGBToColor(244, 244, 0); //Yellow
|
||||
500 .. 599: Result := RGBToColor(255, 130, 0); //Orange
|
||||
600 .. 699: Result := RGBToColor(245, 40, 65); //lred
|
||||
700 .. 799: Result := RGBToColor(215, 25, 30); //red
|
||||
800 .. 900: Result := RGBToColor(222, 48, 222); //violet
|
||||
else
|
||||
Result := clDefault;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmPropDK0WCY.SyncProp;
|
||||
|
||||
var
|
||||
dk: double;
|
||||
begin
|
||||
lblInfo.Caption := time;
|
||||
lblInfoUTC.Caption := UTC;
|
||||
lblInfoDate.Caption := Date;
|
||||
lblInfoFrom.Caption := HttpFrm;
|
||||
DBoulAidx.Caption := ab;
|
||||
DKielAidx.Caption := ak;
|
||||
DKiel3K.Caption := k3h;
|
||||
DCurKidx.Caption := k;
|
||||
DSolarFlx.Caption := sfi;
|
||||
DSunSNr.Caption := ssn;
|
||||
DSolAct.Caption := sa;
|
||||
DGeomFi.Caption := gf;
|
||||
DAurora.Caption := au;
|
||||
|
||||
if TryStrToFloat(k, dk) then
|
||||
begin
|
||||
DCurKidx.Color := getKindexColor(round(dk * 100));
|
||||
DCurKidx.Font.Style := [fsBold];
|
||||
end
|
||||
else
|
||||
begin
|
||||
DCurKidx.Color := clBtnFace;
|
||||
DCurKidx.Font.Style := [];
|
||||
end;
|
||||
|
||||
if TryStrToFloat(k3h, dk) then
|
||||
begin
|
||||
DKiel3K.Color := getKindexColor(round(dk * 100));
|
||||
DKiel3K.Font.Style := [fsBold];
|
||||
end
|
||||
else
|
||||
begin
|
||||
DKiel3K.Color := clBtnFace;
|
||||
DKiel3K.Font.Style := [];
|
||||
end;
|
||||
|
||||
frmPropDK0WCY.KidxGraph;
|
||||
|
||||
{if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
if tstcolor < 950 then
|
||||
tstcolor := tstcolor +50
|
||||
else
|
||||
tstcolor := 0;
|
||||
end; }
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmPropDK0WCY.KidxGraph;
|
||||
var
|
||||
kloop, kv: integer;
|
||||
dk: double;
|
||||
AllKdata: boolean;
|
||||
|
||||
begin
|
||||
|
||||
if not TryStrToFloat(k, dk) then
|
||||
begin
|
||||
dk := 0;
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
end;
|
||||
|
||||
if dmData.DebugLevel >= 1 then
|
||||
begin
|
||||
Writeln('Rounded Kidx for Graph: ', round(dk * 100));
|
||||
end;
|
||||
|
||||
|
||||
AllKdata := True;
|
||||
kloop := 0;
|
||||
repeat
|
||||
begin
|
||||
if KValues[kloop] = -1 then //all data is not yet filled
|
||||
begin
|
||||
KValues[kloop] := round(dk * 100); //place new value to first free
|
||||
if dmData.DebugLevel >= 1 then
|
||||
begin
|
||||
Writeln('There are : ', kloop + 1, ' Kdata entries');
|
||||
end;
|
||||
kloop := 35;
|
||||
AllKdata := False;
|
||||
end;
|
||||
Inc(kloop);
|
||||
end;
|
||||
until kloop > 35;
|
||||
|
||||
kloop := 0;
|
||||
repeat
|
||||
begin
|
||||
if AllKdata then
|
||||
begin
|
||||
if kloop < 35 then
|
||||
KValues[kloop] := KValues[kloop + 1] //scroll data
|
||||
else
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
begin
|
||||
Writeln('All Kdata entries filled; scroll and place new to end');
|
||||
end;
|
||||
KValues[kloop] := round(dk * 100); //place new value to end
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
kv := 0;
|
||||
if KValues[kloop] > -1 then
|
||||
begin
|
||||
kv := KValues[kloop];
|
||||
ImageKidx.Canvas.pen.Color := getKindexColor(kv);
|
||||
end
|
||||
else
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
|
||||
//double lines pen width 1 are better than one with pen width 2 (why?)
|
||||
ImageKidx.Canvas.line(kloop * 2, 20 - 20 * kv div 1000, kloop * 2, 20); //Kidx value
|
||||
ImageKidx.Canvas.line(kloop * 2 + 1, 20 - 20 * kv div 1000, kloop * 2 + 1, 20);
|
||||
ImageKidx.Canvas.pen.Color := BkColor;
|
||||
ImageKidx.Canvas.line(kloop * 2, 0, kloop * 2, 20 - 20 * kv div 1000); //the rest of bar
|
||||
ImageKidx.Canvas.line(kloop * 2 + 1, 0, kloop * 2 + 1, 20 - 20 * kv div 1000);
|
||||
|
||||
if (kloop mod 12) = 0 then
|
||||
begin
|
||||
ImageKidx.Canvas.pen.Color := FrColor; //Hour lines if fetch is every 5min
|
||||
ImageKidx.Canvas.pen.style := psDot;
|
||||
ImageKidx.Canvas.line(kloop * 2, 0, kloop * 2, 20 - 20 * kv div 1000);
|
||||
ImageKidx.Canvas.pen.style := psSolid;
|
||||
end;
|
||||
|
||||
Inc(kloop);
|
||||
end;
|
||||
until kloop > 35;
|
||||
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
ImageKidx.Canvas.pen.style := psDot;
|
||||
ImageKidx.Canvas.line(0, 19, 72, 19); // bottom line
|
||||
ImageKidx.Canvas.pen.style := psSolid;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
@ -10,7 +10,7 @@ object frmReminder: TfrmReminder
|
||||
OnClose = FormClose
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.6.4.0'
|
||||
LCLVersion = '1.6.0.4'
|
||||
object RemiMemo: TMemo
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
@ -30,9 +30,9 @@ object frmReminder: TfrmReminder
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 222
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 30
|
||||
Width = 154
|
||||
Width = 159
|
||||
BorderSpacing.Top = 5
|
||||
Caption = 'Remind again after '
|
||||
OnChange = chRemiChange
|
||||
@ -44,7 +44,7 @@ object frmReminder: TfrmReminder
|
||||
Left = 8
|
||||
Height = 16
|
||||
Top = 73
|
||||
Width = 116
|
||||
Width = 92
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Bottom = 2
|
||||
Caption = 'Remember to:'
|
||||
@ -71,8 +71,8 @@ object frmReminder: TfrmReminder
|
||||
AnchorSideLeft.Control = chRemi
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = chRemi
|
||||
Left = 376
|
||||
Height = 32
|
||||
Left = 381
|
||||
Height = 27
|
||||
Top = 30
|
||||
Width = 56
|
||||
CharCase = ecNormal
|
||||
@ -89,26 +89,26 @@ object frmReminder: TfrmReminder
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = chRemi
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 434
|
||||
Height = 15
|
||||
Left = 439
|
||||
Height = 17
|
||||
Top = 34
|
||||
Width = 53
|
||||
Width = 56
|
||||
BorderSpacing.Left = 2
|
||||
Caption = 'minutes'
|
||||
ParentColor = False
|
||||
end
|
||||
object chUTRemi: TCheckBox
|
||||
Left = 222
|
||||
Height = 23
|
||||
Height = 24
|
||||
Top = 64
|
||||
Width = 153
|
||||
Width = 155
|
||||
Caption = 'Remind time (UTC) '
|
||||
OnChange = chUTRemiChange
|
||||
TabOrder = 4
|
||||
end
|
||||
object RemindUThour: TMaskEdit
|
||||
Left = 376
|
||||
Height = 32
|
||||
Height = 27
|
||||
Top = 57
|
||||
Width = 56
|
||||
CharCase = ecNormal
|
||||
@ -122,9 +122,9 @@ object frmReminder: TfrmReminder
|
||||
end
|
||||
object lblRemi1: TLabel
|
||||
Left = 0
|
||||
Height = 28
|
||||
Height = 27
|
||||
Top = 0
|
||||
Width = 600
|
||||
Width = 497
|
||||
Caption = ' Sitting is killing you! Take a short walk! '
|
||||
Color = clRed
|
||||
Font.Color = clYellow
|
||||
@ -47,6 +47,7 @@ var
|
||||
TimerValue: string;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfrmReminder }
|
||||
|
||||
@ -213,7 +214,6 @@ begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I fremind.lrs}
|
||||
|
||||
end.
|
||||
|
||||
241
src/fWorkedGrids.lfm
Normal file
241
src/fWorkedGrids.lfm
Normal file
@ -0,0 +1,241 @@
|
||||
object frmWorkedGrids: TfrmWorkedGrids
|
||||
Left = 590
|
||||
Height = 441
|
||||
Top = 263
|
||||
Width = 753
|
||||
VertScrollBar.Visible = False
|
||||
Caption = 'Worked locator grids'
|
||||
ClientHeight = 441
|
||||
ClientWidth = 753
|
||||
Constraints.MaxHeight = 441
|
||||
Constraints.MaxWidth = 753
|
||||
Constraints.MinHeight = 441
|
||||
Constraints.MinWidth = 753
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
Position = poDefault
|
||||
LCLVersion = '1.6.0.4'
|
||||
object LocMap: TImage
|
||||
Left = 16
|
||||
Height = 361
|
||||
Top = 72
|
||||
Width = 721
|
||||
OnClick = LocMapClick
|
||||
OnMouseMove = LocMapMouseMove
|
||||
end
|
||||
object BandSelector: TComboBox
|
||||
AnchorSideLeft.Control = LocMap
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 16
|
||||
Height = 27
|
||||
Hint = 'Band selector'
|
||||
Top = 25
|
||||
Width = 124
|
||||
Anchors = []
|
||||
BorderSpacing.Top = 25
|
||||
ItemHeight = 0
|
||||
ItemIndex = 4
|
||||
Items.Strings = (
|
||||
'all'
|
||||
'2190M'
|
||||
'630M'
|
||||
'160M'
|
||||
'80M'
|
||||
'60M'
|
||||
'40M'
|
||||
'30M'
|
||||
'20M'
|
||||
'17M'
|
||||
'15M'
|
||||
'12M'
|
||||
'10M'
|
||||
'6M'
|
||||
'4M'
|
||||
'2M'
|
||||
)
|
||||
OnChange = BandSelectorChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
Text = '80M'
|
||||
end
|
||||
object BandLabel: TLabel
|
||||
AnchorSideLeft.Control = BandSelector
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideBottom.Control = BandSelector
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 79
|
||||
Anchors = []
|
||||
BorderSpacing.Bottom = 25
|
||||
Caption = 'Select band'
|
||||
ParentColor = False
|
||||
end
|
||||
object SaveMap: TButton
|
||||
AnchorSideTop.Control = BandSelector
|
||||
AnchorSideRight.Control = LocMap
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 609
|
||||
Height = 27
|
||||
Top = 25
|
||||
Width = 128
|
||||
Anchors = []
|
||||
Caption = 'Save map image'
|
||||
OnClick = SaveMapClick
|
||||
OnEnter = SaveMapClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object ZooMap: TImage
|
||||
AnchorSideLeft.Control = LocMap
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = LocMap
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 176
|
||||
Height = 201
|
||||
Top = 152
|
||||
Width = 401
|
||||
OnClick = ZooMapClick
|
||||
Visible = False
|
||||
end
|
||||
object LocMapBase: TImage
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 15
|
||||
Height = 361
|
||||
Top = 72
|
||||
Width = 721
|
||||
BorderSpacing.Left = 15
|
||||
BorderSpacing.Top = 72
|
||||
OnClick = LocMapClick
|
||||
OnMouseMove = LocMapMouseMove
|
||||
Visible = False
|
||||
end
|
||||
object Nrstatus: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 346
|
||||
Height = 17
|
||||
Top = 53
|
||||
Width = 61
|
||||
Alignment = taCenter
|
||||
BorderSpacing.Top = 53
|
||||
Caption = 'NrStatus'
|
||||
ParentColor = False
|
||||
Visible = False
|
||||
end
|
||||
object Nrgrids: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 40
|
||||
Height = 17
|
||||
Top = 53
|
||||
Width = 52
|
||||
Alignment = taCenter
|
||||
BorderSpacing.Left = 40
|
||||
BorderSpacing.Top = 53
|
||||
Caption = 'Nrgrids'
|
||||
ParentColor = False
|
||||
Visible = False
|
||||
end
|
||||
object Nrqsos: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 665
|
||||
Height = 17
|
||||
Top = 53
|
||||
Width = 49
|
||||
Alignment = taCenter
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Top = 53
|
||||
BorderSpacing.Right = 39
|
||||
Caption = 'Nrqsos'
|
||||
ParentColor = False
|
||||
Visible = False
|
||||
end
|
||||
object WsMode: TComboBox
|
||||
AnchorSideLeft.Control = LocMap
|
||||
AnchorSideTop.Control = BandSelector
|
||||
Left = 181
|
||||
Height = 31
|
||||
Top = 25
|
||||
Width = 128
|
||||
Anchors = []
|
||||
BorderSpacing.Left = 165
|
||||
ItemHeight = 0
|
||||
OnChange = WsModeChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 3
|
||||
end
|
||||
object modeLabel: TLabel
|
||||
AnchorSideLeft.Control = WsMode
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = WsMode
|
||||
AnchorSideBottom.Control = BandSelector
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 200
|
||||
Height = 17
|
||||
Top = 10
|
||||
Width = 83
|
||||
Anchors = []
|
||||
Caption = 'Select mode'
|
||||
ParentColor = False
|
||||
end
|
||||
object FollowRig: TCheckBox
|
||||
AnchorSideLeft.Control = LocMap
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = BandSelector
|
||||
Left = 329
|
||||
Height = 24
|
||||
Top = 25
|
||||
Width = 94
|
||||
Anchors = []
|
||||
Caption = 'Follow rig'
|
||||
TabOrder = 4
|
||||
end
|
||||
object ZooIlbl: TImage
|
||||
AnchorSideLeft.Control = ZooMap
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideBottom.Control = ZooMap
|
||||
Left = 320
|
||||
Height = 80
|
||||
Top = 72
|
||||
Width = 112
|
||||
Anchors = [akLeft, akBottom]
|
||||
Visible = False
|
||||
end
|
||||
object ShoWkdOnly: TCheckBox
|
||||
AnchorSideTop.Control = BandSelector
|
||||
AnchorSideRight.Control = LocMap
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 444
|
||||
Height = 24
|
||||
Top = 28
|
||||
Width = 128
|
||||
Anchors = []
|
||||
BorderSpacing.Right = 165
|
||||
Caption = 'Show wkd only'
|
||||
OnClick = ShoWkdOnlyClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object SaveMapImage: TSaveDialog
|
||||
OnClose = SaveMapImageClose
|
||||
Title = 'Save map file'
|
||||
DefaultExt = '.bmp'
|
||||
Filter = '.bmp, .png, .jpg'
|
||||
Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing, ofViewDetail]
|
||||
left = 544
|
||||
top = 368
|
||||
end
|
||||
object AutoUpdate: TTimer
|
||||
Enabled = False
|
||||
OnTimer = AutoUpdateTimer
|
||||
left = 638
|
||||
top = 368
|
||||
end
|
||||
end
|
||||
796
src/fWorkedGrids.pas
Normal file
796
src/fWorkedGrids.pas
Normal file
@ -0,0 +1,796 @@
|
||||
unit fWorkedGrids;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil,
|
||||
Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LResources, IniFiles;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmWorkedGrids }
|
||||
|
||||
TfrmWorkedGrids = class(TForm)
|
||||
ZooIlbl: TImage;
|
||||
modeLabel: TLabel;
|
||||
FollowRig: TCheckBox;
|
||||
WsMode: TComboBox;
|
||||
Nrstatus: TLabel;
|
||||
BandSelector: TComboBox;
|
||||
AutoUpdate: TTimer;
|
||||
Nrgrids: TLabel;
|
||||
Nrqsos: TLabel;
|
||||
LocMapBase: TImage;
|
||||
ZooMap: TImage;
|
||||
ShoWkdOnly: TCheckBox;
|
||||
SaveMapImage: TSaveDialog;
|
||||
SaveMap: TButton;
|
||||
LocMap: TImage;
|
||||
BandLabel: TLabel;
|
||||
procedure BandSelectorChange(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure LocMapClick(Sender: TObject);
|
||||
procedure LocMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
|
||||
procedure ShoWkdOnlyClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure SaveMapImageClose(Sender: TObject);
|
||||
procedure SaveMapClick(Sender: TObject);
|
||||
procedure AutoUpdateTimer(Sender: TObject);
|
||||
procedure WsModeChange(Sender: TObject);
|
||||
procedure ZooMapClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure DrawBase(BCanvas: TCanvas; SubBase: boolean);
|
||||
procedure MarkGrid(LocGrid: string; Cfmd: boolean; MCanvas: TCanvas;
|
||||
SubBase: boolean);
|
||||
public
|
||||
{ public declarations }
|
||||
procedure ToRigMode(mode: string);
|
||||
procedure ToRigBand(band: string);
|
||||
function RecordCount: string;
|
||||
function WkdGrid(loc, band, mode: string): integer;
|
||||
//returns 0=not wkd, 1=main grid wkd, 2=wkd
|
||||
function WkdCall(call, band, mode: string): boolean; //returns wkd=true
|
||||
function GridOK(Loc: string): boolean;
|
||||
procedure UpdateMap;
|
||||
end;
|
||||
|
||||
var
|
||||
frmWorkedGrids: TfrmWorkedGrids; //Main form
|
||||
MaxRowId, //rows in table (Number of qsos in log database)
|
||||
BandQsoCount, //Number of qsos on selected band
|
||||
LogTable, //Table name found from database file (own call ad locator)
|
||||
LogBand, //Band that is selected for worked locators
|
||||
LogSave, //Default File name for saving image
|
||||
LogMainGrid: string; //first 2 letters of locator grid clicked from map
|
||||
MouseX, MouseY, //Mouse position on loc map rounded to grids up/right corner
|
||||
MainGridCount, //Number of Maingrids (achrs) from query result
|
||||
GridCount: integer; //Number of subgrids (4chrs) from query result
|
||||
Changes: boolean; //changes in rig mode/band
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
uses fNewQSO, fTRXControl, dData, dUtils, uMyIni;
|
||||
|
||||
{ TfrmWorkedGrids }
|
||||
|
||||
|
||||
function TfrmWorkedGrids.GridOK(Loc: string): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := True;
|
||||
Loc := trim(UpCase(Loc));
|
||||
if Length(Loc) mod 2 = 0 then
|
||||
begin
|
||||
for i := 1 to length(loc) do
|
||||
begin
|
||||
case i of
|
||||
1, 2, 5, 6: case Loc[i] of
|
||||
'A'..'R':
|
||||
begin {OK!}
|
||||
end;
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
3, 4, 7, 8: case Loc[i] of
|
||||
'0'..'9':
|
||||
begin {OK!}
|
||||
end;
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.ToRigMode(mode: string);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('ToRigMode was index:', WsMode.ItemIndex);
|
||||
i := WsMode.Items.Count;
|
||||
Changes := True;
|
||||
repeat
|
||||
begin
|
||||
Dec(i);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('looping now:', i);
|
||||
end;
|
||||
until (WsMode.Items[i] = mode) or (i = 0);
|
||||
WsMode.ItemIndex := i;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Result:', i, ' ', WsMode.Items[WsMode.ItemIndex]);
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.ToRigBand(band: string);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('ToRigBand was index:', WsMode.ItemIndex);
|
||||
i := BandSelector.Items.Count;
|
||||
Changes := True;
|
||||
repeat
|
||||
begin
|
||||
Dec(i);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('looping now:', i);
|
||||
end;
|
||||
until (BandSelector.Items[i] = band) or (i = 0);
|
||||
BandSelector.ItemIndex := i;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Result:', i, ' ', BandSelector.Items[BandSelector.ItemIndex]);
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.UpdateMap;
|
||||
|
||||
begin
|
||||
BandSelectorChange(AutoUpdate); //update map(s)
|
||||
end;
|
||||
|
||||
function TfrmWorkedGrids.RecordCount: string;
|
||||
begin
|
||||
|
||||
dmData.Q1.Close;
|
||||
if dmData.trQ1.Active then
|
||||
dmData.trQ1.Rollback;
|
||||
dmData.Q1.SQL.Text := 'select count(callsign) from ' + LogTable;
|
||||
dmData.trQ1.StartTransaction;
|
||||
try
|
||||
dmData.Q1.Open;
|
||||
RecordCount := dmData.Q1.Fields[0].AsString;
|
||||
if (RecordCount = '') then
|
||||
RecordCount := '0';
|
||||
dmData.Q1.Close;
|
||||
|
||||
finally
|
||||
dmData.trQ1.Rollback;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfrmWorkedGrids.WkdGrid(loc, band, mode: string): integer;
|
||||
begin
|
||||
WkdGrid := 0;
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then
|
||||
dmData.trQ.Rollback;
|
||||
|
||||
dmData.Q.SQL.Text := 'select loc from ' + LogTable + ' where band=' + chr(39) + band + chr(39) +
|
||||
' and mode=' + chr(39) + mode + chr(39) + ' and loc like ' +
|
||||
chr(39) + loc + '%' + chr(39);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(dmData.Q.SQL.Text);
|
||||
dmData.trQ.StartTransaction;
|
||||
try
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdGrid := 2;
|
||||
dmData.Q.Close;
|
||||
if WkdGrid = 0 then
|
||||
begin
|
||||
dmData.Q.SQL.Text := 'select loc from ' + LogTable + ' where band=' + chr(
|
||||
39) + band + chr(39) + ' and mode=' + chr(39) + mode +
|
||||
chr(39) + ' and loc like ' + chr(39) + copy(loc, 1, 2) + '%' + chr(39);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(dmData.Q.SQL.Text);
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdGrid := 1;
|
||||
dmData.Q.Close;
|
||||
end;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('WkdGrid is:', WkdGrid);
|
||||
end;
|
||||
|
||||
function TfrmWorkedGrids.WkdCall(call, band, mode: string): boolean;
|
||||
begin
|
||||
WkdCall := False;
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then
|
||||
dmData.trQ.Rollback;
|
||||
dmData.Q.SQL.Text := 'select callsign from ' + LogTable + ' where band=' +
|
||||
chr(39) + band + chr(39) + ' and mode=' + chr(39) +
|
||||
mode + chr(39) + ' and callsign=' + chr(39) + call + chr(39);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(dmData.Q.SQL.Text);
|
||||
try
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdCall := True;
|
||||
dmData.Q.Close;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('WkdCall is:', WkdCall);
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.MarkGrid(LocGrid: string; Cfmd: boolean; MCanvas: TCanvas;
|
||||
SubBase: boolean);
|
||||
|
||||
var
|
||||
v, vs, h, hs, Mheight, ltrbase, Pwidth, Pcolor, Grid1, Grid2: integer;
|
||||
|
||||
begin
|
||||
LocGrid := UpperCase(LocGrid);//to be sure ;)
|
||||
Pwidth := 2;
|
||||
if Cfmd then
|
||||
Pcolor := clGreen
|
||||
else
|
||||
Pcolor := clMaroon;
|
||||
Mheight := 360;
|
||||
ltrbase := 65;
|
||||
Grid1 := 1;
|
||||
Grid2 := 2;
|
||||
|
||||
if not GridOK(LocGrid) then
|
||||
exit; // all (4chr) must be valid
|
||||
|
||||
if SubBase then
|
||||
begin
|
||||
Pwidth := 4;
|
||||
if Cfmd then
|
||||
Pcolor := clLime
|
||||
else
|
||||
Pcolor := clred;
|
||||
Mheight := 200;
|
||||
ltrbase := 48;
|
||||
Grid1 := 3;
|
||||
Grid2 := 4;
|
||||
end;
|
||||
|
||||
with MCanvas do
|
||||
begin
|
||||
//draw main grids
|
||||
v := (Ord(LocGrid[Grid1]) - ltrbase) * 40;
|
||||
h := Mheight - (Ord(LocGrid[Grid2]) - (ltrbase - 1)) * 20;
|
||||
|
||||
brush.style := bsClear;
|
||||
pen.Color := Pcolor;
|
||||
pen.Width := Pwidth;
|
||||
if subBase then
|
||||
begin
|
||||
brush.Color := Pcolor;
|
||||
FillRect(v + 3, h + 3, v + 38, h + 18);
|
||||
end
|
||||
else begin
|
||||
Rectangle(v + 2, h + 2, v + 39, h + 19);
|
||||
end;
|
||||
|
||||
//name grids
|
||||
font.Size := 7;
|
||||
font.Color := clBlack;
|
||||
Font.Style := [fsBold];
|
||||
TextOut(v + 15, h + 5, LocGrid[Grid1] + LocGrid[Grid2]);
|
||||
Font.Style := [];
|
||||
|
||||
//draw sub grids
|
||||
if not SubBase then
|
||||
begin
|
||||
hs := h + 20 - ((Ord(LocGrid[4]) - 47) * 2);
|
||||
vs := v + (Ord(LocGrid[3]) - 48) * 4;
|
||||
if Cfmd then
|
||||
Pcolor := clLime
|
||||
else
|
||||
Pcolor := clred;
|
||||
pen.Color := Pcolor;
|
||||
Rectangle(vs, hs, vs + 4, hs + 2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmWorkedGrids.DrawBase(BCanvas: TCanvas; SubBase: boolean);
|
||||
|
||||
var
|
||||
v, vc, h, hc, Bwidth, Bheight, ltrbase: integer;
|
||||
|
||||
begin
|
||||
|
||||
Bwidth := 720;
|
||||
Bheight := 360;
|
||||
ltrbase := 65;
|
||||
|
||||
if SubBase then
|
||||
begin
|
||||
Bwidth := 400;
|
||||
Bheight := 200;
|
||||
ltrbase := 48;
|
||||
end;
|
||||
|
||||
with BCanvas do
|
||||
begin
|
||||
v := 0;
|
||||
repeat
|
||||
begin
|
||||
pen.Color := clGray;
|
||||
pen.Width := 1;
|
||||
line(0, v, Bwidth, v);
|
||||
line(v * 2, 0, v * 2, Bheight);
|
||||
v := v + 20;
|
||||
end;
|
||||
until v > Bheight;
|
||||
v := 15;
|
||||
vc := ltrbase;
|
||||
repeat
|
||||
begin
|
||||
h := Bheight - 15;
|
||||
;
|
||||
hc := ltrbase;
|
||||
repeat
|
||||
begin
|
||||
Brush.Style := bsClear;
|
||||
font.Size := 7;
|
||||
font.Color := clGray;
|
||||
TextOut(v, h, chr(vc) + chr(hc));
|
||||
h := h - 20;
|
||||
hc := hc + 1;
|
||||
end;
|
||||
until h < 0;
|
||||
end;
|
||||
v := v + 40;
|
||||
vc := vc + 1;
|
||||
until v > Bwidth;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.FormCreate(Sender: TObject);
|
||||
var
|
||||
ImgStream : TResourceStream;
|
||||
begin
|
||||
ImgStream := TResourceStream.Create(HINSTANCE,'WORLD_BORDERS',RT_RCDATA);
|
||||
try
|
||||
LocMapBase.Picture.LoadFromStream(ImgStream)
|
||||
finally
|
||||
ImgStream.Free
|
||||
end;
|
||||
|
||||
AutoUpdate.Enabled := False;
|
||||
AutoUpdate.Interval := 5000;
|
||||
WsMode.ItemIndex := -1;
|
||||
BandSelector.ItemIndex := -1;
|
||||
LogSave := 'wkd_locs_empty';
|
||||
LogBand := ' ';
|
||||
LogTable := 'cqrlog_main'; //assume table name is this always
|
||||
|
||||
dmUtils.InsertModes(WsMode);
|
||||
WsMode.Items.Insert(0, 'any');
|
||||
WsMode.Items.Insert(1, 'JT9+JT65');
|
||||
WsMode.ItemIndex := 0;
|
||||
|
||||
dmUtils.InsertBands(BandSelector);
|
||||
BandSelector.Items.Insert(0, 'all');
|
||||
BandSelector.ItemIndex := 4;
|
||||
|
||||
frmWorkedGrids.Caption := Caption + ' ' + dmData.LogName + ' ' + LogBand;
|
||||
|
||||
LocMap.Canvas.CopyRect(Rect(0, 0, Width, Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas, Rect(0, 0, Width, Height));
|
||||
|
||||
DrawBase(LocMap.canvas, False)
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.SaveMapImageClose(Sender: TObject);
|
||||
|
||||
var
|
||||
Bmp: TBitmap;
|
||||
AddSize, aWidth, aHeight: integer;
|
||||
AddText, AddText1: string;
|
||||
|
||||
begin
|
||||
AddText := '';
|
||||
AddText1 := '';
|
||||
if LocMap.Visible then
|
||||
begin
|
||||
AddSize := 20;
|
||||
aWidth := LocMap.Picture.Bitmap.Width;
|
||||
aHeight := LocMap.Picture.Bitmap.Height + AddSize;
|
||||
AddText := dmData.LogName + ' ' + LogBand + ' ' + WsMode.items[WsMode.ItemIndex] + ' ' +
|
||||
IntToStr(MainGridCount) + 'main/' + IntToStr(
|
||||
GridCount) + 'sub grids ' + dmData.DBName +
|
||||
' ' + BandQsoCount + '/' + MaxRowId + 'qsos';
|
||||
end
|
||||
else begin
|
||||
AddSize := 40;
|
||||
aWidth := ZooMap.Picture.Bitmap.Width;
|
||||
aHeight := ZooMap.Picture.Bitmap.Height + AddSize;
|
||||
AddText := dmData.LogName + ' ' + LogBand + ' ' +
|
||||
WsMode.items[WsMode.ItemIndex] + ' ' + LogMainGrid +
|
||||
' -> ' + IntToStr(GridCount) + 'subgrids';
|
||||
AddText1 := dmData.DBName + ' ' + BandQsoCount + '/' + MaxRowId + 'qsos';
|
||||
end;
|
||||
|
||||
Bmp := TBitmap.Create;
|
||||
try try
|
||||
Bmp.Width := aWidth;
|
||||
Bmp.Height := aHeight;
|
||||
Bmp.Canvas.Rectangle(0, 0, aWidth, aHeight);
|
||||
|
||||
if LocMap.Visible then
|
||||
begin
|
||||
Bmp.Canvas.CopyRect(Rect(0, AddSize, aWidth, aHeight), LocMap.Picture.Bitmap.Canvas, Rect(0, 0, aWidth, aHeight - AddSize));
|
||||
end
|
||||
else begin
|
||||
Bmp.Canvas.CopyRect(Rect(0, AddSize, aWidth, aHeight), ZooMap.Picture.Bitmap.Canvas, Rect(0, 0, aWidth, aHeight - AddSize));
|
||||
end;
|
||||
Bmp.Canvas.Brush.Style := bsClear;
|
||||
Bmp.Canvas.font.Size := 10;
|
||||
Bmp.Canvas.font.Color := clBlack;
|
||||
Bmp.Canvas.TextOut(5, 3, AddText);
|
||||
if AddText1 <> '' then
|
||||
Bmp.Canvas.TextOut(5, 23, AddText1);
|
||||
|
||||
Bmp.SaveToFile(SaveMapImage.FileName);
|
||||
except
|
||||
on E: Exception do
|
||||
ShowMessage('Error: ' + E.Message)
|
||||
end
|
||||
finally
|
||||
Bmp.Free
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.SaveMapClick(Sender: TObject);
|
||||
begin
|
||||
if LocMap.Visible then
|
||||
SaveMapImage.FileName := LogSave + '.bmp'
|
||||
else
|
||||
SaveMapImage.FileName := LogSave + '_' + LogMainGrid + '.bmp';
|
||||
SaveMapImage.Execute
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.AutoUpdateTimer(Sender: TObject);
|
||||
var
|
||||
mode, band: string;
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('WkdGrids-TimerTick. FlwRig stage0 is:', FollowRig.Checked);
|
||||
AutoUpdate.Enabled := False;
|
||||
|
||||
if FollowRig.Checked then
|
||||
begin
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(' FlwRig stage 1 is:', FollowRig.Checked);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln(' FlwRig getmode returns(st-m-b):', frmTRXControl.GetModeBand(
|
||||
mode, band), ' ', mode, ' ', band);
|
||||
if (frmTRXControl.GetModeBand(mode, band)) and (band <> '') then
|
||||
//if off from ham freq gives True, but empty band !!!
|
||||
begin
|
||||
//here wsjt-x makes exeption as mode is JT9 , JT65 or combination JT9+JT65 not what RigCtl says
|
||||
//maybe same is needed from fldigi, too. It just does not update it before qso is logged!
|
||||
//perhaps could use preference's option: (rigctl, from program or fixed "RTTY")
|
||||
|
||||
//empty frmNewQSO.WsjtxMode causes crash. Happens if "follow rig" checked before wsjtx starts.
|
||||
if frmNewQSO.mnuRemoteModeWsjt.Checked and (frmNewQSO.WsjtxMode <> '') then
|
||||
mode := frmNewQSO.WsjtxMode;
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Follow rig mode: ', mode, ' Band: ', band);
|
||||
if WsMode.ItemIndex < 0 then
|
||||
ToRigMode(mode)
|
||||
else
|
||||
if WsMode.Items[WsMode.ItemIndex] <> mode then
|
||||
ToRigMode(mode);
|
||||
|
||||
if BandSelector.ItemIndex < 0 then
|
||||
ToRigBand(band)
|
||||
else
|
||||
if BandSelector.Items[BandSelector.ItemIndex] <> band then
|
||||
ToRigBand(band);
|
||||
end;
|
||||
end;
|
||||
|
||||
if (BandSelector.ItemIndex >= 0) and (WsMode.ItemIndex >= 0) and Changes then
|
||||
//both must be set
|
||||
begin
|
||||
BandSelectorChange(AutoUpdate); //update map(s)
|
||||
end;
|
||||
AutoUpdate.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.WsModeChange(Sender: TObject);
|
||||
begin
|
||||
if (BandSelector.ItemIndex >= 0) then
|
||||
BandSelectorChange(WsMode);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmWorkedGrids.ZooMapClick(Sender: TObject);
|
||||
begin
|
||||
ZooMap.Visible := False;
|
||||
ZooILbl.Visible := False;
|
||||
ShoWkdOnlyClick(ZooMap);
|
||||
LocMap.Visible := True;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.BandSelectorChange(Sender: TObject); //update map(s)
|
||||
var
|
||||
MainGridStream, SQLExtension, Grid: string;
|
||||
qsocount, c: integer;
|
||||
SQLCfm: array [0 .. 2] of string;
|
||||
begin
|
||||
//no updates if band and mode are not set
|
||||
if (BandSelector.ItemIndex >= 0) and (WsMode.ItemIndex >= 0) then
|
||||
begin
|
||||
AutoUpdate.Enabled := False;
|
||||
Changes := False;
|
||||
//clean map if caller is not zoomed grid(=visible)
|
||||
if ZooMap.Visible then
|
||||
begin
|
||||
LocMapClick(BandSelector);
|
||||
end
|
||||
else begin
|
||||
LocMap.Canvas.CopyRect(Rect(0, 0, Width, Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas, Rect(0, 0, Width, Height));
|
||||
if not ShoWkdOnly.Checked then
|
||||
DrawBase(LocMap.canvas, False);
|
||||
end;
|
||||
|
||||
case WsMode.ItemIndex of
|
||||
//any
|
||||
0: SQLExtension := '';
|
||||
//JT9+JT65
|
||||
1: SQLExtension := ' and ((mode=' + chr(39) + 'JT9' + chr(39) +
|
||||
') or ( mode=' + chr(39) + 'JT65' + chr(39) + '))';
|
||||
else // all others
|
||||
SQLExtension := ' and mode=' + chr(39) + WsMode.items[WsMode.ItemIndex] + chr(39);
|
||||
end;
|
||||
|
||||
|
||||
//1:not (at all) confirmed grids
|
||||
SQLCfm[1] := ' and eqsl_qsl_rcvd<>' + chr(39) + 'E' + chr(39) +
|
||||
' and lotw_qslr<>' + chr(39) + 'L' + chr(39) + ' and qsl_r<>' + chr(39) + 'Q' + chr(39);
|
||||
//2:some way confirmed grids
|
||||
SQLCfm[2] := ' and (eqsl_qsl_rcvd=' + chr(39) + 'E' + chr(39) +
|
||||
' or lotw_qslr=' + chr(39) + 'L' + chr(39) + ' or qsl_r=' + chr(39) + 'Q' + chr(39) + ')';
|
||||
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then
|
||||
dmData.trQ.Rollback;
|
||||
|
||||
if BandSelector.ItemIndex > 0 then //band selected
|
||||
begin
|
||||
//0:the base query string
|
||||
SQLCfm[0] := 'select upper(left(loc,4)) as lo from ' + LogTable +
|
||||
' where band=' + chr(39) + BandSelector.items[BandSelector.ItemIndex] +
|
||||
chr(39) + 'and loc<>' + chr(39) + chr(39) + SQLExtension;
|
||||
end
|
||||
else begin //band "all"
|
||||
SQLCfm[0] := 'select upper(left(loc,4)) lo from ' + LogTable +
|
||||
' where loc<>' + chr(39) + chr(39) + SQLExtension;
|
||||
end;
|
||||
if ZooMap.Visible then //coming from zoomed grid
|
||||
begin
|
||||
SQLCfm[0] := SQLCfm[0] + ' and loc like ' + chr(39) + LogMainGrid + '%' + chr(39);
|
||||
end;
|
||||
|
||||
GridCount := 0;
|
||||
MainGridCount := 0;
|
||||
MainGridStream := '';
|
||||
dmData.trQ.StartTransaction;
|
||||
try
|
||||
for c := 1 to 2 do
|
||||
begin
|
||||
dmData.Q.SQL.Text := SQLCfm[0] + SQLCfm[c];
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.EOF do
|
||||
begin
|
||||
Grid := dmData.Q.FieldByName('lo').AsString;
|
||||
|
||||
if ZooMap.Visible then //coming from zoomed grid
|
||||
begin
|
||||
MarkGrid(Grid, c = 2, ZooMap.canvas, True);
|
||||
end
|
||||
else begin
|
||||
MarkGrid(Grid, c = 2, LocMap.canvas, False);
|
||||
end;
|
||||
|
||||
if (GridOK(Grid)) and (pos(copy(Grid, 1, 2), MainGridStream) = 0) then
|
||||
begin
|
||||
Inc(MainGridCount);
|
||||
MainGridStream := MainGridStream + ',' + copy(Grid, 1, 2);
|
||||
end;
|
||||
|
||||
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
end;
|
||||
|
||||
//distinct sub grid count
|
||||
dmData.Q.SQL.Text := 'select distinct' + copy(SQLCfm[0], 7, length(SQLCfm[0]));
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.EOF do
|
||||
begin
|
||||
Inc(GridCount);
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
|
||||
MaxRowId := RecordCount;
|
||||
if (BandSelector.ItemIndex > 0) then
|
||||
begin
|
||||
qsocount := 0;
|
||||
dmData.Q.SQL.Text := 'select loc from ' + LogTable + ' where band=' + chr(39) +
|
||||
BandSelector.items[BandSelector.ItemIndex] + chr(39) +
|
||||
SQLExtension;
|
||||
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Write(dmData.Q.SQL.Text);
|
||||
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.EOF do
|
||||
begin
|
||||
Inc(qsocount);
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
BandQsoCount := IntToStr(qsocount);
|
||||
end
|
||||
else begin
|
||||
BandQsoCount := MaxRowId;
|
||||
end;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if (BandSelector.ItemIndex >= 0) and (WsMode.ItemIndex >= 0) then
|
||||
//both must be set
|
||||
begin
|
||||
LogSave := 'Wkd_locs_' + dmData.LogName + '_' +
|
||||
BandSelector.items[BandSelector.ItemIndex];
|
||||
LogBand := BandSelector.items[BandSelector.ItemIndex];
|
||||
frmWorkedGrids.Caption :=
|
||||
'Worked locator grids ' + dmData.LogName + ' ' + LogBand + ' ' + WsMode.items[WsMode.ItemIndex];
|
||||
end;
|
||||
|
||||
Nrgrids.Caption := IntToStr(MainGridCount) + 'main/' + IntToStr(
|
||||
GridCount) + 'sub grids';
|
||||
Nrstatus.Caption := dmData.LogName;
|
||||
Nrqsos.Caption := BandQsoCount + '/' + MaxRowId + 'qsos';
|
||||
Nrgrids.Visible := True;
|
||||
Nrstatus.Visible := True;
|
||||
Nrqsos.Visible := True;
|
||||
|
||||
AutoUpdate.Enabled := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.FormShow(Sender: TObject);
|
||||
begin
|
||||
dmUtils.LoadWindowPos(frmWorkedGrids);
|
||||
FollowRig.Checked := cqrini.ReadBool('Worked_grids', 'FollowRig', False);
|
||||
ShoWkdOnly.Checked := cqrini.ReadBool('Worked_grids', 'ShowWkdOnly', False);
|
||||
AutoUpdate.Enabled := True;
|
||||
BandSelectorChange(nil)
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.LocMapClick(Sender: TObject);
|
||||
|
||||
var
|
||||
Bmp: TBitmap;
|
||||
aWidth, aHeight, ww, hh: integer;
|
||||
|
||||
begin
|
||||
|
||||
if (BandSelector.ItemIndex >= 0) and (WsMode.ItemIndex >= 0) then //both must be set
|
||||
begin
|
||||
ww := 0;
|
||||
hh := 0;
|
||||
aWidth := 40;
|
||||
aHeight := 20;
|
||||
Bmp := TBitmap.Create;
|
||||
Bmp.Width := aWidth;
|
||||
Bmp.Height := aHeight;
|
||||
Bmp.Canvas.CopyRect(Rect(0, 0, aWidth, aHeight),
|
||||
LocMapBase.Picture.Bitmap.Canvas,
|
||||
Rect(MouseX, MouseY, MouseX + aWidth + 1, MouseY + aHeight + 1));
|
||||
ZooMap.Picture.Bitmap.SetSize(ZooMap.Width, ZooMap.Height);
|
||||
ZooMap.Picture.Bitmap.Canvas.StretchDraw(
|
||||
Rect(0, 0, ZooMap.Picture.Bitmap.Width, ZooMap.Picture.Bitmap.Height), Bmp);
|
||||
Bmp.Free;
|
||||
DrawBase(ZooMap.Canvas, True);
|
||||
|
||||
if Sender <> BandSelector then //to avoid BandSelector looping when ZooMap active
|
||||
begin
|
||||
LogMainGrid := chr((MouseX) div 40 + 65) + chr((340 - MouseY) div 20 + 65);
|
||||
LocMap.Visible := False;
|
||||
ZooMap.Visible := True;
|
||||
ZooILbl.Visible := True;
|
||||
with ZooIlbl.Canvas do
|
||||
//had to make this grapic as cqrlog controls font size of window after wkd-map
|
||||
begin
|
||||
//position saved/loaded as other forms and I'm too lazy to dig out how to avoid it
|
||||
Clear;
|
||||
Brush.Color := clBackground;
|
||||
FillRect(0, 0, Width, Height);
|
||||
Brush.style := bsClear;
|
||||
font.Color := clBlack;
|
||||
Font.Style := [fsBold];
|
||||
font.Size := 54;
|
||||
repeat //fit the text to canvas
|
||||
begin
|
||||
font.Size := font.Size - 1;
|
||||
GetTextSize(LogMainGrid, ww, hh);
|
||||
if dmData.DebugLevel >= 1 then
|
||||
Writeln('Font size:', font.Size);
|
||||
end;
|
||||
until (ww <= Width) and (hh <= Height);
|
||||
TextOut(1, 1, LogMainGrid);
|
||||
end;
|
||||
|
||||
BandSelectorChange(LocMap);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.LocMapMouseMove(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: integer);
|
||||
begin
|
||||
MouseX := (X div 40) * 40;
|
||||
MouseY := (Y div 20) * 20;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.ShoWkdOnlyClick(Sender: TObject);
|
||||
begin
|
||||
if (BandSelector.ItemIndex >= 0) and (WsMode.ItemIndex >= 0) then
|
||||
//both must be set
|
||||
begin
|
||||
BandSelectorChange(BandSelector);
|
||||
end
|
||||
else begin
|
||||
LocMap.Canvas.CopyRect(Rect(0, 0, Width, Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas, Rect(0, 0, Width, Height));
|
||||
if not ShoWkdOnly.Checked then
|
||||
DrawBase(LocMap.canvas, False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorkedGrids.FormClose(Sender: TObject);
|
||||
begin
|
||||
AutoUpdate.Enabled := False;
|
||||
cqrini.WriteBool('Worked_grids', 'FollowRig', FollowRig.Checked);
|
||||
cqrini.WriteBool('Worked_grids', 'ShowWkdOnly', ShoWkdOnly.Checked);
|
||||
dmUtils.SaveWindowPos(frmWorkedGrids);
|
||||
frmWorkedGrids.hide;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
362
src/fcontest.pas
362
src/fcontest.pas
@ -1,362 +0,0 @@
|
||||
unit fContest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls,LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmContest }
|
||||
|
||||
TfrmContest = class(TForm)
|
||||
btSave: TButton;
|
||||
chTrueRST: TCheckBox;
|
||||
chNoNr: TCheckBox;
|
||||
chSpace: TCheckBox;
|
||||
chLoc: TCheckBox;
|
||||
chNRInc: TCheckBox;
|
||||
edtCall: TEdit;
|
||||
edtRSTs: TEdit;
|
||||
edtSTX: TEdit;
|
||||
edtSTX2: TEdit;
|
||||
edtRSTr: TEdit;
|
||||
edtSRX: TEdit;
|
||||
edtSRX2: TEdit;
|
||||
lblCall: TLabel;
|
||||
lblRSTs: TLabel;
|
||||
lblMSGs: TLabel;
|
||||
lblRSTr: TLabel;
|
||||
lblNRr: TLabel;
|
||||
lblMSGr: TLabel;
|
||||
lblNRs: TLabel;
|
||||
tmrESC2: TTimer;
|
||||
procedure btSaveClick(Sender: TObject);
|
||||
procedure chNoNrChange(Sender: TObject);
|
||||
procedure chTrueRSTChange(Sender: TObject);
|
||||
procedure edtCallExit(Sender: TObject);
|
||||
procedure edtCallKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
|
||||
);
|
||||
procedure edtCallKeyPress(Sender: TObject; var Key: char);
|
||||
procedure edtSRXExit(Sender: TObject);
|
||||
procedure edtSTX2Exit(Sender: TObject);
|
||||
procedure edtSTXExit(Sender: TObject);
|
||||
procedure edtSTXKeyPress(Sender: TObject; var Key: char);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormHide(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure tmrESC2Timer(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure InitInput;
|
||||
procedure ChkSerialNrUpd(IncNr:boolean);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmContest: TfrmContest;
|
||||
RSTstx :string = ''; //contest mode serial numbers store
|
||||
RSTstxAdd :string = ''; //contest mode additional string store
|
||||
//RSTsrx :string = '';
|
||||
EscFirstTime :Boolean = false;
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmContest }
|
||||
|
||||
Uses dData,dUtils,fNewQSO;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TfrmContest.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
var
|
||||
tmp : String;
|
||||
speed : Integer = 0;
|
||||
i : Integer = 0;
|
||||
|
||||
begin
|
||||
// enter anywhere
|
||||
if key = VK_RETURN then
|
||||
Begin
|
||||
if (length(edtCall.Text) > 2 ) then //must be some kind of call
|
||||
btSave.Click;
|
||||
key := 0
|
||||
end;
|
||||
|
||||
//esc and double esc
|
||||
if key = VK_ESCAPE then
|
||||
begin
|
||||
if EscFirstTime then
|
||||
begin
|
||||
if edtCall.Text = '' then
|
||||
edtCall.SetFocus
|
||||
else
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
frmNewQSO.CWint.StopSending;
|
||||
EscFirstTime := False;
|
||||
tmrESC2.Enabled := True;
|
||||
end
|
||||
else
|
||||
begin // esc second time
|
||||
frmNewQSO.ClearAll;
|
||||
writeln('Clear all done nex focus');
|
||||
initInput;
|
||||
tmrESC2Timer(nil);
|
||||
end;
|
||||
key := 0
|
||||
end;
|
||||
|
||||
//cw memories
|
||||
if (Key >= VK_F1) and (Key <= VK_F10) and (Shift = []) then
|
||||
begin
|
||||
if (frmNewQSO.cmbMode.Text='SSB') then
|
||||
frmNewQSO.RunVK(dmUtils.GetDescKeyFromCode(Key))
|
||||
else
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
frmNewQSO.CWint.SendText(dmUtils.GetCWMessage(dmUtils.GetDescKeyFromCode(Key),frmNewQSO.edtCall.Text,frmNewQSO.edtHisRST.Text,frmNewQSO.edtName.Text,frmNewQSO.lblGreeting.Caption,''));
|
||||
key := 0
|
||||
end;
|
||||
|
||||
if (key = 33) then//pgup
|
||||
begin
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
begin
|
||||
speed := frmNewQSO.CWint.GetSpeed+2;
|
||||
frmNewQSO.CWint.SetSpeed(speed);
|
||||
frmNewQSO.sbNewQSO.Panels[2].Text := IntToStr(speed)+'WPM'
|
||||
end;
|
||||
key := 0
|
||||
end;
|
||||
|
||||
if (key = 34) then//pgup
|
||||
begin
|
||||
if Assigned(frmNewQSO.CWint) then
|
||||
begin
|
||||
speed := frmNewQSO.CWint.GetSpeed-2;
|
||||
frmNewQSO.CWint.SetSpeed(speed);
|
||||
frmNewQSO.sbNewQSO.Panels[2].Text := IntToStr(speed)+'WPM'
|
||||
end;
|
||||
key := 0
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmContest.edtCallExit(Sender: TObject);
|
||||
begin
|
||||
frmNewQSO.edtCall.Text := edtCall.Text;
|
||||
frmNewQSO.edtHisRST.Text:= edtRSTs.Text+' '+edtSTX.Text+' '+edtSTX2.Text; //so that CW macros work
|
||||
frmNewQSO.edtCallExit(nil);
|
||||
frmContest.ShowOnTop;
|
||||
frmContest.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.btSaveClick(Sender: TObject);
|
||||
begin
|
||||
|
||||
frmNewQSO.edtHisRST.Text:= edtRSTs.Text+' '+edtSTX.Text+' '+edtSTX2.Text; //this should be ok before
|
||||
if chLoc.Checked then
|
||||
Begin
|
||||
frmNewQSO.edtMyRST.Text:= edtRSTr.Text+' '+edtSRX.Text;
|
||||
frmNewQSO.edtGrid.Text := edtSRX2.Text;
|
||||
end
|
||||
else
|
||||
frmNewQSO.edtMyRST.Text:= edtRSTr.Text+' '+edtSRX.Text+' '+edtSRX2.Text;
|
||||
|
||||
frmNewQSO.btnSave.Click;
|
||||
writeln('input finale');
|
||||
ChkSerialNrUpd(chNRInc.Checked);
|
||||
initInput;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.chNoNrChange(Sender: TObject);
|
||||
var n,m,s,c:integer;
|
||||
procedure swapTab;
|
||||
Begin //swap
|
||||
c:=n;
|
||||
n:=m;
|
||||
m:=c;
|
||||
if (m<n) and (s>n) then //must change n and s
|
||||
begin
|
||||
c:=n;
|
||||
n:=s;
|
||||
s:=c;
|
||||
end;
|
||||
if (n<m) and (s<m) then //must change m and s
|
||||
begin
|
||||
c:=m;
|
||||
m:=s;
|
||||
s:=c;
|
||||
end;
|
||||
|
||||
end ;
|
||||
begin
|
||||
n := edtSRX.TabOrder;
|
||||
m := edtSRX2.TabOrder;
|
||||
s := btSave.TabOrder;
|
||||
|
||||
if (chNoNr.Checked) and (n < m ) then //msg always gets smaller tab order
|
||||
swapTab;
|
||||
|
||||
if (not chNoNr.Checked) and (m < n ) then //msg always gets higher tab order
|
||||
swapTab;
|
||||
edtSRX.TabOrder:=n;
|
||||
edtSRX2.TabOrder:=m;
|
||||
btSave.TabOrder := s;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmContest.chTrueRSTChange(Sender: TObject);
|
||||
begin
|
||||
if chTrueRST.Checked then
|
||||
Begin //true RST order
|
||||
edtRSTs.TabOrder := 1;
|
||||
edtRSTr.TabOrder := 2;
|
||||
edtSRX.TabOrder := 3;
|
||||
edtSRX2.TabOrder := 4;
|
||||
btSave.TabOrder := 5;
|
||||
end
|
||||
else
|
||||
Begin //contest order
|
||||
edtSRX.TabOrder := 1;
|
||||
edtSRX2.TabOrder := 2;
|
||||
btSave.TabOrder := 3;
|
||||
edtRSTr.TabOrder := 4;
|
||||
edtRSTs.TabOrder := 5;
|
||||
end;
|
||||
frmContest.chNoNrChange(nil); //finally check Nr/MSG order
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtCallKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if ((Key=VK_SPACE) and (chSpace.Checked)) then
|
||||
begin
|
||||
Key := 0;
|
||||
SelectNext(Sender as TWinControl, True, True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtCallKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if not (key in ['a'..'z','A'..'Z', '0'..'9', '/',chr(VK_DELETE),chr(VK_BACK),chr(VK_RIGHT),chr(VK_LEFT)] ) then key:=#0;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSRXExit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(false); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTX2Exit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(false); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTXExit(Sender: TObject);
|
||||
begin
|
||||
ChkSerialNrUpd(false); //just save it
|
||||
end;
|
||||
|
||||
procedure TfrmContest.edtSTXKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if not (key in ['0'..'9',chr(VK_SPACE),chr(VK_DELETE),chr(VK_BACK),chr(VK_RIGHT),chr(VK_LEFT)] ) then key:=#0;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormCreate(Sender: TObject);
|
||||
begin
|
||||
frmContest.KeyPreview := True;
|
||||
end;
|
||||
procedure TfrmContest.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
dmUtils.SaveWindowPos(frmContest);
|
||||
|
||||
end;
|
||||
procedure TfrmContest.FormHide(Sender: TObject);
|
||||
begin
|
||||
dmUtils.SaveWindowPos(frmContest);
|
||||
frmContest.Hide;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.FormShow(Sender: TObject);
|
||||
begin
|
||||
dmUtils.LoadWindowPos(frmContest);
|
||||
InitInput;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.tmrESC2Timer(Sender: TObject);
|
||||
begin
|
||||
EscFirstTime := True; //time for double esc passed
|
||||
tmrESC2.Enabled := False
|
||||
end;
|
||||
|
||||
procedure TfrmContest.InitInput;
|
||||
Begin
|
||||
edtRSTs.Text := trim(copy(frmNewQSO.edtHisRST.Text,0,3)); //just pick '599' or '59 ' if there happens to be more
|
||||
edtRSTr.Text := trim(copy(frmNewQSO.edtMyRST.Text,0,3));
|
||||
edtSTX.Text := RSTstx;
|
||||
edtSTX2.Text := RSTstxAdd;
|
||||
edtSRX.Text := '';
|
||||
edtSRX2.Text := '';
|
||||
edtCall.Clear;
|
||||
frmContest.ShowOnTop;
|
||||
frmContest.SetFocus;
|
||||
edtCall.SetFocus;
|
||||
EscFirstTime := True;
|
||||
end;
|
||||
|
||||
procedure TfrmContest.ChkSerialNrUpd(IncNr:boolean); // do we need serial nr inc
|
||||
var //otherwise just update memos
|
||||
stxLen,
|
||||
stxInt : integer;
|
||||
lZero : boolean;
|
||||
stx : string;
|
||||
|
||||
Begin
|
||||
stx := trim(edtSTX.Text);
|
||||
|
||||
if IncNr then
|
||||
Begin
|
||||
stxlen:= length(stx);
|
||||
if chNRInc.Checked then //inc of number requested
|
||||
Begin
|
||||
lZero:= stx[1] = '0'; //do we have leading zero(es)
|
||||
if dmData.DebugLevel>=1 then Writeln('Need inc number:',stx,' Has leading zero:',lZero,' len:',stxlen);
|
||||
if TryStrToInt(stx,stxint) then
|
||||
Begin
|
||||
if dmData.DebugLevel>=1 then Writeln('Integer is:',stxInt);
|
||||
inc(stxInt);
|
||||
stx :=IntToStr(stxInt);
|
||||
if dmData.DebugLevel>=1 then Writeln('New number is:',stx);
|
||||
if (length(stx) < stxLen ) and lZero then //pad with zero(es)
|
||||
Begin
|
||||
//AddChar('0',stx,stxLen); // why does this NOT work???
|
||||
While length(stx) < stxlen do
|
||||
stx:= '0'+stx;
|
||||
if dmData.DebugLevel>=1 then Writeln('After leading zero(es) added:',stx);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
RSTstx:=stx;
|
||||
RSTstxAdd:=edtSTX2.Text;
|
||||
|
||||
if dmData.DebugLevel>=1 then Writeln(' Inc number is: ',IncNr);
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I fContest.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,490 +0,0 @@
|
||||
unit fProp_DK0WCY;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls,ComCtrls,Buttons, httpsend, LCLType, ftpsend,
|
||||
lazutf8sysutils, lclintf;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmProp_DK0WCY }
|
||||
|
||||
TfrmProp_DK0WCY = class(TForm)
|
||||
ImageKidx: TImage;
|
||||
lblInfoDate: TLabel;
|
||||
lblBoulAidx: TLabel;
|
||||
lblKidxG: TLabel;
|
||||
lblInfoFrom: TLabel;
|
||||
lblInfoUTC: TLabel;
|
||||
DKiel3K: TLabel;
|
||||
lblCurKidx: TLabel;
|
||||
lblSolarFlx: TLabel;
|
||||
lblSunSNr: TLabel;
|
||||
lblGeomFi: TLabel;
|
||||
lblSolAct: TLabel;
|
||||
lblKielAidx: TLabel;
|
||||
lblAurora: TLabel;
|
||||
lblKiel3K: TLabel;
|
||||
DKielAidx: TLabel;
|
||||
DAurora: TLabel;
|
||||
lblInfo: TLabel;
|
||||
DGeomFi: TLabel;
|
||||
DSunSNr: TLabel;
|
||||
DSolarFlx: TLabel;
|
||||
DSolAct: TLabel;
|
||||
DCurKidx: TLabel;
|
||||
DBoulAidx: TLabel;
|
||||
Panel1: TPanel;
|
||||
sbtnRefresh : TSpeedButton;
|
||||
tmrProp: TTimer;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDblClick(Sender: TObject);
|
||||
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure lblInfoFromMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure lblInfoFromMouseEnter(Sender: TObject);
|
||||
procedure lblInfoFromMouseLeave(Sender: TObject);
|
||||
procedure sbtnRefreshClick(Sender : TObject);
|
||||
procedure tmrPropTimer(Sender: TObject);
|
||||
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
ak : String;
|
||||
ab : String;
|
||||
k : String;
|
||||
k3h : String;
|
||||
sfi : String;
|
||||
ssn : String;
|
||||
sa : String;
|
||||
gf : String;
|
||||
au : String;
|
||||
time : String;
|
||||
date : String;
|
||||
UTC : String;
|
||||
HttpFrm: String;
|
||||
running : Boolean;
|
||||
|
||||
dbc : integer; // debug colors
|
||||
|
||||
procedure SyncProp;
|
||||
procedure KidxGraph;
|
||||
function getKindexColor(kIndex : integer) : TColor;
|
||||
end;
|
||||
|
||||
type
|
||||
KData = array [0..35] of integer; //stores 3h K-idx data
|
||||
TPropThread = class(TThread)
|
||||
protected
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
frmProp_DK0WCY : TfrmProp_DK0WCY;
|
||||
KValues : KData;
|
||||
BkColor : TColor = clGray; //background and borderline in KidxGraph
|
||||
FrColor : TColor = clBlack;
|
||||
|
||||
tstcolor : integer; // for color testing
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmProp_DK0WCY }
|
||||
uses dData, dUtils, uMyIni, fNewQSO;
|
||||
|
||||
procedure TPropThread.Execute;
|
||||
var
|
||||
HTTP : THTTPSend;
|
||||
tmp : String;
|
||||
m : TStringList;
|
||||
p : Integer;
|
||||
ki : Integer;
|
||||
t : String;
|
||||
|
||||
begin
|
||||
if frmProp_DK0WCY.running then
|
||||
exit;
|
||||
frmProp_DK0WCY.running := True;
|
||||
frmProp_DK0WCY.ak := '';
|
||||
frmProp_DK0WCY.ab := '';
|
||||
frmProp_DK0WCY.k := '';
|
||||
frmProp_DK0WCY.sfi := '';
|
||||
frmProp_DK0WCY.ssn := '';
|
||||
frmProp_DK0WCY.sa := '';
|
||||
frmProp_DK0WCY.gf := '';
|
||||
frmProp_DK0WCY.au := '';
|
||||
frmProp_DK0WCY.time := '';
|
||||
frmProp_DK0WCY.date := '';
|
||||
frmProp_DK0WCY.UTC := '';
|
||||
frmProp_DK0WCY.HttpFrm := '';
|
||||
frmProp_DK0WCY.k3h := '';
|
||||
|
||||
FreeOnTerminate := True;
|
||||
http := THTTPSend.Create;
|
||||
m := TStringList.Create;
|
||||
try
|
||||
HTTP.ProxyHost := cqrini.ReadString('Program','Proxy','');
|
||||
HTTP.ProxyPort := cqrini.ReadString('Program','Port','');
|
||||
HTTP.UserName := cqrini.ReadString('Program','User','');
|
||||
HTTP.Password := cqrini.ReadString('Program','Passwd','');
|
||||
frmProp_DK0WCY.HttpFrm := 'http://dk0wcy.de/magnetogram/'; //fetch address
|
||||
if HTTP.HTTPMethod('GET', frmProp_DK0WCY.HttpFrm ) then
|
||||
begin
|
||||
m.LoadFromStream(HTTP.Document);
|
||||
tmp := m.Text;
|
||||
|
||||
if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
Writeln('TMP: ',tmp)
|
||||
end;
|
||||
|
||||
p := Pos('>Indices of',tmp);
|
||||
frmProp_DK0WCY.time := trim(copy(tmp,p+1,30));
|
||||
frmProp_DK0WCY.time := copy(frmProp_DK0WCY.time,1,Pos('</th>',frmProp_DK0WCY.time)-1);
|
||||
frmProp_DK0WCY.time := frmProp_DK0WCY.time;
|
||||
frmProp_DK0WCY.UTC := TimeToStr(nowUTC());
|
||||
frmProp_DK0WCY.date := DateToStr(nowUTC());
|
||||
|
||||
p := Pos('>Boulder A',tmp);
|
||||
frmProp_DK0WCY.ab := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.ab := copy(frmProp_DK0WCY.ab,1,Pos('</b>',frmProp_DK0WCY.ab)-1);
|
||||
|
||||
p := Pos('>Solar Activity',tmp);
|
||||
frmProp_DK0WCY.sa := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.sa := copy(frmProp_DK0WCY.sa,1,Pos('</b>',frmProp_DK0WCY.sa)-1);
|
||||
|
||||
p := Pos('>Kiel A',tmp);
|
||||
frmProp_DK0WCY.ak := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.ak := copy(frmProp_DK0WCY.ak,1,Pos('</b>',frmProp_DK0WCY.ak)-1);
|
||||
|
||||
p := Pos('>Kiel current k',tmp);
|
||||
frmProp_DK0WCY.k := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.k := copy(frmProp_DK0WCY.k,1,Pos('</b>',frmProp_DK0WCY.k)-1);
|
||||
|
||||
p := Pos('>Geomagnetic Field',tmp);
|
||||
frmProp_DK0WCY.gf := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.gf := copy(frmProp_DK0WCY.gf,1,Pos('</b>',frmProp_DK0WCY.gf)-1);
|
||||
|
||||
p := Pos('>Sunspot Number',tmp);
|
||||
frmProp_DK0WCY.ssn := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.ssn := copy(frmProp_DK0WCY.ssn,1,Pos('</b>',frmProp_DK0WCY.ssn)-1);
|
||||
|
||||
p := Pos('>Aurora',tmp);
|
||||
frmProp_DK0WCY.au := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.au := copy(frmProp_DK0WCY.au,1,Pos('</b>',frmProp_DK0WCY.au)-1);
|
||||
|
||||
p := Pos('>Solar Flux',tmp);
|
||||
frmProp_DK0WCY.sfi := trim(copy(tmp,p+30,18));
|
||||
frmProp_DK0WCY.sfi := copy(frmProp_DK0WCY.sfi,1,Pos('</b>',frmProp_DK0WCY.sfi)-1);
|
||||
|
||||
p := Pos('>Kiel 3-hour k',tmp);
|
||||
frmProp_DK0WCY.k3h := trim(copy(tmp,p+44,18));
|
||||
frmProp_DK0WCY.k3h := copy(frmProp_DK0WCY.k3h,1,Pos('</b>',frmProp_DK0WCY.k3h)-1)
|
||||
end;
|
||||
|
||||
if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
Writeln('Time: ',frmProp_DK0WCY.time);
|
||||
Writeln('UTC: ',frmProp_DK0WCY.UTC);
|
||||
Writeln('Boulder A:',frmProp_DK0WCY.ab);
|
||||
Writeln('Solar Act:',frmProp_DK0WCY.sa);
|
||||
Writeln('Kiel A:',frmProp_DK0WCY.ak);
|
||||
Writeln('Kiel K: ',frmProp_DK0WCY.k);
|
||||
Writeln('Kiel 3h ',frmProp_DK0WCY.k3h);
|
||||
Writeln('GF: ',frmProp_DK0WCY.gf);
|
||||
Writeln('SSN: ',frmProp_DK0WCY.ssn);
|
||||
Writeln('Aurora: ',frmProp_DK0WCY.au);
|
||||
Writeln('SFI: ',frmProp_DK0WCY.sfi)
|
||||
end;
|
||||
|
||||
Synchronize(@frmProp_DK0WCY.SyncProp);
|
||||
finally
|
||||
http.Free;
|
||||
m.Free;
|
||||
frmProp_DK0WCY.running := False
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmProp_DK0WCY.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
tmrProp.Enabled := False;
|
||||
dmUtils.SaveWindowPos(frmProp_DK0WCY)
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.FormCreate(Sender: TObject);
|
||||
var kloop : integer;
|
||||
|
||||
Begin
|
||||
//clear K-idx image and data
|
||||
ImageKidx.Canvas.brush.style := bsSolid;
|
||||
ImageKidx.Canvas.brush.Color := BkColor;
|
||||
ImageKidx.Canvas.pen.Color := BkColor;
|
||||
ImageKidx.Canvas.Rectangle(0,0,ImageKidx.Width,ImageKidx.Height);
|
||||
ImageKidx.Canvas.pen.Width := 1;
|
||||
for kloop := 0 to 35 do
|
||||
begin
|
||||
KValues[kloop] :=-1;
|
||||
end;
|
||||
|
||||
{ if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
tstcolor :=0;
|
||||
end; }
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.FormDblClick(Sender: TObject);
|
||||
begin
|
||||
tmrPropTimer(nil)
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.FormKeyUp(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if (key= VK_ESCAPE) then
|
||||
begin
|
||||
frmNewQSO.ReturnToNewQSO;
|
||||
key := 0
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.FormShow(Sender: TObject);
|
||||
const
|
||||
C_LOADING = 'Loading...';
|
||||
begin
|
||||
running := False;
|
||||
dmUtils.LoadWindowPos(frmProp_DK0WCY);
|
||||
DBoulAidx.Caption := C_LOADING;
|
||||
DKielAidx.Caption := C_LOADING;
|
||||
DCurKidx.Caption := C_LOADING;
|
||||
DKiel3K.Caption := C_LOADING;
|
||||
DAurora.Caption := C_LOADING;
|
||||
DSolarFlx.Caption := C_LOADING;
|
||||
DSunSNr.Caption := C_LOADING;
|
||||
DSolAct.Caption := C_LOADING;
|
||||
DGeomFi.Caption := C_LOADING;
|
||||
lblInfo.Caption := '';
|
||||
lblInfoUTC.Caption := '';
|
||||
lblInfoDate.Caption := '';
|
||||
lblInfoFrom.Caption:= frmProp_DK0WCY.HttpFrm;
|
||||
tmrProp.Enabled := False;
|
||||
tmrProp.Interval := 1000 * 60 * 5; //every 5 minutes do refresh
|
||||
tmrProp.Enabled := True;
|
||||
tmrPropTimer(nil)
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmProp_DK0WCY.lblInfoFromMouseDown(Sender: TObject;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
OpenURL(frmProp_DK0WCY.HttpFrm);
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.lblInfoFromMouseEnter(Sender: TObject);
|
||||
begin
|
||||
TLabel(Sender).Font.Style := [fsUnderLine];
|
||||
TLabel(Sender).Font.Color := clBlue;
|
||||
TLabel(Sender).Cursor := crHandPoint;
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.lblInfoFromMouseLeave(Sender: TObject);
|
||||
begin
|
||||
TLabel(Sender).Font.Style := [];
|
||||
TLabel(Sender).Font.Color := clDefault;
|
||||
TLabel(Sender).Cursor := crDefault;
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.sbtnRefreshClick(Sender : TObject);
|
||||
begin
|
||||
tmrPropTimer(nil)
|
||||
end;
|
||||
|
||||
procedure TfrmProp_DK0WCY.tmrPropTimer(Sender: TObject);
|
||||
var
|
||||
T : TPropThread;
|
||||
begin
|
||||
T := TPropThread.Create(True);
|
||||
T.Start
|
||||
end;
|
||||
|
||||
function TfrmProp_DK0WCY.getKindexColor(kIndex : integer) : TColor;
|
||||
begin
|
||||
|
||||
{ if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
kIndex := tstcolor;
|
||||
Writeln('Color selection by: ',kIndex)
|
||||
end;}
|
||||
|
||||
case kIndex of
|
||||
0 .. 133 : Result :=RGBToColor( 0,180, 0); //Green
|
||||
134 .. 266 : Result :=RGBToColor( 0,222, 0); //lGreen
|
||||
267 .. 399 : Result :=RGBToColor( 96,240, 96); //llGreen
|
||||
400 .. 499 : Result :=RGBToColor(244,244, 0); //Yellow
|
||||
500 .. 599 : Result :=RGBToColor(255,130, 0); //Orange
|
||||
600 .. 699 : Result :=RGBToColor(245, 40, 65); //lred
|
||||
700 .. 799 : Result :=RGBToColor(215, 25, 30); //red
|
||||
800 .. 900 : Result :=RGBToColor(222, 48,222); //violet
|
||||
else
|
||||
Result := clDefault;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmProp_DK0WCY.SyncProp;
|
||||
|
||||
var
|
||||
dk : Double;
|
||||
begin
|
||||
lblInfo.Caption := time;
|
||||
lblInfoUTC.Caption := UTC;
|
||||
lblInfoDate.Caption := Date;
|
||||
lblInfoFrom.Caption:= HttpFrm;
|
||||
DBoulAidx.Caption := ab;
|
||||
DKielAidx.Caption := ak;
|
||||
DKiel3K.Caption := k3h;
|
||||
DCurKidx.Caption := k;
|
||||
DSolarFlx.Caption := sfi;
|
||||
DSunSNr.Caption := ssn;
|
||||
DSolAct.Caption := sa;
|
||||
DGeomFi.Caption := gf;
|
||||
DAurora.Caption := au;
|
||||
|
||||
if TryStrToFloat(k,dk) then
|
||||
begin
|
||||
DCurKidx.Color := getKindexColor(round(dk*100));
|
||||
DCurKidx.Font.Style := [fsBold];
|
||||
end
|
||||
else
|
||||
begin
|
||||
DCurKidx.Color := clBtnFace;
|
||||
DCurKidx.Font.Style := [];
|
||||
end;
|
||||
|
||||
if TryStrToFloat(k3h,dk) then
|
||||
begin
|
||||
DKiel3K.Color := getKindexColor(round(dk*100));
|
||||
DKiel3K.Font.Style := [fsBold];
|
||||
end
|
||||
else
|
||||
begin
|
||||
DKiel3K.Color := clBtnFace;
|
||||
DKiel3K.Font.Style := [];
|
||||
end;
|
||||
|
||||
frmProp_DK0WCY.KidxGraph;
|
||||
|
||||
{if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
if tstcolor < 950 then
|
||||
tstcolor := tstcolor +50
|
||||
else
|
||||
tstcolor := 0;
|
||||
end; }
|
||||
|
||||
end;
|
||||
procedure TfrmProp_DK0WCY.KidxGraph;
|
||||
var
|
||||
kloop,kv : integer;
|
||||
dk : double;
|
||||
AllKdata : boolean;
|
||||
|
||||
|
||||
begin
|
||||
|
||||
if not TryStrToFloat(k,dk) then
|
||||
begin
|
||||
dk := 0;
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
end;
|
||||
|
||||
if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
Writeln('Rounded Kidx for Graph: ',round(dk*100))
|
||||
end;
|
||||
|
||||
|
||||
AllKdata := True;
|
||||
kloop := 0;
|
||||
repeat
|
||||
begin
|
||||
if KValues[kloop]=-1 then //all data is not yet filled
|
||||
begin
|
||||
KValues[kloop] := round(dk*100); //place new value to first free
|
||||
if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
Writeln('There are : ',kloop +1,' Kdata entries');
|
||||
end;
|
||||
kloop:=35;
|
||||
AllKdata :=False;
|
||||
end;
|
||||
inc(kloop);
|
||||
end;
|
||||
until kloop>35;
|
||||
|
||||
kloop := 0;
|
||||
repeat
|
||||
begin
|
||||
if AllKdata then
|
||||
begin
|
||||
if kloop<35 then
|
||||
KValues[kloop]:=KValues[kloop+1] //scroll data
|
||||
else
|
||||
begin
|
||||
if dmData.DebugLevel >=1 then
|
||||
begin
|
||||
Writeln('All Kdata entries filled; scroll and place new to end');
|
||||
end;
|
||||
KValues[kloop] := round(dk*100); //place new value to end
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
kv:=0;
|
||||
if KValues[kloop]>-1 then
|
||||
begin
|
||||
kv := KValues[kloop];
|
||||
ImageKidx.Canvas.pen.Color := getKindexColor(kv);
|
||||
end
|
||||
else
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
|
||||
//double lines pen width 1 are better than one with pen width 2 (why?)
|
||||
ImageKidx.Canvas.line(kloop*2,20 - 20*kv div 1000,kloop*2,20); //Kidx value
|
||||
ImageKidx.Canvas.line(kloop*2+1,20 - 20*kv div 1000,kloop*2+1,20);
|
||||
ImageKidx.Canvas.pen.Color := BkColor;
|
||||
ImageKidx.Canvas.line(kloop*2,0,kloop*2,20 - 20*kv div 1000); //the rest of bar
|
||||
ImageKidx.Canvas.line(kloop*2+1,0,kloop*2+1,20 - 20*kv div 1000);
|
||||
|
||||
if (kloop mod 12) = 0 then
|
||||
begin
|
||||
ImageKidx.Canvas.pen.Color := FrColor; //Hour lines if fetch is every 5min
|
||||
ImageKidx.Canvas.pen.style := psDot;
|
||||
ImageKidx.Canvas.line(kloop*2,0,kloop*2,20 - 20*kv div 1000);
|
||||
ImageKidx.Canvas.pen.style := psSolid;
|
||||
end;
|
||||
|
||||
inc(kloop);
|
||||
end;
|
||||
until kloop>35;
|
||||
|
||||
ImageKidx.Canvas.pen.Color := FrColor;
|
||||
ImageKidx.Canvas.pen.style := psDot;
|
||||
ImageKidx.Canvas.line(0,19,72,19); // bottom line
|
||||
ImageKidx.Canvas.pen.style := psSolid;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I fprop_dk0wcy.lrs}
|
||||
|
||||
end.
|
||||
|
||||
40854
src/fwkd.lrs
40854
src/fwkd.lrs
File diff suppressed because it is too large
Load Diff
2353
src/fwkd1.lfm
2353
src/fwkd1.lfm
File diff suppressed because it is too large
Load Diff
755
src/fwkd1.pas
755
src/fwkd1.pas
@ -1,755 +0,0 @@
|
||||
unit fWkd1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,FileUtil,
|
||||
Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LResources, IniFiles;
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TfrmWorked_grids }
|
||||
|
||||
TfrmWorked_grids = class(TForm)
|
||||
ZooIlbl: TImage;
|
||||
modeLabel: TLabel;
|
||||
FollowRig: TCheckBox;
|
||||
WsMode: TComboBox;
|
||||
Nrstatus: TLabel;
|
||||
BandSelector: TComboBox;
|
||||
AutoUpdate: TTimer;
|
||||
Nrgrids: TLabel;
|
||||
Nrqsos: TLabel;
|
||||
LocMapBase: TImage;
|
||||
ZooMap: TImage;
|
||||
ShoWkdOnly: TCheckBox;
|
||||
SaveMapImage: TSaveDialog;
|
||||
SaveMap: TButton;
|
||||
LocMap: TImage;
|
||||
BandLabel: TLabel;
|
||||
procedure BandSelectorChange(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure LocMapClick(Sender: TObject);
|
||||
procedure LocMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
|
||||
procedure ShoWkdOnlyClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure SaveMapImageClose(Sender: TObject);
|
||||
procedure SaveMapClick(Sender: TObject);
|
||||
procedure AutoUpdateTimer(Sender: TObject);
|
||||
procedure WsModeChange(Sender: TObject);
|
||||
procedure ZooMapClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure DrawBase(BCanvas : TCanvas; SubBase : boolean);
|
||||
procedure MarkGrid(LocGrid : String; Cfmd:boolean; MCanvas : TCanvas; SubBase : boolean);
|
||||
public
|
||||
{ public declarations }
|
||||
Procedure ToRigMode(mode:string);
|
||||
Procedure ToRigBand(band:string);
|
||||
function RecordCount:String;
|
||||
function WkdGrid(loc,band,mode:string):integer; //returns 0=not wkd, 1=main grid wkd, 2=wkd
|
||||
function WkdCall(call,band,mode:string):boolean; //returns wkd=true
|
||||
function GridOK(Loc: string): boolean;
|
||||
procedure UpdateMap;
|
||||
end;
|
||||
|
||||
var
|
||||
frmWorked_grids: TfrmWorked_grids; //Main form
|
||||
MaxRowId, //rows in table (Number of qsos in log database)
|
||||
BandQsoCount, //Number of qsos on selected band
|
||||
LogTable, //Table name found from database file (own call ad locator)
|
||||
LogBand, //Band that is selected for worked locators
|
||||
LogSave, //Default File name for saving image
|
||||
LogMainGrid : String; //first 2 letters of locator grid clicked from map
|
||||
MouseX, MouseY, //Mouse position on loc map rounded to grids up/right corner
|
||||
MainGridCount, //Number of Maingrids (achrs) from query result
|
||||
GridCount :integer; //Number of subgrids (4chrs) from query result
|
||||
Changes : Boolean; //changes in rig mode/band
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
Uses fNewQSO,fTRXControl,dData,dUtils,uMyIni;
|
||||
|
||||
{ TfrmWorked_grids }
|
||||
|
||||
|
||||
function TfrmWorked_grids.GridOK(Loc: string): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := True;
|
||||
Loc := trim(UpCase(Loc));
|
||||
if Length(Loc) mod 2 = 0 then
|
||||
Begin
|
||||
for i:=1 to length(loc) do
|
||||
Begin
|
||||
case i of
|
||||
1, 2, 5, 6: case Loc[i] of
|
||||
'A'..'R':Begin {OK!} end;
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
3, 4, 7, 8: case Loc[i] of
|
||||
'0'..'9':Begin {OK!} end;
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Begin
|
||||
Result:=false;
|
||||
end;
|
||||
end;
|
||||
Procedure TfrmWorked_grids.ToRigMode(mode:string);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
if dmData.DebugLevel>=1 then Writeln('ToRigMode was index:',WsMode.Itemindex);
|
||||
i:=WsMode.Items.Count;
|
||||
Changes := True;
|
||||
repeat
|
||||
begin
|
||||
dec(i);
|
||||
if dmData.DebugLevel>=1 then Writeln('looping now:',i);
|
||||
end;
|
||||
until ( WsMode.Items[i] = mode ) or ( i=0 );
|
||||
WsMode.Itemindex := i;
|
||||
if dmData.DebugLevel>=1 then Writeln('Result:',i,' ',WsMode.Items[WsMode.Itemindex]);
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.ToRigBand(band:string);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
if dmData.DebugLevel>=1 then Writeln('ToRigBand was index:',WsMode.Itemindex);
|
||||
i:=BandSelector.Items.Count;
|
||||
Changes := True;
|
||||
repeat
|
||||
begin
|
||||
dec(i);
|
||||
if dmData.DebugLevel>=1 then Writeln('looping now:',i);
|
||||
end;
|
||||
until ( BandSelector.Items[i] = band ) or ( i=0 );
|
||||
BandSelector.Itemindex := i;
|
||||
if dmData.DebugLevel>=1 then Writeln('Result:',i,' ',BandSelector.Items[BandSelector.Itemindex]);
|
||||
end;
|
||||
procedure TfrmWorked_grids.UpdateMap;
|
||||
|
||||
Begin
|
||||
BandSelectorChange(AutoUpdate); //update map(s)
|
||||
end;
|
||||
function TfrmWorked_grids.RecordCount:String;
|
||||
Begin
|
||||
|
||||
|
||||
dmData.Q1.Close;
|
||||
if dmData.trQ1.Active then dmData.trQ1.Rollback;
|
||||
dmData.Q1.SQL.Text := 'select count(callsign) from '+LogTable;
|
||||
dmData.trQ1.StartTransaction;
|
||||
try
|
||||
dmData.Q1.Open;
|
||||
RecordCount := dmData.Q1.Fields[0].AsString;
|
||||
if (RecordCount = '') then
|
||||
RecordCount := '0';
|
||||
dmData.Q1.Close;
|
||||
|
||||
finally
|
||||
dmData.trQ1.Rollback;
|
||||
end;
|
||||
end;
|
||||
function TfrmWorked_grids.WkdGrid(loc,band,mode:string):integer;
|
||||
Begin
|
||||
WkdGrid:= 0;
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then dmData.trQ.Rollback;
|
||||
|
||||
dmData.Q.SQL.Text:='select loc from '+LogTable+' where band='+chr(39)+band+chr(39)+
|
||||
' and mode='+chr(39)+mode+chr(39)+' and loc like '+chr(39)+loc+'%'+chr(39);
|
||||
if dmData.DebugLevel>=1 then Writeln(dmData.Q.SQL.Text);
|
||||
dmData.trQ.StartTransaction;
|
||||
try
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdGrid:= 2;
|
||||
dmData.Q.Close;
|
||||
if WkdGrid = 0 then
|
||||
Begin
|
||||
dmData.Q.SQL.Text:='select loc from '+LogTable+' where band='+chr(39)+band+chr(39)+
|
||||
' and mode='+chr(39)+mode+chr(39)+' and loc like '+chr(39)+copy(loc,1,2)+'%'+chr(39);
|
||||
if dmData.DebugLevel>=1 then Writeln(dmData.Q.SQL.Text);
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdGrid:= 1;
|
||||
dmData.Q.Close;
|
||||
end;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if dmData.DebugLevel>=1 then Writeln('WkdGrid is:',WkdGrid);
|
||||
end;
|
||||
function TfrmWorked_grids.WkdCall(call,band,mode:string):boolean;
|
||||
Begin
|
||||
WkdCall:=False;
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then dmData.trQ.Rollback;
|
||||
dmData.Q.SQL.Text:='select callsign from '+LogTable+' where band='+chr(39)+band+chr(39)+
|
||||
' and mode='+chr(39)+mode+chr(39)+' and callsign='+chr(39)+call+chr(39);
|
||||
if dmData.DebugLevel>=1 then Writeln(dmData.Q.SQL.Text);
|
||||
try
|
||||
dmData.Q.Open;
|
||||
if dmData.Q.Fields[0].AsString <> '' then
|
||||
WkdCall:= True;
|
||||
dmData.Q.Close;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if dmData.DebugLevel>=1 then Writeln('WkdCall is:',WkdCall);
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.MarkGrid(LocGrid : String; Cfmd:boolean ;MCanvas : TCanvas; SubBase : boolean);
|
||||
|
||||
var v,vs,h,hs,
|
||||
Mheight,ltrbase,
|
||||
Pwidth,Pcolor,
|
||||
Grid1,Grid2 :integer;
|
||||
|
||||
|
||||
begin
|
||||
LocGrid:=UpperCase(LocGrid);//to be sure ;)
|
||||
Pwidth := 2;
|
||||
if Cfmd then Pcolor := clGreen else Pcolor := clMaroon;
|
||||
Mheight := 360;
|
||||
ltrbase := 65;
|
||||
Grid1 := 1;
|
||||
Grid2 := 2;
|
||||
|
||||
if not GridOK(LocGrid) then exit; // all (4chr) must be valid
|
||||
|
||||
if SubBase then
|
||||
Begin
|
||||
Pwidth := 4;
|
||||
if Cfmd then Pcolor := clLime else Pcolor := clred;
|
||||
Mheight := 200;
|
||||
ltrbase := 48;
|
||||
Grid1 := 3;
|
||||
Grid2 := 4;
|
||||
end;
|
||||
|
||||
with MCanvas do
|
||||
begin
|
||||
//draw main grids
|
||||
v:=(ord(LocGrid[Grid1])- ltrbase)*40;
|
||||
h:=Mheight - (ord(LocGrid[Grid2])-(ltrbase-1))*20;
|
||||
|
||||
brush.style := bsClear;
|
||||
pen.Color := Pcolor;
|
||||
pen.width := Pwidth;
|
||||
if subBase then
|
||||
Begin
|
||||
brush.Color := Pcolor;
|
||||
FillRect(v+3, h+3, v+38, h+18)
|
||||
end
|
||||
else
|
||||
Begin
|
||||
Rectangle(v+2, h+2, v+39, h+19);
|
||||
end;
|
||||
|
||||
//name grids
|
||||
font.Size := 7;
|
||||
font.Color := clBlack;
|
||||
Font.Style := [fsBold];
|
||||
TextOut(v+15,h+5, LocGrid[Grid1]+LocGrid[Grid2]);
|
||||
Font.Style := [];
|
||||
|
||||
//draw sub grids
|
||||
if not SubBase then
|
||||
Begin
|
||||
hs:= h + 20 - ((ord(LocGrid[4])-47)*2);
|
||||
vs:= v + (ord(LocGrid[3])-48)*4;
|
||||
if Cfmd then Pcolor := clLime else Pcolor := clred;
|
||||
pen.Color := Pcolor;
|
||||
Rectangle(vs, hs, vs+4, hs+2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmWorked_grids.DrawBase(BCanvas : TCanvas; SubBase : boolean);
|
||||
|
||||
var v,vc,h,hc,Bwidth,Bheight,ltrbase:integer;
|
||||
|
||||
begin
|
||||
|
||||
Bwidth := 720;
|
||||
Bheight := 360;
|
||||
ltrbase := 65;
|
||||
|
||||
if SubBase then
|
||||
Begin
|
||||
Bwidth := 400;
|
||||
Bheight := 200;
|
||||
ltrbase := 48;
|
||||
end;
|
||||
|
||||
with BCanvas do
|
||||
begin
|
||||
v:=0;
|
||||
repeat
|
||||
Begin
|
||||
pen.Color := clGray;
|
||||
pen.width := 1;
|
||||
line(0,v,Bwidth,v);
|
||||
line(v*2,0,v*2,Bheight);
|
||||
v:=v+20;
|
||||
end;
|
||||
until v>Bheight;
|
||||
v:= 15;
|
||||
vc:= ltrbase;
|
||||
repeat
|
||||
begin
|
||||
h:= Bheight -15; ;
|
||||
hc:= ltrbase;
|
||||
repeat
|
||||
Begin
|
||||
Brush.Style:=bsClear;
|
||||
font.Size := 7;
|
||||
font.Color := clGray;
|
||||
TextOut(v,h, chr(vc)+chr(hc));
|
||||
h:=h-20;
|
||||
hc:=hc+1;
|
||||
end;
|
||||
until h< 0;
|
||||
end;
|
||||
v:=v+40;
|
||||
vc:=vc+1;
|
||||
until v>Bwidth;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.FormCreate(Sender: TObject);
|
||||
|
||||
begin
|
||||
AutoUpdate.enabled := False;
|
||||
AutoUpdate.Interval := 5000;
|
||||
WsMode.Itemindex := -1;
|
||||
BandSelector.Itemindex := -1;
|
||||
LogSave := 'Wkd_locs_empty';
|
||||
LogBand := ' ';
|
||||
LogTable := 'cqrlog_main'; //assume table name is this always
|
||||
|
||||
dmUtils.InsertModes(WsMode);
|
||||
WsMode.Items.Insert(0,'any');
|
||||
WsMode.Items.Insert(1,'JT9+JT65');
|
||||
|
||||
//load map base image
|
||||
LocMapBase.Picture.LoadFromLazarusResource('borders');
|
||||
frmWorked_grids.Caption := frmWorked_grids.Caption+' '+dmData.LogName+' '+LogBand;
|
||||
|
||||
LocMap.Canvas.CopyRect(Rect(0,0,Width,Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas,Rect(0,0,Width,Height));
|
||||
|
||||
DrawBase(LocMap.canvas, False);
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.SaveMapImageClose(Sender: TObject);
|
||||
|
||||
var Bmp :TBitmap;
|
||||
AddSize,
|
||||
aWidth,
|
||||
aHeight :integer;
|
||||
AddText,
|
||||
AddText1 : String;
|
||||
|
||||
begin
|
||||
AddText :='';
|
||||
AddText1 :='';
|
||||
|
||||
try
|
||||
if LocMap.Visible Then
|
||||
begin
|
||||
AddSize := 20;
|
||||
aWidth :=LocMap.Picture.Bitmap.Width;
|
||||
aHeight :=LocMap.Picture.Bitmap.Height + AddSize;
|
||||
AddText :=dmData.LogName+' '+LogBand+' '+WsMode.items[WsMode.Itemindex]+' '+
|
||||
intToStr(MainGridCount)+'main/'+intToStr(GridCount)+'sub grids '+
|
||||
dmData.DBName+' '+BandQsoCount+'/'+MaxRowId+'qsos';
|
||||
end
|
||||
else
|
||||
begin
|
||||
AddSize := 40;
|
||||
aWidth := ZooMap.Picture.Bitmap.Width;
|
||||
aHeight := ZooMap.Picture.Bitmap.Height + AddSize;
|
||||
AddText := dmData.LogName+' '+LogBand+' '+WsMode.items[WsMode.Itemindex]+' '+
|
||||
LogMainGrid+' -> '+intToStr(GridCount)+'subgrids';
|
||||
AddText1 := dmData.DBName+' '+BandQsoCount+'/'+MaxRowId+'qsos';
|
||||
end;
|
||||
|
||||
Bmp :=TBitmap.Create;
|
||||
Bmp.Width :=aWidth;
|
||||
Bmp.Height :=aHeight;
|
||||
Bmp.Canvas.Rectangle(0, 0,aWidth,aHeight);
|
||||
|
||||
if LocMap.Visible Then
|
||||
begin
|
||||
Bmp.Canvas.CopyRect(Rect(0,AddSize,aWidth,aHeight),
|
||||
LocMap.Picture.Bitmap.Canvas,
|
||||
Rect(0,0,aWidth,aHeight-AddSize));
|
||||
end
|
||||
else
|
||||
begin
|
||||
Bmp.Canvas.CopyRect(Rect(0,AddSize,aWidth,aHeight),
|
||||
ZooMap.Picture.Bitmap.Canvas,
|
||||
Rect(0,0,aWidth,aHeight-AddSize));
|
||||
end;
|
||||
Bmp.Canvas.Brush.Style:=bsClear;
|
||||
Bmp.Canvas.font.Size := 10;
|
||||
Bmp.Canvas.font.Color := clBlack;
|
||||
Bmp.Canvas.TextOut(5,3, AddText);
|
||||
if AddText1 <> '' then
|
||||
Bmp.Canvas.TextOut(5,23, AddText1);
|
||||
|
||||
Bmp.SaveToFile(SaveMapImage.FileName);
|
||||
except
|
||||
on E: Exception do
|
||||
ShowMessage('Error: ' + E.Message);
|
||||
end;
|
||||
Bmp.free;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.SaveMapClick(Sender: TObject);
|
||||
begin
|
||||
if LocMap.Visible Then
|
||||
SaveMapImage.FileName := LogSave+'.bmp'
|
||||
else
|
||||
SaveMapImage.FileName := LogSave+'_'+LogMainGrid+'.bmp';
|
||||
|
||||
SaveMapImage.Execute;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.AutoUpdateTimer(Sender: TObject);
|
||||
var
|
||||
mode,
|
||||
band: String;
|
||||
|
||||
|
||||
begin
|
||||
if dmData.DebugLevel>=1 then Writeln('WkdGrids-TimerTick. FlwRig stage0 is:',FollowRig.Checked );
|
||||
AutoUpdate.enabled := False;
|
||||
|
||||
if FollowRig.Checked then
|
||||
Begin
|
||||
if dmData.DebugLevel>=1 then Writeln(' FlwRig stage 1 is:',FollowRig.Checked );
|
||||
if dmData.DebugLevel>=1 then Writeln(' FlwRig getmode returns(st-m-b):',frmTRXControl.GetModeBand(mode,band),' ',mode,' ',band );
|
||||
if (frmTRXControl.GetModeBand(mode,band)) and (band<>'') then //if off from ham freq gives True, but empty band !!!
|
||||
Begin
|
||||
//here wsjt-x makes exeption as mode is JT9 , JT65 or combination JT9+JT65 not what RigCtl says
|
||||
//maybe same is needed from fldigi, too. It just does not update it before qso is logged!
|
||||
//perhaps could use preference's option: (rigctl, from program or fixed "RTTY")
|
||||
|
||||
//empty frmNewQSO.WsjtxMode causes crash. Happens if "follow rig" checked before wsjtx starts.
|
||||
if frmNewQSO.mnuRemoteModeWsjt.Checked and (frmNewQSO.WsjtxMode<>'')then
|
||||
mode := frmNewQSO.WsjtxMode;
|
||||
if dmData.DebugLevel>=1 then Writeln('Follow rig mode: ',mode,' Band: ',band);
|
||||
if WsMode.Itemindex < 0 then
|
||||
ToRigMode(mode)
|
||||
else
|
||||
if WsMode.Items[WsMode.Itemindex] <> mode then
|
||||
ToRigMode(mode);
|
||||
|
||||
if BandSelector.Itemindex < 0 then
|
||||
ToRigBand(band)
|
||||
else
|
||||
if BandSelector.Items[BandSelector.Itemindex] <> band then
|
||||
ToRigBand(band);
|
||||
end;
|
||||
end;
|
||||
|
||||
if (BandSelector.itemIndex >= 0) and (WsMode.Itemindex >= 0) and Changes then //both must be set
|
||||
begin
|
||||
BandSelectorChange(AutoUpdate); //update map(s)
|
||||
end;
|
||||
AutoUpdate.enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.WsModeChange(Sender: TObject);
|
||||
|
||||
begin
|
||||
if (BandSelector.itemIndex >= 0) then
|
||||
BandSelectorChange(WsMode);
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmWorked_grids.ZooMapClick(Sender: TObject);
|
||||
begin
|
||||
ZooMap.Visible := False;
|
||||
ZooILbl.Visible := False;
|
||||
ShoWkdOnlyClick(ZooMap);
|
||||
LocMap.Visible := True;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.BandSelectorChange(Sender: TObject); //update map(s)
|
||||
var
|
||||
MainGridStream,
|
||||
SQLExtension,
|
||||
Grid : String;
|
||||
qsocount,
|
||||
c : integer;
|
||||
SQLCfm : array [0 .. 2] of string;
|
||||
Begin
|
||||
//no updates if band and mode are not set
|
||||
if (BandSelector.itemIndex >= 0) and (WsMode.itemindex >= 0) then
|
||||
Begin
|
||||
AutoUpdate.enabled := False;
|
||||
Changes := False;
|
||||
//clean map if caller is not zoomed grid(=visible)
|
||||
if ZooMap.Visible then
|
||||
Begin
|
||||
LocMapClick(BandSelector);
|
||||
end
|
||||
else
|
||||
Begin
|
||||
LocMap.Canvas.CopyRect(Rect(0,0,Width,Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas,Rect(0,0,Width,Height));
|
||||
if not ShoWkdOnly.Checked then
|
||||
DrawBase(LocMap.canvas,False);
|
||||
end;
|
||||
|
||||
case WsMode.itemindex of
|
||||
//any
|
||||
0 : SQLExtension := '';
|
||||
//JT9+JT65
|
||||
1 : SQLExtension := ' and ((mode='+chr(39)+'JT9'+chr(39)+') or ( mode='+chr(39)+'JT65'+chr(39)+'))';
|
||||
|
||||
else // all others
|
||||
SQLExtension := ' and mode='+chr(39)+WsMode.items[WsMode.Itemindex]+chr(39);
|
||||
end;
|
||||
|
||||
|
||||
//1:not (at all) confirmed grids
|
||||
SQLCfm[1] :=' and eqsl_qsl_rcvd<>'+chr(39)+'E'+chr(39)+' and lotw_qslr<>'+chr(39)+'L'+chr(39)+' and qsl_r<>'+chr(39)+'Q'+chr(39);
|
||||
//2:some way confirmed grids
|
||||
SQLCfm[2] :=' and (eqsl_qsl_rcvd='+chr(39)+'E'+chr(39)+' or lotw_qslr='+chr(39)+'L'+chr(39)+' or qsl_r='+chr(39)+'Q'+chr(39)+')';
|
||||
|
||||
dmData.Q.Close;
|
||||
if dmData.trQ.Active then dmData.trQ.Rollback;
|
||||
|
||||
if BandSelector.itemIndex > 0 then //band selected
|
||||
Begin
|
||||
//0:the base query string
|
||||
SQLCfm[0] := 'select upper(left(loc,4)) as lo from '+LogTable+' where band='+chr(39)+
|
||||
BandSelector.items[BandSelector.itemIndex]+chr(39)+
|
||||
'and loc<>'+chr(39)+chr(39)+SQLExtension;
|
||||
end
|
||||
else //band "all"
|
||||
Begin
|
||||
SQLCfm[0] := 'select upper(left(loc,4)) lo from '+LogTable+' where loc<>'+chr(39)+chr(39)+SQLExtension;
|
||||
end;
|
||||
if ZooMap.Visible then //coming from zoomed grid
|
||||
Begin
|
||||
SQLCfm[0] := SQLCfm[0] + ' and loc like '+chr(39)+LogMainGrid+'%'+chr(39);
|
||||
end;
|
||||
|
||||
GridCount:= 0;
|
||||
MainGridCount:= 0;
|
||||
MainGridStream := '';
|
||||
dmData.trQ.StartTransaction;
|
||||
try
|
||||
for c:=1 to 2 do
|
||||
Begin
|
||||
dmData.Q.SQL.Text:= SQLCfm[0] + SQLCfm[c];
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.Eof do
|
||||
begin
|
||||
Grid := dmData.Q.FieldByName('lo').AsString;
|
||||
|
||||
if ZooMap.Visible then //coming from zoomed grid
|
||||
Begin
|
||||
MarkGrid(Grid, c=2 ,ZooMap.canvas,True);
|
||||
end
|
||||
else
|
||||
Begin
|
||||
MarkGrid(Grid, c=2 ,LocMap.canvas,False);
|
||||
end;
|
||||
|
||||
If (GridOK(Grid)) and (pos(copy(Grid ,1,2),MainGridStream) = 0) then
|
||||
Begin
|
||||
inc(MainGridCount);
|
||||
MainGridStream := MainGridStream +','+ copy(Grid ,1,2);
|
||||
end;
|
||||
|
||||
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
end;
|
||||
|
||||
//distinct sub grid count
|
||||
dmData.Q.SQL.Text:= 'select distinct' + copy(SQLCfm[0],7,length(SQLCfm[0]));
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.Eof do
|
||||
Begin
|
||||
inc(GridCount);
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
|
||||
MaxRowId := RecordCount;
|
||||
if (BandSelector.itemIndex > 0) then
|
||||
Begin
|
||||
qsocount:=0;
|
||||
dmData.Q.SQL.Text:= 'select loc from '+LogTable+' where band='+chr(39)+
|
||||
BandSelector.items[BandSelector.itemIndex]+chr(39)+
|
||||
SQLExtension;
|
||||
|
||||
if dmData.DebugLevel>=1 then Write(dmData.Q.SQL.Text);
|
||||
|
||||
dmData.Q.Open;
|
||||
while not dmData.Q.Eof do
|
||||
Begin
|
||||
inc(qsocount);
|
||||
dmData.Q.Next;
|
||||
end;
|
||||
dmData.Q.Close;
|
||||
BandQsoCount := IntToStr(qsocount);
|
||||
end
|
||||
else
|
||||
Begin
|
||||
BandQsoCount := MaxRowId;
|
||||
end;
|
||||
finally
|
||||
dmData.trQ.Rollback;
|
||||
end;
|
||||
if (BandSelector.itemIndex >= 0) and (WsMode.Itemindex >= 0) then //both must be set
|
||||
Begin
|
||||
LogSave := 'Wkd_locs_'+dmData.LogName+'_'+BandSelector.items[BandSelector.itemIndex];
|
||||
LogBand := BandSelector.items[BandSelector.itemIndex];
|
||||
frmWorked_grids.Caption := 'Worked locator grids '+dmData.LogName+' '+LogBand+' '+WsMode.items[WsMode.Itemindex];
|
||||
end;
|
||||
|
||||
Nrgrids.Caption := intToStr(MainGridCount)+'main/'+intToStr(GridCount)+'sub grids';
|
||||
Nrstatus.Caption := dmData.LogName;
|
||||
Nrqsos.Caption := BandQsoCount+'/'+MaxRowId+'qsos';
|
||||
Nrgrids.Visible := True;
|
||||
Nrstatus.Visible := True;
|
||||
Nrqsos.Visible := True;
|
||||
|
||||
AutoUpdate.enabled := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.FormShow(Sender: TObject);
|
||||
begin
|
||||
dmUtils.LoadWindowPos(frmWorked_grids);
|
||||
FollowRig.Checked := cqrini.ReadBool('Worked_grids','FollowRig',false);
|
||||
ShoWkdOnly.Checked := cqrini.ReadBool('Worked_grids','ShowWkdOnly',false);
|
||||
AutoUpdate.enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.LocMapClick(Sender: TObject);
|
||||
|
||||
var Bmp :TBitmap;
|
||||
aWidth,
|
||||
aHeight,
|
||||
ww,hh :integer;
|
||||
|
||||
Begin
|
||||
|
||||
if (BandSelector.itemIndex >= 0) and (WsMode.Itemindex >= 0) then //both must be set
|
||||
begin
|
||||
ww:=0;hh:=0;
|
||||
aWidth:=40;
|
||||
aHeight:=20;
|
||||
Bmp:=TBitmap.Create;
|
||||
Bmp.Width:=aWidth;
|
||||
Bmp.Height:=aHeight;
|
||||
Bmp.Canvas.CopyRect(Rect(0,0,aWidth,aHeight),
|
||||
LocMapBase.Picture.Bitmap.Canvas,
|
||||
Rect(MouseX,MouseY,MouseX+aWidth+1, MouseY+aHeight+1));
|
||||
ZooMap.Picture.Bitmap.SetSize(ZooMap.Width,ZooMap.Height);
|
||||
ZooMap.Picture.Bitmap.Canvas.StretchDraw(Rect(0,0,ZooMap.Picture.Bitmap.Width,ZooMap.Picture.Bitmap.Height),Bmp);
|
||||
Bmp.free;
|
||||
DrawBase(ZooMap.Canvas,True);
|
||||
|
||||
if Sender <> BandSelector then //to avoid BandSelector looping when ZooMap active
|
||||
Begin
|
||||
LogMainGrid := chr((MouseX)div 40+65)+chr((340-MouseY)div 20+65);
|
||||
LocMap.Visible := False;
|
||||
ZooMap.Visible := True;
|
||||
ZooILbl.Visible := True;
|
||||
with ZooIlbl.Canvas do //had to make this grapic as cqrlog controls font size of window after wkd-map
|
||||
Begin //position saved/loaded as other forms and I'm too lazy to dig out how to avoid it
|
||||
Clear;
|
||||
Brush.Color:=clBackground;
|
||||
FillRect(0,0,width,height);
|
||||
Brush.style:=bsClear;
|
||||
font.Color := clBlack;
|
||||
Font.Style := [fsBold];
|
||||
font.Size := 54;
|
||||
repeat //fit the text to canvas
|
||||
Begin
|
||||
font.Size := font.Size -1;
|
||||
GetTextSize(LogMainGrid, ww, hh);
|
||||
if dmData.DebugLevel>=1 then Writeln('Font size:', font.Size);
|
||||
end;
|
||||
until (ww<=width) and (hh<=height);
|
||||
TextOut(1,1 , LogMainGrid);
|
||||
end;
|
||||
|
||||
BandSelectorChange(LocMap);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.LocMapMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
begin
|
||||
MouseX := (X div 40) * 40;
|
||||
MouseY := (Y div 20) * 20;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.ShoWkdOnlyClick(Sender: TObject);
|
||||
begin
|
||||
if (BandSelector.itemIndex >= 0) and (WsMode.Itemindex >= 0) then //both must be set
|
||||
Begin
|
||||
BandSelectorChange(BandSelector);
|
||||
end
|
||||
else
|
||||
Begin
|
||||
LocMap.Canvas.CopyRect(Rect(0,0,Width,Height),
|
||||
LocMapBase.Picture.Bitmap.Canvas,Rect(0,0,Width,Height));
|
||||
if not ShoWkdOnly.Checked then
|
||||
DrawBase(LocMap.canvas,False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmWorked_grids.FormClose(Sender: TObject);
|
||||
begin
|
||||
AutoUpdate.enabled := False;
|
||||
cqrini.WriteBool('Worked_grids','FollowRig',FollowRig.Checked);
|
||||
cqrini.WriteBool('Worked_grids','ShowWkdOnly',ShoWkdOnly.Checked);
|
||||
dmUtils.SaveWindowPos(frmWorked_grids);
|
||||
frmWorked_grids.hide;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Initialization
|
||||
{$i fwkd.lrs}
|
||||
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user