hamradio/cqrlog
1
0
Fork 0
mirror of https://github.com/ok2cqr/cqrlog.git synced 2024-09-21 10:27:17 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #44 from OH1KH/master

Browse Source 
Added 'reminder' to remind minute period or UTC based. Added simple '…
This commit is contained in:
Petr Hlozek 2017-04-13 15:26:21 +02:00 committed by GitHub
commit 5b6cc3d3b6
19 changed files with 2131 additions and 772 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
CqrlogAdditions2.pdf
View File

Binary file not shown.

43
README.OH1KH
View File

@ -110,5 +110,46 @@
This also speeds up normal period decoding giving user more time (from that 10sec gap between periods) to decide to whose
CQ call he is going to answer.
22.3.2017
- modified NewQSO/Window listing to alpabethical order
- added two selections "Reminder" and "Contest" and made forms and units for them. See CqrlogAdditions2.pdf for details.
Tried to minimize changes to original cqrlog source code by doing these as separate units, but some modifications must
done inside original cqrlog source code to make these new ones to work.
At same time I was thinking about moving wsjt-x decode inside of Wsjt-x monitor unit. It actually should be there.
(maybe some day, maybe not...).
1.4.2017
- added "No" checkbox to contest form. Changes tabulation order of NRr,MSGr to MSGr,NRr for contest where there is just message
but no number. Note that you can feed only numbers to NRs and NRr fields.
3.4.2017
- returned Contest/Msg is Loc checkbox function to original meaning, I.E. when checked Msg is expected to be locator and placed
now ONLY to New/QSO/Grid field (not together with received rst).
- added Contest/Tru checkbox for true reports exchange. Changes tabulation order so that it goes RSTs, RSTr, NRr, MSGr.
This might be useful in VHF, UHF, SHF Tropo, Es etc. openings (and maybe some contests, too) where you like fast qso logging.
- Added DXCluster additions.
-- ACalls toggle button does just the same as "Preferences/DXCluster/List of callsigns" I.E. opens alert calls list for edit:
This is easier and faster than using it via preferences. When edit list is closed alert remains active (button text is green)
Second press deactivates alert (button text is black).
Checkbox "Inc" changes alert to RegExp,so if any part of alert calls list fits to dx cluster's call it alerts.
Unchecked call must be exactly same. I.E. "Inc" checked with list call OF100FI alerts OF100FI/1, OF100FI/2 ..etc.
-- Typed command history. With Ctrl-Z you can scroll back 5 last commands (fix, if needed) and reuse them. (2.0.5(028))
11.04.2017
- Added IP address field to preferences/fldigi-wsjtx settings of wsjt-x. Defaults to 127.0.0.1 (localhost) but can be changed.
There is no valid IP format check so you have to type right formatted address.
This setting can be used if you run wsjt-x on different computer than cqrlog. If so, put the IP address of cqrlog computer
to Wsjt-x's settings/reporting replacing there the default 127.0.0.1
At cqrlog computer put cqrlog/preferences/wsjtx-settings IP address to the same as it's own network IP address. No need to change
port numbers. Remember to open your firewalls on both computers to allow UDP traffic from 2237 port on your network.
Tested with two laptops on same WiFi local network:
cqrlog PC ip address 192.168.60.222, cqrlog setting/wsjt-x: port 2237 address 192.168.60.222
wsjt-x PC ip address 192.168.60.223, wstt-x setting/reporting port 2237 address 192.168.60.222
(2.0.5(029))

2
src/cqrlog.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="10"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>

41
src/cqrlog.lpr
View File

@ -4,25 +4,25 @@ program cqrlog;
uses
cmem,cthreads,uScrollBars,
Interfaces, // this includes the LCL widgetset
Forms,sysutils,
Classes,
fMain,fPreferences,dUtils,fNewQSO,dialogs,fChangeLocator,dData,
dDXCC,fMarkQSL,fDXCCStat,fSort,fFilter,fImportProgress,fImportTest,
TAChartLazarusPkg,RunTimeTypeInfoControls,fSelectDXCC,fGrayline,fCallbook,
fTRXControl,fFreq,fChangeFreq,fAdifImport,fSplash,fSearch,fQTHProfiles,
fNewQTHProfile,fEnterFreq,fExportProgress,fNewDXCluster,fDXCluster,
fDXClusterList,dDXCluster,fWorking,fSerialPort,fQSLMgr,fSendSpot,fQSODetails,
fUpgrade,fWAZITUStat,fIOTAStat,fClubSettings,fLoadClub,fRefCall,fGraphStat,
fBandMap,fBandMapWatch,fLongNote,fDatabaseUpdate,fExLabelPrint,
fImportLoTWWeb,fLoTWExport,fGroupEdit,fDefaultFreq,fCustomStat,fKeyTexts,
fCWType,fSplitSettings,MemDSLaz,SDFLaz,turbopoweripro,fShowStations,uMyIni,
fPropagation,fSQLConsole,fCallAttachment,fEditDetails,fQSLViewer,fCWKeys,fSCP,fDBConnect,fNewLog,
fRebuildMembStat,uVersion,fAbout,fChangelog,fBigSquareStat,feQSLDownload,
feQSLUpload,fSOTAExport, fNewQSODefValues, fQSLExpPref, fRotControl,
dLogUpload, fLogUploadStatus,frCWKeys, fCallAlert, fNewCallAlert,
fConfigStorage, fRbnFilter, fRbnMonitor, fRbnServer, fRadioMemories,
fAddRadioMemory, fException, fDbError, fCommentToCall, fNewCommentToCall,
fFindCommentToCall, frExportPref, fExportPref, fMoniWsjtx, fWkd1, fProp_DK0WCY;
Forms, sysutils, Classes, fMain, fPreferences, dUtils, fNewQSO, dialogs,
fChangeLocator, dData, dDXCC, fMarkQSL, fDXCCStat, fSort, fFilter,
fImportProgress, fImportTest, TAChartLazarusPkg, RunTimeTypeInfoControls,
fSelectDXCC, fGrayline, fCallbook, fTRXControl, fFreq, fChangeFreq,
fAdifImport, fSplash, fSearch, fQTHProfiles, fNewQTHProfile, fEnterFreq,
fExportProgress, fNewDXCluster, fDXCluster, fDXClusterList, dDXCluster,
fWorking, fSerialPort, fQSLMgr, fSendSpot, fQSODetails, fUpgrade, fWAZITUStat,
fIOTAStat, fClubSettings, fLoadClub, fRefCall, fGraphStat, fBandMap,
fBandMapWatch, fLongNote, fDatabaseUpdate, fExLabelPrint, fImportLoTWWeb,
fLoTWExport, fGroupEdit, fDefaultFreq, fCustomStat, fKeyTexts, fCWType,
fSplitSettings, MemDSLaz, SDFLaz, turbopoweripro, fShowStations, uMyIni,
fPropagation, fSQLConsole, fCallAttachment, fEditDetails, fQSLViewer, fCWKeys,
fSCP, fDBConnect, fNewLog, fRebuildMembStat, uVersion, fAbout, fChangelog,
fBigSquareStat, feQSLDownload, feQSLUpload, fSOTAExport, fNewQSODefValues,
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;
var
Splash : TfrmSplash;
@ -66,7 +66,8 @@ begin
Application.CreateForm(TfrmMonWsjtx, frmMonWsjtx);
Application.CreateForm(TfrmWorked_grids, frmWorked_grids);
Application.CreateForm(TfrmProp_DK0WCY , frmProp_DK0WCY );
Application.CreateForm(TfrmReminder , frmReminder );
Application.CreateForm(TfrmContest , frmContest );
Splash.Update;
application.ProcessMessages;

8
src/dDXCluster.pas
View File

@ -94,7 +94,7 @@ type
function PfxFromADIF(adif : Word) : String;
function CountryFromADIF(adif : Word) : String;
function GetBandFromFreq(freq : string; kHz : Boolean=false): String;
function IsAlertCall(const call,band,mode : String) : Boolean;
function IsAlertCall(const call,band,mode : String;rp :boolean) : Boolean;
procedure AddToMarkFile(prefix,call : String;sColor : Integer;Max,lat,long : String);
procedure GetRealCoordinate(lat,long : String; var latitude, longitude: Currency);
@ -1188,11 +1188,15 @@ begin
end
end;
function TdmDXCluster.IsAlertCall(const call,band,mode : String) : Boolean;
function TdmDXCluster.IsAlertCall(const call,band,mode : String;rp :boolean) : Boolean;
const
C_SEL = 'select * from call_alert where callsign = %s';
C_RGX_SEL ='select * from call_alert where %s regexp callsign';
begin
try
if rp then
qCallAlert.SQL.Text := Format(C_RGX_SEL,[QuotedStr(call)])
else
qCallAlert.SQL.Text := Format(C_SEL,[QuotedStr(call)]);
if dmData.DebugLevel>=1 then Writeln(qCallAlert.SQL.Text);
trCallAlert.StartTransaction;

1
src/dUtils.pas
View File

@ -2638,6 +2638,7 @@ begin
Result := text;
rst_sh := StringReplace(rst_s,'9','N',[rfReplaceAll, rfIgnoreCase]);
rst_sh := StringReplace(rst_sh,'0','T',[rfReplaceAll, rfIgnoreCase]);//replace zeros, too
Result := StringReplace(Result,'%mc',mycall,[rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result,'%mn',myname,[rfReplaceAll, rfIgnoreCase]);

92
src/fDXCluster.lfm
View File

@ -1,14 +1,14 @@
object frmDXCluster: TfrmDXCluster
Left = 497
Height = 219
Top = 548
Width = 564
Left = 702
Height = 367
Top = 436
Width = 709
HelpType = htKeyword
HelpKeyword = 'help/h21.html#ah19'
ActiveControl = pgDXCluster
Caption = 'DXCluster'
ClientHeight = 219
ClientWidth = 564
ClientHeight = 367
ClientWidth = 709
Icon.Data = {
BE0C00000000010001002020000001001800A80C000016000000280000002000
0000400000000100180000000000000C00006400000064000000000000000000
@ -121,20 +121,20 @@ object frmDXCluster: TfrmDXCluster
OnDestroy = FormDestroy
OnKeyUp = FormKeyUp
OnShow = FormShow
LCLVersion = '1.4.4.0'
LCLVersion = '1.6.4.0'
object pgDXCluster: TPageControl
Left = 0
Height = 219
Height = 367
Top = 0
Width = 564
Width = 709
ActivePage = tabTelnet
Align = alClient
TabIndex = 1
TabOrder = 0
object tabWeb: TTabSheet
Caption = 'Web'
ClientHeight = 188
ClientWidth = 560
ClientHeight = 338
ClientWidth = 699
object Panel4: TPanel
Left = 0
Height = 36
@ -216,69 +216,97 @@ object frmDXCluster: TfrmDXCluster
end
object tabTelnet: TTabSheet
Caption = 'Telnet'
ClientHeight = 188
ClientWidth = 560
ClientHeight = 338
ClientWidth = 699
object Panel1: TPanel
Left = 0
Height = 34
Top = 154
Width = 560
Top = 304
Width = 699
Align = alBottom
BevelOuter = bvNone
ClientHeight = 34
ClientWidth = 560
ClientWidth = 699
TabOrder = 0
object Label1: TLabel
Left = 6
Height = 17
Top = 13
Width = 73
Height = 15
Top = 11
Width = 71
Caption = 'Command:'
ParentColor = False
end
object edtCommand: TEdit
Left = 88
Height = 27
Top = 8
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
Left = 79
Height = 32
Top = 3
Width = 266
BorderSpacing.Left = 2
OnKeyPress = edtCommandKeyPress
TabOrder = 0
end
object Button1: TButton
Left = 471
AnchorSideLeft.Control = cbAlertRegExp
AnchorSideLeft.Side = asrBottom
Left = 462
Height = 25
Top = 8
Top = 3
Width = 85
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Caption = 'Help'
OnClick = btnHelpClick
TabOrder = 1
end
object Button2: TButton
Left = 367
Left = 328
Height = 25
Top = 8
Top = -8
Width = 75
Caption = 'Button2'
OnClick = Button2Click
TabOrder = 2
Visible = False
end
object tbAlertCalls: TToggleBox
AnchorSideLeft.Control = edtCommand
AnchorSideLeft.Side = asrBottom
Left = 349
Height = 25
Top = 3
Width = 60
BorderSpacing.Left = 4
BorderSpacing.Right = 4
Caption = 'ACalls'
OnClick = tbAlertCallsClick
TabOrder = 3
end
object cbAlertRegExp: TCheckBox
AnchorSideLeft.Control = tbAlertCalls
AnchorSideLeft.Side = asrBottom
Left = 413
Height = 23
Top = 3
Width = 45
BorderSpacing.Right = 4
Caption = 'Inc'
TabOrder = 4
end
end
object Panel2: TPanel
Left = 0
Height = 30
Top = 0
Width = 560
Width = 699
Align = alTop
BevelOuter = bvNone
ClientHeight = 30
ClientWidth = 560
ClientWidth = 699
TabOrder = 1
object edtTelAddress: TEdit
Left = 8
Height = 27
Height = 32
Top = 1
Width = 189
TabOrder = 0
@ -316,9 +344,9 @@ object frmDXCluster: TfrmDXCluster
end
object pnlTelnet: TPanel
Left = 0
Height = 124
Height = 274
Top = 30
Width = 560
Width = 699
Align = alClient
BevelOuter = bvNone
Color = clWhite

68
src/fDXCluster.pas
View File

@ -33,6 +33,7 @@ type
btnWebConnect: TButton;
Button1: TButton;
Button2: TButton;
cbAlertRegExp: TCheckBox;
dlgDXfnt: TFontDialog;
edtCommand: TEdit;
edtTelAddress: TEdit;
@ -48,6 +49,7 @@ type
tabWeb: TTabSheet;
tmrAutoConnect: TTimer;
tmrSpots: TTimer;
tbAlertCalls: TToggleBox;
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -62,7 +64,8 @@ type
procedure btnTelConnectClick(Sender: TObject);
procedure btnWebConnectClick(Sender: TObject);
procedure edtCommandKeyPress(Sender: TObject; var Key: char);
procedure tmrAutoConnectTimer(Sender: TObject);
procedure tmrAutoConnectTimer(Sender: TObject);
procedure tbAlertCallsClick(Sender: TObject);
procedure tmrSpotsTimer(Sender: TObject);
private
telDesc : String;
@ -110,6 +113,9 @@ type
giWAZ : String;
giITU : String;
HistCmd : array [0..4] of string;
HistPtr : integer;
procedure WebDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
procedure TelDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
procedure ConnectToWeb;
@ -124,6 +130,8 @@ type
function GetFreq(spot : String) : String;
function GetCall(spot : String; web : Boolean = False) : String;
function GetSplit(spot : String) :String;
procedure StoreLastCmd(LastCmd:string);
function GetHistCmd:string;
public
ConWeb : Boolean;
ConTelnet : Boolean;
@ -164,7 +172,7 @@ implementation
{ TfrmDXCluster }
uses dUtils, fDXClusterList, dData, dDXCluster, fMain, fTRXControl, fNewQSO, fBandMap,
uMyIni;
uMyIni, fPreferences;
procedure TfrmDXCluster.ConnectToWeb;
var
@ -237,6 +245,32 @@ begin
btnTelConnect.Click;
tmrSpots.Enabled := False;
end;
procedure TfrmDXCluster.StoreLastCmd(LastCmd:string); //scroll &store last typed line
begin
HistPtr:=4;
Repeat
Begin
HistCmd[HistPtr] := HistCmd[HistPtr-1];
if dmData.DebugLevel>=1 then writeln('[',HistPtr,']' ,HistCmd[HistPtr]);
dec(HistPtr);
end;
until HistPtr = 0;
HistCmd[HistPtr] := LastCmd;
if dmData.DebugLevel>=1 then writeln('[',HistPtr,']' ,HistCmd[HistPtr]);
end;
function TfrmDXCluster.GetHistCmd:string; //return line that ptr points & inc ptr(go round if not empty);
begin
Result:= HistCmd[HistPtr];
if (HistPtr < 4) and ( HistCmd[HistPtr+1]<>'') then
inc (HistPtr)
else
HistPtr:=0;
end;
procedure TfrmDXCluster.btnHelpClick(Sender: TObject);
begin
@ -319,7 +353,14 @@ begin
TelThread := TTelThread.Create(True);
TelThread.FreeOnTerminate := True;
TelThread.Start
TelThread.Start;
HistPtr:=5; //initialize command history to be clean
repeat
Begin
dec(HistPtr);
HistCmd[HistPtr]:=''
end;
until HistPtr =0;
end;
procedure TfrmDXCluster.FormKeyUp(Sender: TObject; var Key: Word;
@ -517,13 +558,32 @@ end;
procedure TfrmDXCluster.edtCommandKeyPress(Sender: TObject; var Key: char);
begin
if key=#26 then
Begin
key := #0;
edtCommand.Clear;
edtCommand.Text := GetHistCmd;
edtCommand.SelStart := Length(edtCommand.Text);
end;
if key=#13 then
begin
StoreLastCmd(edtCommand.Text);
key := #0;
SendCommand(edtCommand.Text);
edtCommand.Clear
end;
end;
procedure TfrmDXCluster.tbAlertCallsClick(Sender: TObject);
begin
if tbAlertCalls.Checked then
Begin
tbAlertCalls.Font.Color := clGreen;
frmPreferences.btnAlertCallsignsClick(nil);
end
else
tbAlertCalls.Font.Color := clDefault;
end;
procedure TfrmDXCluster.tmrAutoConnectTimer(Sender: TObject);
begin
@ -1058,7 +1118,7 @@ begin
end
end;
if dmDXCluster.IsAlertCall(call,band,mode) then
if (dmDXCluster.IsAlertCall(call,band,mode,cbAlertRegExp.Checked)) and tbAlertCalls.Checked then
dmDXCluster.RunCallAlertCmd(call,band,mode,freq);
if dmData.DebugLevel >=1 then

92
src/fExportProgress.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, iniFiles, ExtCtrls, db, dateutils, FileUtil, LazFileUtils;
ComCtrls, iniFiles, ExtCtrls, db, dateutils, FileUtil, LazFileUtils,strutils;
type
@ -215,26 +215,82 @@ var
end;
if exRSTS then
begin
tmp := '<RST_SENT' + dmUtils.StringToADIF(RSTS);
tmp := '<RST_SENT' + dmUtils.StringToADIF(ExtractWord(1,RSTS,[' ']));
Write(f,tmp);
leng := leng + Length(tmp)
end;
if leng>200 then
begin
Writeln(f);
leng := 0
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
if length(RSTS)>3 then // there is something else
Begin
tmp:=ExtractWord(2,RSTS,[' ']); //contest NR
if (tmp <>'') then
Begin
tmp := '<STX' + dmUtils.StringToADIF(tmp);
Write(f,tmp);
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
end;
tmp:=ExtractWord(3,RSTS,[' ']); //Contest MSG
if (tmp <>'') then
Begin
tmp := '<STX_STRING' + dmUtils.StringToADIF(tmp);
Write(f,tmp);
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
end;
end;
end;
if exRSTR then
begin
tmp := '<RST_RCVD' + dmUtils.StringToADIF(RSTR);
Write(f,tmp);
leng := leng + Length(tmp)
end;
if leng>200 then
begin
Writeln(f);
leng := 0
end;
begin
tmp := '<RST_RCVD' + dmUtils.StringToADIF(ExtractWord(1,RSTR,[' ']));
Write(f,tmp);
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
if length(RSTR)>3 then // there is something else
Begin
tmp:=ExtractWord(2,RSTR,[' ']); //contest NR
if (tmp <>'') then
Begin
tmp := '<SRX' + dmUtils.StringToADIF(tmp);
Write(f,tmp);
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
end;
tmp:=ExtractWord(3,RSTR,[' ']); //Contest MSG
if (tmp <>'') then
Begin
tmp := '<SRX_STRING' + dmUtils.StringToADIF(tmp);
Write(f,tmp);
leng := leng + Length(tmp);
if leng>200 then
begin
Writeln(f);
leng := 0
end;
end;
end;
end;
if exName then
begin
if Length(sName) > 0 then

80
src/fNewQSO.lfm
View File

@ -1,7 +1,7 @@
object frmNewQSO: TfrmNewQSO
Left = 429
Left = 469
Height = 651
Top = 93
Top = 124
Width = 807
HelpType = htKeyword
HelpKeyword = 'help/index.html'
@ -4029,6 +4029,24 @@ object frmNewQSO: TfrmNewQSO
end
object MenuItem67: TMenuItem
Caption = 'Window'
object MenuItem71: TMenuItem
Action = acShowBandMap
end
object MenuItem63: TMenuItem
Action = acContest
end
object MenuItem73: TMenuItem
Action = acCWType
end
object MenuItem72: TMenuItem
Action = acCWFKey
end
object MenuItem80: TMenuItem
Action = acDetails
end
object MenuItem70: TMenuItem
Action = acDXCluster
end
object MenuItem68: TMenuItem
Action = acGrayline
Bitmap.Data = {
@ -4068,45 +4086,34 @@ object frmNewQSO: TfrmNewQSO
0C00012200001101030001FFC4006C9BD3006999D1006596CE00
}
end
object MenuItem69: TMenuItem
Action = acTRXControl
object MenuItem52: TMenuItem
Action = acLogUploadStatus
end
object MenuItem70: TMenuItem
Action = acDXCluster
end
object MenuItem75: TMenuItem
Action = acXplanet
end
object MenuItem71: TMenuItem
Action = acShowBandMap
end
object MenuItem72: TMenuItem
Action = acCWFKey
end
object MenuItem73: TMenuItem
Action = acCWType
object mnuDK0WCY: TMenuItem
Action = acpDK0WCY
Caption = 'Prop_DK0WCY'
end
object MenuItem74: TMenuItem
Action = acProp
Caption = 'Propgation'
end
object MenuItem80: TMenuItem
Action = acDetails
object MenuItem38: TMenuItem
Action = acQSOList
end
object MenuItem34: TMenuItem
Action = acSCP
object MenuItem91: TMenuItem
Action = acRBNMonitor
end
object mnuReminder: TMenuItem
Action = acReminder
end
object MenuItem37: TMenuItem
Action = acRotControl
end
object MenuItem38: TMenuItem
Action = acQSOList
object MenuItem34: TMenuItem
Action = acSCP
end
object MenuItem52: TMenuItem
Action = acLogUploadStatus
end
object MenuItem91: TMenuItem
Action = acRBNMonitor
object MenuItem69: TMenuItem
Action = acTRXControl
end
object mnuWsjtxmonitor: TMenuItem
Action = acMonitorWsjtx
@ -4116,9 +4123,8 @@ object frmNewQSO: TfrmNewQSO
Action = acLocatorMap
Caption = 'Wkd locators'
end
object mnuDK0WCY: TMenuItem
Action = acpDK0WCY
Caption = 'Prop_DK0WCY'
object MenuItem75: TMenuItem
Action = acXplanet
end
end
object MenuItem3: TMenuItem
@ -4825,6 +4831,16 @@ object frmNewQSO: TfrmNewQSO
Caption = 'acpDK0WCY'
OnExecute = acpDK0WCYExecute
end
object acReminder: TAction
Category = 'Window'
Caption = 'Reminder'
OnExecute = acReminderExecute
end
object acContest: TAction
Category = 'Window'
Caption = 'Contest'
OnExecute = acContestExecute
end
end
object imgMain: TImageList
left = 200

35
src/fNewQSO.pas
View File

@ -74,6 +74,8 @@ type
acLocatorMap: TAction;
acpDK0WCY: TAction;
acProp: TAction;
acReminder: TAction;
acContest: TAction;
acUploadToAll: TAction;
acUploadToHrdLog: TAction;
acUploadToClubLog: TAction;
@ -98,6 +100,8 @@ type
MenuItem56: TMenuItem;
MenuItem57: TMenuItem;
MenuItem58: TMenuItem;
MenuItem63: TMenuItem;
mnuReminder: TMenuItem;
MenuItem86: TMenuItem;
MenuItem87: TMenuItem;
MenuItem88: TMenuItem;
@ -320,6 +324,7 @@ type
tmrStart: TTimer;
procedure acBigSquareExecute(Sender: TObject);
procedure acCommentToCallsignExecute(Sender : TObject);
procedure acContestExecute(Sender: TObject);
procedure acCWFKeyExecute(Sender: TObject);
procedure acHotkeysExecute(Sender: TObject);
procedure acLocatorMapExecute(Sender: TObject);
@ -332,6 +337,7 @@ type
procedure acRefreshTimeExecute(Sender: TObject);
procedure acRefreshTRXExecute(Sender: TObject);
procedure acReloadCWExecute(Sender: TObject);
procedure acReminderExecute(Sender: TObject);
procedure acRemoteWsjtExecute(Sender: TObject);
procedure acRotControlExecute(Sender: TObject);
procedure acSCPExecute(Sender : TObject);
@ -562,7 +568,6 @@ type
procedure SaveSettings;
procedure ChangeCallBookCaption;
procedure SendSpot;
procedure RunVK(key_pressed: String);
procedure CreateAutoBackup();
procedure RefreshInfoLabels;
procedure FillDateTimeFields;
@ -609,6 +614,7 @@ type
procedure UploadAllQSOOnline;
procedure ReturnToNewQSO;
procedure InitializeCW;
procedure RunVK(key_pressed: String);
end;
type
@ -668,7 +674,8 @@ uses dUtils, fChangeLocator, dDXCC, dDXCluster, dData, fMain, fSelectDXCC, fGray
fQSODetails, fWAZITUStat, fIOTAStat, fGraphStat, fImportProgress, fBandMap,
fLongNote, fRefCall, fKeyTexts, fCWType, fExportProgress, fPropagation, fCallAttachment,
fQSLViewer, fCWKeys, uMyIni, fDBConnect, fAbout, uVersion, fChangelog,
fBigSquareStat, fSCP, fRotControl, fLogUploadStatus, fRbnMonitor, fException, fCommentToCall;
fBigSquareStat, fSCP, fRotControl, fLogUploadStatus, fRbnMonitor, fException, fCommentToCall,
fRemind, fContest;
procedure TQSLTabThread.Execute;
var
@ -1282,6 +1289,15 @@ begin
thqsl.Start
end;
//this have to be done here when log is selected (settings at database)
frmReminder.chRemi.Checked := cqrini.ReadBool('Reminder','chRemi',False);
frmReminder.chUTRemi.Checked := cqrini.ReadBool('Reminder','chUTRemi',False);
frmReminder.RemindTimeSet.EditText := cqrini.ReadString('Reminder','RemindTimeSet','000');
frmReminder.RemindUThour.EditText := cqrini.ReadString('Reminder','RemindUThour','00:00');
frmReminder.RemiMemo.Lines.Clear;
frmReminder.RemiMemo.Lines.Add(cqrini.ReadString('Reminder','RemiMemo',''));
frmReminder.btCloseClick(nil);
dmUtils.InsertQSL_S(cmbQSL_S);
dmUtils.InsertQSL_R(cmbQSL_R);
@ -3837,6 +3853,11 @@ begin
InitializeCW
end;
procedure TfrmNewQSO.acReminderExecute(Sender: TObject);
begin
frmReminder.OpenReminder;
end;
procedure TfrmNewQSO.acRemoteWsjtExecute(Sender: TObject);
begin
if mnuRemoteModeWsjt.Checked then
@ -3958,6 +3979,11 @@ begin
end
end;
procedure TfrmNewQSO.acContestExecute(Sender: TObject);
begin
frmContest.Show;
end;
procedure TfrmNewQSO.acOpenLogExecute(Sender: TObject);
var
old : String;
@ -6257,8 +6283,9 @@ begin
WsjtxSock := TUDPBlockSocket.Create;
{if dmData.DebugLevel>=1 then} Writeln('Socket created!');
try
WsjtxSock.bind('127.0.0.1',cqrini.ReadString('wsjt','port','2237'));
{if dmData.DebugLevel>=1 then }Writeln('Bind issued '+cqrini.ReadString('wsjt','port','2237'))
WsjtxSock.bind(cqrini.ReadString('wsjt','ip','127.0.0.1'),cqrini.ReadString('wsjt','port','2237'));
{if dmData.DebugLevel>=1 then }Writeln('Bind issued '+cqrini.ReadString('wsjt','ip','127.0.0.1')+
':'+cqrini.ReadString('wsjt','port','2237'))
except
{if dmData.DebugLevel>=1 then} Writeln('Could not bind socket for wsjtx!');
DisableRemoteMode;

1498
src/fPreferences.lfm
View File

File diff suppressed because it is too large Load Diff

4
src/fPreferences.pas
View File

@ -467,6 +467,7 @@ type
cmbDataBitsR1: TComboBox;
cl10db : TColorBox;
cmbModelRig1: TComboBox;
edtWsjtIp: TEdit;
edtCondxImageUrl: TEdit;
edtBackupPath1: TEdit;
edtR1Host : TEdit;
@ -764,6 +765,7 @@ type
Label204: TLabel;
Label205: TLabel;
Label206 : TLabel;
Label26: TLabel;
lbl: TLabel;
Label19: TLabel;
Label2: TLabel;
@ -1405,6 +1407,7 @@ begin
cqrini.WriteString('wsjt','path',edtWsjtPath.Text);
cqrini.WriteString('wsjt','port',edtWsjtPort.Text);
cqrini.WriteString('wsjt','ip',edtWsjtIp.Text);
cqrini.WriteBool('wsjt','run',chkRunWsjt.Checked);
cqrini.WriteInteger('wsjt', 'freq', rgWsjtFreqFrom.ItemIndex);
cqrini.WriteString('wsjt', 'deffreq', edtWsjtDefaultFreq.Text);
@ -2760,6 +2763,7 @@ begin
edtWsjtPath.Text := cqrini.ReadString('wsjt','path','');
edtWsjtPort.Text := cqrini.ReadString('wsjt','port','2237');
edtWsjtIp.Text := cqrini.ReadString('wsjt','ip','127.0.0.1');
chkRunWsjt.Checked := cqrini.ReadBool('wsjt','run',False);
rgWsjtFreqFrom.ItemIndex := cqrini.ReadInteger('wsjt', 'freq', 1);
edtWsjtDefaultFreq.Text := cqrini.ReadString('wsjt', 'deffreq', '3.600');

20
src/fTRXControl.lfm
View File

@ -152,7 +152,7 @@ object frmTRXControl: TfrmTRXControl
OnKeyDown = FormKeyDown
OnKeyUp = FormKeyUp
OnShow = FormShow
LCLVersion = '1.6.0.4'
LCLVersion = '1.6.4.0'
object GroupBox2: TGroupBox
Left = 256
Height = 210
@ -160,7 +160,7 @@ object frmTRXControl: TfrmTRXControl
Width = 83
Align = alRight
Caption = ' Mode '
ClientHeight = 192
ClientHeight = 194
ClientWidth = 81
TabOrder = 0
object btnCW: TButton
@ -245,7 +245,7 @@ object frmTRXControl: TfrmTRXControl
Width = 256
Align = alTop
Caption = ' Freq '
ClientHeight = 54
ClientHeight = 56
ClientWidth = 254
TabOrder = 0
object lblFreq: TLabel
@ -263,7 +263,7 @@ object frmTRXControl: TfrmTRXControl
ParentFont = False
end
object btnVFOA: TButton
Left = 2
Left = -1
Height = 25
Top = -1
Width = 32
@ -272,7 +272,7 @@ object frmTRXControl: TfrmTRXControl
Visible = False
end
object btnVFOB: TButton
Left = 2
Left = 0
Height = 25
Top = 23
Width = 32
@ -288,7 +288,7 @@ object frmTRXControl: TfrmTRXControl
Width = 256
Align = alClient
Caption = ' Band '
ClientHeight = 94
ClientHeight = 96
ClientWidth = 254
TabOrder = 1
object btn160m: TButton
@ -424,9 +424,9 @@ object frmTRXControl: TfrmTRXControl
TabOrder = 2
object rbRadio1: TRadioButton
Left = 8
Height = 22
Height = 23
Top = 2
Width = 50
Width = 57
Caption = 'RIG: '
Checked = True
OnClick = rbRadio1Click
@ -435,9 +435,9 @@ object frmTRXControl: TfrmTRXControl
end
object rbRadio2: TRadioButton
Left = 160
Height = 22
Height = 23
Top = 2
Width = 50
Width = 57
Caption = 'RIG: '
OnClick = rbRadio2Click
TabOrder = 1

192
src/fcontest.lfm Normal file
View File

@ -0,0 +1,192 @@
object frmContest: TfrmContest
Left = 1889
Height = 99
Top = 115
Width = 696
Caption = 'Contest'
ClientHeight = 99
ClientWidth = 696
OnClose = FormClose
OnCreate = FormCreate
OnHide = FormHide
OnKeyDown = FormKeyDown
OnShow = FormShow
LCLVersion = '1.6.4.0'
object edtCall: TEdit
Left = 10
Height = 32
Top = 27
Width = 140
CharCase = ecUppercase
OnExit = edtCallExit
OnKeyDown = edtCallKeyDown
OnKeyPress = edtCallKeyPress
TabOrder = 0
end
object edtRSTs: TEdit
Left = 151
Height = 32
Top = 27
Width = 50
OnKeyDown = edtCallKeyDown
TabOrder = 5
end
object edtSTX: TEdit
Left = 202
Height = 32
Top = 27
Width = 50
OnExit = edtSTXExit
OnKeyDown = edtCallKeyDown
OnKeyPress = edtSTXKeyPress
TabOrder = 6
end
object edtSTX2: TEdit
Left = 253
Height = 32
Top = 27
Width = 100
OnExit = edtSTX2Exit
OnKeyDown = edtCallKeyDown
TabOrder = 7
end
object edtRSTr: TEdit
Left = 370
Height = 32
Top = 27
Width = 50
OnKeyDown = edtCallKeyDown
TabOrder = 4
end
object edtSRX: TEdit
Left = 421
Height = 32
Top = 27
Width = 50
OnExit = edtSRXExit
OnKeyDown = edtCallKeyDown
OnKeyPress = edtSTXKeyPress
TabOrder = 1
end
object btSave: TButton
Left = 592
Height = 32
Top = 27
Width = 83
Caption = 'Save QSO'
OnClick = btSaveClick
TabOrder = 3
end
object edtSRX2: TEdit
Left = 472
Height = 32
Top = 27
Width = 100
OnKeyDown = edtCallKeyDown
TabOrder = 2
end
object lblCall: TLabel
Left = 16
Height = 15
Top = 10
Width = 25
Caption = 'Call'
ParentColor = False
end
object lblRSTs: TLabel
Left = 160
Height = 15
Top = 10
Width = 36
Caption = 'RST s'
ParentColor = False
end
object lblMSGs: TLabel
Left = 256
Height = 15
Top = 10
Width = 40
Caption = 'MSG s'
ParentColor = False
end
object lblRSTr: TLabel
Left = 376
Height = 15
Top = 10
Width = 34
Caption = 'RST r'
ParentColor = False
end
object lblNRr: TLabel
Left = 424
Height = 15
Top = 10
Width = 28
Caption = 'NR r'
ParentColor = False
end
object lblMSGr: TLabel
Left = 480
Height = 15
Top = 10
Width = 38
Caption = 'MSG r'
ParentColor = False
end
object chNRInc: TCheckBox
Left = 202
Height = 23
Top = 56
Width = 45
Caption = 'Inc'
TabOrder = 8
end
object lblNRs: TLabel
Left = 208
Height = 15
Top = 10
Width = 30
Caption = 'NR s'
ParentColor = False
end
object chLoc: TCheckBox
Left = 472
Height = 23
Top = 56
Width = 100
Caption = 'MSG is LOC'
TabOrder = 9
end
object chSpace: TCheckBox
Left = 16
Height = 23
Top = 56
Width = 111
Caption = 'SPACE is TAB'
TabOrder = 10
end
object chNoNr: TCheckBox
Left = 424
Height = 23
Top = 56
Width = 44
Caption = 'No'
OnChange = chNoNrChange
TabOrder = 11
end
object chTrueRST: TCheckBox
Left = 153
Height = 23
Top = 56
Width = 45
Caption = 'Tru'
OnChange = chTrueRSTChange
TabOrder = 12
end
object tmrESC2: TTimer
Enabled = False
OnTimer = tmrESC2Timer
left = 632
top = 64
end
end

362
src/fcontest.pas Normal file
View File

@ -0,0 +1,362 @@
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.

144
src/fremind.lfm Normal file
View File

@ -0,0 +1,144 @@
object frmReminder: TfrmReminder
Left = 545
Height = 128
Top = 222
Width = 599
BorderStyle = bsDialog
Caption = 'Reminder'
ClientHeight = 128
ClientWidth = 599
OnClose = FormClose
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '1.6.4.0'
object RemiMemo: TMemo
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 33
Top = 91
Width = 582
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
MaxLength = 255
OnKeyPress = RemiMemoLimit
TabOrder = 0
end
object chRemi: TCheckBox
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrBottom
Left = 222
Height = 23
Top = 30
Width = 154
BorderSpacing.Top = 5
Caption = 'Remind again after '
OnChange = chRemiChange
TabOrder = 1
end
object lblRemi2: TLabel
AnchorSideLeft.Control = RemiMemo
AnchorSideBottom.Control = RemiMemo
Left = 8
Height = 16
Top = 73
Width = 116
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Remember to:'
Font.Height = 14
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object btClose: TButton
AnchorSideRight.Control = RemiMemo
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RemiMemo
Left = 515
Height = 25
Top = 64
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Close'
OnClick = btCloseClick
TabOrder = 2
end
object RemindTimeSet: TMaskEdit
AnchorSideLeft.Control = chRemi
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chRemi
Left = 376
Height = 32
Top = 30
Width = 56
CharCase = ecNormal
MaxLength = 3
TabOrder = 3
OnEnter = RemindTimeSetEnter
OnExit = RemindTimeSetExit
EditMask = '999;1;0'
Text = ' '
SpaceChar = '0'
end
object lblRemi3: TLabel
AnchorSideLeft.Control = RemindTimeSet
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chRemi
AnchorSideTop.Side = asrCenter
Left = 434
Height = 15
Top = 34
Width = 53
BorderSpacing.Left = 2
Caption = 'minutes'
ParentColor = False
end
object chUTRemi: TCheckBox
Left = 222
Height = 23
Top = 64
Width = 153
Caption = 'Remind time (UTC) '
OnChange = chUTRemiChange
TabOrder = 4
end
object RemindUThour: TMaskEdit
Left = 376
Height = 32
Top = 57
Width = 56
CharCase = ecNormal
MaxLength = 5
ParentFont = False
TabOrder = 5
OnChange = RemindUThourChange
EditMask = '!00\:00;1;-'
Text = ' : '
SpaceChar = '-'
end
object lblRemi1: TLabel
Left = 0
Height = 28
Top = 0
Width = 600
Caption = ' Sitting is killing you! Take a short walk! '
Color = clRed
Font.Color = clYellow
Font.Height = -24
Font.Style = [fsBold, fsItalic]
ParentColor = False
ParentFont = False
Transparent = False
end
object tmrRemi: TTimer
Enabled = False
Interval = 1800000
OnTimer = tmrRemiTimer
left = 75
top = 216
end
end

219
src/fremind.pas Normal file
View File

@ -0,0 +1,219 @@
unit fRemind;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, maskedit;
type
{ TfrmReminder }
TfrmReminder = class(TForm)
btClose: TButton;
chUTRemi: TCheckBox;
chRemi: TCheckBox;
lblRemi1: TLabel;
lblRemi3: TLabel;
lblRemi2: TLabel;
RemindUThour: TMaskEdit;
RemindTimeSet: TMaskEdit;
RemiMemo: TMemo;
tmrRemi: TTimer;
procedure FormShow(Sender: TObject);
procedure RemiMemoLimit(Sender: TObject; var Key: Char);
procedure btCloseClick(Sender: TObject);
procedure chRemiChange(Sender: TObject);
procedure chUTRemiChange(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure RemindTimeSetEnter(Sender: TObject);
procedure RemindTimeSetExit(Sender: TObject);
procedure RemindUThourChange(Sender: TObject);
procedure tmrRemiTimer(Sender: TObject);
private
procedure ShowReminder;
{ private declarations }
public
procedure OpenReminder;
{ public declarations }
end;
var
frmReminder: TfrmReminder;
date : TDateTime;
TimerValue: string;
implementation
{ TfrmReminder }
uses dData,dUtils,uMyini;
Procedure TfrmReminder.OpenReminder;
Begin //when not entering from timer
tmrRemi.Enabled :=false;
frmReminder.ShowOnTop;
RemiMemo.SetFocus;
end;
procedure TfrmReminder.RemiMemoLimit(Sender: TObject; var Key: Char);
var
MAX_LINES : Integer;
LINE_LENGTH : Integer;
begin
MAX_LINES := 1;
LINE_LENGTH := 255;
if (RemiMemo.Lines.Count = MAX_LINES) then
if(Key = #13) or (length(RemiMemo.Lines[MAX_LINES-1]) >= LINE_LENGTH ) then
begin
if not((Key = #08) or (Key = #127)) then Key := #0; //del & BS ok
Exit;
end;
if (RemiMemo.Lines.Count > MAX_LINES) and (Key = #13) then //no new lines
begin
Key := #0;
Exit;
end;
end;
procedure TfrmReminder.FormShow(Sender: TObject);
begin
//dmUtils.LoadWindowPos(frmReminder); // this breaks big fonts and positions used in this form !!!!
end;
Procedure TfrmReminder.ShowReminder;
var s,i:string;
Begin
if chRemi.Checked then
begin
TimerValue := IntToStr(tmrRemi.Interval div 60000);
if dmData.DebugLevel >=1 then writeln('Reminder TimerValue:', tmrRemi.Interval );
while length(Timervalue)< 3 do TimerValue := '0'+TimerValue;
RemindTimeSet.EditText:= TimerValue;
tmrRemi.Enabled := False;
frmReminder.ShowOnTop;
RemiMemo.SetFocus;
end;
if chUTRemi.checked then
Begin
date := dmUtils.GetDateTime(0);
i:= FormatDateTime('hh:mm',date);
s:= RemindUThour.EditText;
if dmData.DebugLevel >=1 then writeln('UT reminder *',s,'* is nw *',i,'*');
if i = s then
Begin
tmrRemi.Enabled := False;
frmReminder.ShowOnTop;
RemiMemo.SetFocus;
end;
end;
end;
procedure TfrmReminder.FormClose(Sender: TObject; var CloseAction: TCloseAction
);
begin
frmReminder.btCloseClick(nil);
end;
procedure TfrmReminder.RemindTimeSetEnter(Sender: TObject);
begin
RemindTimeSet.SelectAll;
end;
procedure TfrmReminder.RemindTimeSetExit(Sender: TObject);
begin
if ((RemindTimeSet.EditText = '000') and chRemi.Checked) then
RemindTimeSet.EditText := '001';
end;
procedure TfrmReminder.RemindUThourChange(Sender: TObject);
var s : string;
begin
s := RemindUThour.EditText;
case s[1] of //hour tens just 0,1,2
'3' .. '9' : s[1] := '0';
end;
if s[1] = '2' then // hours just up to 23
case s[2] of
'4' .. '9' : s[2] := '0';
end;
case s[4] of //minute tens just 0,1,2,4,5
'6' .. '9' : s[4] := '0';
end;
RemindUThour.EditText := s;
end;
procedure TfrmReminder.btCloseClick(Sender: TObject);
var
TimerSetting : integer;
begin
if chRemi.Checked = true then
Begin
if TryStrToINt(RemindTimeSet.EditText,TimerSetting) then
TimerSetting := TimerSetting * 60000 //to milliseconds
else
begin
RemindTimeSet.EditText :='001';
TimerSetting := 60000; // on error defaults to minute
end;
tmrRemi.Interval:= TimerSetting;
tmrRemi.Enabled := True;
if dmData.DebugLevel >=1 then Writeln('Remind timer set to :',tmrRemi.Interval,'ms');
end;
if chUTRemi.Checked = true then
Begin
TimerSetting := 10000; // 10sec for UT check
tmrRemi.Interval:= TimerSetting;
tmrRemi.Enabled := True;
if dmData.DebugLevel >=1 then Writeln('UT Remind check timer set to :',tmrRemi.Interval,'ms');
end;
if (not chUTRemi.Checked) and (not chRemi.Checked ) then tmrRemi.Enabled := False;
cqrini.WriteBool('Reminder','chRemi',chRemi.Checked);
cqrini.WriteBool('Reminder','chUTRemi',chUTRemi.Checked);
cqrini.WriteString('Reminder','RemindTimeSet',RemindTimeSet.EditText);
cqrini.WriteString('Reminder','RemindUThour',RemindUThour.EditText);
cqrini.WriteString('Reminder','RemiMemo',RemiMemo.Lines[0]);
//dmUtils.SaveWindowPos(frmReminder);
frmReminder.hide;
end;
procedure TfrmReminder.chRemiChange(Sender: TObject);
begin
if chRemi.Checked = true then chUTRemi.Checked := false;
end;
procedure TfrmReminder.chUTRemiChange(Sender: TObject);
begin
if chUTRemi.Checked = true then chRemi.Checked := false;
end;
procedure TfrmReminder.tmrRemiTimer(Sender: TObject);
begin
ShowReminder;
end;
initialization
{$I fremind.lrs}
end.

2
src/uVersion.pas
View File

@ -4,7 +4,7 @@ unit uVersion;
interface
const
cVERSION = '2.0.5 (024)';
cVERSION = '2.0.5 (029)';
cMAJOR = 2;
cMINOR = 0;
cRELEAS = 4;