Quelle reAgenda.pas.bak
Sprache: unbekannt
|
|
Spracherkennung für: .bak vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]
//------------------------------------------------------------------
//
// Bugs:
// 1. ..................
//
//------------------------------------------------------------------
unit reAgenda;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd,
ToolWin, ActnList, ImgList, DBAccess, ShellApi, OleServer, Utilities,
DBXpress, DB, SqlExpr, Feedback, Grids, ValEdit, reThreads, reThreads2,
reLang, reAbout, reThreads3, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,
Maildata, IdSMTP, WideStrings
;
{------------------------------------------------------------------}
{- Type Declarations -}
{------------------------------------------------------------------}
Const
AppName = 'Agenda';
Version = '1.3';
SubVersion = '';
langmax = 24;
AllCountMax = 1024;
EreignisDatei = 'Ereignis.Dat';
ObjectFile = 'agenda.exe';
OptionsDatei = 'options.Dat';
SprachDatei = 'language.dat';
ATCommand = 'atcmd.bat';
KennungsDatei = 'kennung.dat';
SoundsDir = 'Sounds';
ImageDir = 'Images';
LocalEvent = ' ';
CommonEvent = 'RR';
Type
Char2 = array[1..2] of char;
Char4 = array[1..4] of char;
Char28 = array[1 ..28] of char;
Char32 = array[1 ..32] of char;
Char36 = array[1..36] of char;
Char72 = array[1..72] of char;
Filename = array[0..120] of char;
LangArray = array [0..langmax] of String;
PLangArray = array [0..langmax] of Char36;
Date = Record
Minute : 0 .. 59;
Hour : 0 .. 23;
Day : 1 .. 31;
WeekDay: 0 .. 6;
Month : 1 .. 12;
Year : -2200 .. 2200;
end;
// Achtung, immer die Länge mitändern
TAppoint = Record
Month : Char2;
Fill1 : char;
Day : Char2;
BC : char;
Year : Char4;
Fill3 : char;
Typ : Char32;
Fill4 : char;
Who : Char36;
Fill5 : Char4;
Wish : Char36;
Fill6 : Char4;
Picture : Filename; // 244 danach
Fill7 : Char4;
Remote : Char2;
Fill8 : Char2;
Done : Char4; // every, 1., 2., 3. etc
Repeats : Char28; // every, 1., 2., 3. etc
Fill9 : Char2; // 268 danach
Email : Char36; // 304 gesamt
end;
LAppoint = array[0..400] of char;
TOption = record
inited : char;
lang : integer;
locale : string[12];
SoundFile : array[TSound] of filename;
alarmzeit : integer;
Fontname : String[32];
FontStyles : TFontStyles;
FontSize : integer;
FontColor : TColor;
width : integer;
height : integer;
winpos : TPosition;
Top : integer;
Left : integer;
Voice : integer;
VoiceRate : integer;
WarnMe : boolean;
Waittime : integer; // time until close of program
WakeTime : integer; // time of day, when program starts automatically
ATKennung : integer;
LastRun : TDate;
Vorname : String[24];
Name : String[24];
Email : String[24];
SecureEnd : String[12];
LocalDir : String[240];
EditCommon : boolean;
CommonDir : String[240];
PlayMorseCodes : boolean;
SMTPHost : String[240];
SMTPUser : String[24];
SMTPPAssword : String[24];
Buffer : String[200];
ProgramDir : String[200];
end;
TMainForm1 = class(TForm)
MainMenu: TMainMenu;
FileMenu : TMenuItem;
EventNewItem: TMenuItem;
EventChangeItem: TMenuItem;
EventDeleteItem: TMenuItem;
Verzeichnis: TMenuItem;
PrintAllEvents: TMenuItem;
EventExitItem: TMenuItem;
EditMenu : TMEnuItem;
HelpMenu : TMEnuItem;
HelpAboutItem: TMenuItem;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
PrintDialog: TPrintDialog;
FontDialog1: TFontDialog;
N5: TMenuItem;
miEditFont: TMenuItem;
Ereignisse: TRichEdit;
StandardToolBar: TToolBar;
ToolbarImages: TImageList;
Language: TMenuItem;
Netzwerk: TMenuItem;
Alarmzeit: TMenuItem;
Hilfe1: TMenuItem;
N3: TMenuItem;
Sprachausgabe1: TMenuItem;
Sprachausgabe2: TMenuItem;
N6: TMenuItem;
Klnge1: TMenuItem;
ListView1: TListView;
Feedback1: TMenuItem;
Timer1: TTimer;
Tokens: TValueListEditor;
N7: TMenuItem;
Sprachtextendern1: TMenuItem;
FindDialog1: TFindDialog;
N8: TMenuItem;
Finden1: TMenuItem;
UpdateVersion1: TMenuItem;
Fontsize: TEdit;
UpDown1: TUpDown;
VoiceBox: TComboBox;
FontName: TComboBox;
LanguageBox: TComboBox;
ButtonNew: TToolButton;
ButtonChange: TToolButton;
ButtonDelete: TToolButton;
PrintButton: TToolButton;
BoldButton: TToolButton;
ItalicButton: TToolButton;
UnderlineButton: TToolButton;
ButtonFind: TToolButton;
PrintEvents: TMenuItem;
DonateItem: TMenuItem;
SQ: TSQLConnection;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
CommonDialog1: TOpenDialog;
li: TMenuItem;
Voice1: TMenuItem;
Sound1: TMenuItem;
N10: TMenuItem;
SMTP: TIdSMTP;
Postamt: TMenuItem;
procedure Sound1Click(Sender: TObject);
procedure Voice1Click(Sender: TObject);
procedure liClick(Sender: TObject);
procedure Verzeichnis1Click(Sender: TObject);
procedure NetzwerkClick(Sender: TObject);
procedure GetOptions;
procedure PutOptions;
procedure DefaultOptions;
procedure ForeignLocale;
procedure MakeAT;
procedure DeleteAT;
procedure GetAgendaDirectories;
procedure FormCreate(Sender: TObject);
procedure EventEdit(Sender: TObject);
procedure PrintEventFile(Sender: TObject);
procedure FileExit(Sender: TObject);
procedure EditUndo(Sender: TObject);
procedure EditCut(Sender: TObject);
procedure EditCopy(Sender: TObject);
procedure EditPaste(Sender: TObject);
procedure HelpAbout(Sender: TObject);
procedure FontChange(Sender: TObject);
procedure LanguageChange(Sender: TObject);
procedure MenuLanguageChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormShow(Sender: TObject);
procedure Current(var Setting : Date);
Procedure Sounder(so : TSound);
Procedure Communicator(Tx:String);
procedure Speech(sText : String);
function DayofYear(AnyTime:Date) : integer;
procedure Convert(A : TAppoint;var b : Date);
function Inspect(s:string) : boolean;
procedure Event(Ind:integer;Diff : integer);
procedure SendNote(Who :Char36;YearNum:integer;Typ:Char32;Email:Char36;Ind:integer );
procedure GetEvents(Datei:String;Remote:Char2);
procedure PutEvents(Datei:String; RM:Char2);
procedure PutAllEvents;
procedure GetAllEvents;
procedure Greetings;
procedure GetLanguages;
procedure PutLanguages;
procedure IOLanguages;
procedure FillList;
procedure Posit(S: String);
procedure GetFontNames;
procedure AlarmzeitClick(Sender: TObject);
procedure LanguageClick(Sender: TObject);
procedure Sprachausgabe2Click(Sender: TObject);
procedure Klnge1Click(Sender: TObject);
procedure VoiceBoxChange(Sender: TObject);
procedure ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EventNewItemClick(Sender: TObject);
procedure EventChangeItemClick(Sender: TObject);
procedure EventDeleteItemClick(Sender: TObject);
procedure MailData(Sender: TObject);
procedure Feedback1Click(Sender: TObject);
procedure MyIdleHandler(Sender: TObject; var Done: Boolean);
procedure StartTimer(Sender: TObject);
procedure StopTimer(Sender: TObject);
procedure MyTimeHandler(Sender: TObject);
procedure Hilfe1Click(Sender: TObject);
procedure TextEditieren(Sender: TObject);
procedure StandardToolBarMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure EreignisseMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Finden1Click(Sender: TObject);
procedure TokensExit(Sender: TObject);
procedure UpdateVersion1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure PrintButtonClick(Sender: TObject);
procedure EreignisseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure miEditFontClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PrintEventsClick(Sender: TObject);
procedure DonateItemClick(Sender: TObject);
procedure SQBeforeConnect(Sender: TObject);
procedure ThreadsDone(Sender: TObject);
public
Opts : file of TOption;
Locale : String;
LastSearchText : String;
LastWho : String;
ppn, pps : TNotifyEvent;
crlf : array[0..2] of char;
LastMousePosIn : boolean;
LastMousePos : TPoint;
LastMouseTime : TTime;
DoMakeSound : Boolean;
Crypt : String;
Passw : String;
LangBox : TLangBox;
AboutBox : TAboutBox;
Feedb : TFeedform;
MailDa : TMailForm;
LastSoundThread : TMySoundThread;
LastVoiceThread : TMySpeechThread;
LastMorseThread : TMyMorseThread;
nolanguages : integer;
Events : TextFile;
Langs : TextFile;
LangsDir : (readl,writel);
FDragOfs : Integer;
FDragging : Boolean;
Slept : integer;
EventFound : boolean;
WinEvent : boolean;
ThisTime : Date;
Greeting : String[20];
SoundPlayed : array[TSound] of boolean;
VoiceSpoken : boolean;
ShouldPutEvents : boolean;
//
end;
EFileInvalid = class(Exception);
//--------------------------------------------------------------
// statische Variablen
//--------------------------------------------------------------
var
MainForm1 : TMainForm1;
Opt : TOption;
All : array[1..1024] of TAppoint;
AllCount : integer;
Modus : (Neu, Aendern, Loeschen);
EventTypes : array[1..32] of String;
RemoteMark : Char2;
Blank2 : Char2;
Blank4 : Char4;
Blank28 : Char28;
Blank32 : Char32;
Blank36 : Char36;
Blank120 : FileName;
//
//Parameters for translation
D_Langs : LangArray;
D_Foreign : LangArray;
D_DFormats : LangArray;
D_Syntax : LangArray;
D_Months : array [1..langmax,1..12] of String;
D_Days : array [1..langmax,0..6] of String;
D_Geburtstagskalender : LangArray;
D_GutenMorgen : LangArray;
D_GutenAbend : LangArray;
D_GutenTag : LangArray;
D_Jetztist : LangArray;
D_Und : LangArray;
D_Hat : LangArray;
D_Haben : LangArray;
D_Gestern : LangArray;
D_Heute : LangArray;
D_Morgen : LangArray;
D_In : LangArray;
D_Vor : LangArray;
D_Ereignis : LangArray;
D_Geburtstag : LangArray;
D_Hochzeitstag : LangArray;
D_Namenstag : LangArray;
D_Jubilaeum : LangArray;
D_40th : LangArray;
D_werdenhaben : LangArray;
D_wirdhaben : LangArray;
D_Hatte : LangArray;
D_Hatten : LangArray;
D_Ersten : LangArray;
D_Zweiten : LangArray;
D_Dritten : LangArray;
D_Ist : LangArray;
D_Erste : LangArray;
D_Zweite : LangArray;
D_Dritte : LangArray;
D_Ein : LangArray;
D_Uhr : LangArray;
D_Stehtan : LangArray;
D_Wirklich : LangArray;
D_Geaendert : LangArray;
D_Status : LangArray;
D_Neu : LangArray;
D_Aendern : LangArray;
D_Sichern : LangArray;
D_Loeschen : LangArray;
D_Exportieren : LangArray;
D_Importieren : LangArray;
D_Drucken : LangArray;
D_Ende : LangArray;
D_Optionen : LangArray;
D_Sprache : LangArray;
D_Alarmzeit : LangArray;
D_Font : LangArray;
D_Hilfe : LangArray;
D_Ueber : LangArray;
D_Wunschzeit : LangArray;
D_Wunschsprache : LangArray;
D_Wuenschtsich : LangArray;
D_Wuenschensich : LangArray;
D_Am : LangArray;
D_OK : LangArray;
D_Finde : LangArray;
D_Abbrechen : LangArray;
D_Einfuegen : LangArray;
D_setzeSprecher : LangArray;
D_leise : LangArray;
D_Sprecher : LangArray;
D_Sprachausgabe : LangArray;
D_Klaenge : LangArray;
D_setzeFett : LangArray;
D_setzeSchrift : LangArray;
D_setzeGroesse : LangArray;
D_setzeItalic : LangArray;
D_setzeUnterstrichen : LangArray;
D_aendereEreignis : LangArray;
D_Ereignissedrucken : LangArray;
D_loescheEreignis : LangArray;
D_neuesEreignis : LangArray;
D_setzeSprache : LangArray;
D_Warum : LangArray;
D_ListEdit : LangArray;
D_LangEdit : LangArray;
D_Lexem : LangArray;
D_Wertinakt : LangArray;
D_Month : LangArray;
D_Day : LangArray;
D_Year : LangArray;
D_Who : LangArray;
D_Typ : LangArray;
D_Wish : LangArray;
D_Picture : LangArray;
D_Select : LangArray;
D_Emaileingeben : LangArray;
D_PrintHead : LangArray;
D_OutofMem : LangArray;
D_Firstof : LangArray;
D_Everyone : LangArray;
D_WantsFree : LangArray;
D_Incorrect : LangArray;
D_TooMany : LangArray;
D_NotImpl : PLangArray;
D_Parameter : PLangArray;
D_SoundFiles : LangArray;
D_Spende : LangArray;
D_SprachTexte : LangArray;
D_EndeZeit : LangArray;
D_Warnemich : LangArray;
D_Geschwindigkeit : LangArray;
D_SprecherTest : LangArray;
D_UhrzeitStart : LangArray;
D_SehrGut : LangArray;
D_Gut : LangArray;
D_Befriedigend : LangArray;
D_Ausreichend : LangArray;
D_Schlecht : LangArray;
D_SehrSchlecht : LangArray;
D_Name : LangArray;
D_Vorname : LangArray;
D_Email : LangArray;
D_Urteil : LangArray;
D_Kommentar : LangArray;
D_Senden : LangArray;
D_Abbruch : LangArray;
D_NoInternet : LangArray;
// neu
D_Lizenz : LangArray;
D_Herzlichen : LangArray;
D_Glueckwunsch : LangArray;
D_von : LangArray;
D_zum : LangArray;
D_Netzwerk : LangArray;
D_Verzeichnis : LangArray;
D_Uebertragen : LangArray;
D_Server : LAngArray;
D_User : LAngArray;
D_Passwort : LangArray;
D_Feedback : LangArray;
D_Postamt : LangArray;
D_SendeMorse : LangArray;
D_Filler4 : LangArray;
D_Filler5 : LangArray;
D_Filler6 : LangArray;
D_Filler7 : LangArray;
D_Filler8 : LangArray;
D_Filler9 : LangArray;
D_Filler10 : LangArray;
D_Filler11 : LangArray;
implementation
uses
reSplash, reSounds, reSpeech, reEditor, ReAlert,
ReOption, RichEdit, ReInit, DateUtils, StrUtils,
Math;
const
RulerAdj = 4/3;
GutterWid = 6;
{$R *.dfm}
{------------------------------------------------------------------}
{- Procedure FormCreate -}
{- -}
{------------------------------------------------------------------}
procedure TMainForm1.FormCreate(Sender: TObject);
var S: String;i:integer;
begin
Opt.ProgramDir := SysUtils.GetCurrentDir()+ '\';
DoMakeSound := true;
// set Title
Application.Title := AppName+' '+Version+' '+SubVersion;
//language processing
//ForeignLocale;
getLanguages;
//init last thread
LastSoundThread := nil;
LastVoiceThread := nil;
LastMorseThread := nil;
// for SQ passord etc.
Crypt := LowerCase(AppName);
Passw := MidStr(LowerCase(AppName),2,3);
SQ.ParamsLoaded := false;
//produce events
crlf[0] := chr(13);
crlf[1] := chr(10);
crlf[2] := chr(0);
//disable onchange;
PPn:= FontName.OnChange;FontName.OnChange:=nil;
PPs:= FontSize.OnChange;FontSize.OnChange:=nil;
//edit boxes follow here
GetFontNames;
//end set options
if LowerCase(ExtractFileName(Application.ExeName))<> ObjectFile then
Abort;
//Application.OnIdle:= MyIdleHandler;
Application.OnMinimize := StartTimer;
EventFound := False;
WinEvent := false;
Utilities.SpVoice := nil;
// initialization
for i:= 1 to 2 do Blank2[i] := ' ';
for i:= 1 to 4 do Blank4[i] := ' ';
for i:= 1 to 28 do Blank28[i] := ' ';
for i:= 1 to 32 do Blank32[i] := ' ';
for i:= 1 to 36 do Blank36[i] := ' ';
for i:= 1 to 120 do Blank120[i] := ' ';
//builtin gimmicks
Current(ThisTime);
//
LangsDir := readl;
LastSearchText := '';
LastMousePosIn := false;
LastMouseTime := Now;
//
Slept:=0;
//create timer
Timer1.Enabled := True;
Timer1.Interval := Opt.Waittime*1000;
Timer1.OnTimer := MyTimeHandler;
// get acoustical voices
Utilities.EnumVoices(Opt.Voice,D_Leise[Opt.lang],VoiceBox);
//
OpenDialog.InitialDir := ExtractFilePath(Opt.programDir);
SaveDialog.InitialDir := OpenDialog.InitialDir;
// ----- here is getOptions --------------------
getoptions;
//set voice index
VoiceBox.ItemIndex := Opt.Voice;
Utilities.Speaker := Opt.Voice;
//command line parameters
// close on too many invocations
if ParamCount > 0 then begin
s := LowerCase(ParamStr(1));
if (Opt.LastRun = Now)
and (S = 'auto') then
Close;
end;
// set Mouse Pos
LastMousePos := Mouse.CursorPos;
// set last run
Opt.LastRun := Now;
//position and size
MainForm1.Position := Opt.winpos;
MainForm1.Top := Opt.Top;
MainForm1.Left := opt.Left;
MainForm1.Width := Opt.width;
MainForm1.Height := Opt.height;
// file selector
if Opt.EditCommon then RemoteMark := CommonEvent else RemoteMark := LocalEvent;
ShouldPutEvents := false;
end;
{------------------------------------------------------------------}
{- Procedure FormPaint -}
{- -}
{------------------------------------------------------------------}
procedure TMainForm1.FormPaint(Sender: TObject);
var ts, so:TSound;
begin
Ereignisse.ReadOnly := false;
Netzwerk.Checked := Opt.EditCommon;
Verzeichnis.Checked := Opt.CommonDir<>'';
Voice1.Visible := Opt.Voice>0;
Sound1.Visible := false;
for so:=HappyBirthDay to DingDong do
if (Opt.SoundFile[so]>' ') then
Sound1.Visible:= true;
for ts:=HappyBirthDay to Sailing do
SoundPlayed[ts] := false;
VoiceSpoken := false;
//now branch from visibility
if Tokens.Visible then begin
Tokens.TitleCaptions[0] := D_Lexem[Opt.lang];
Tokens.TitleCaptions[1] := D_Wertinakt[Opt.lang];
end else if ListView1.Visible then begin
end else if ereignisse.Visible then begin
Ereignisse.Clear;
if LastSoundThread <> nil then begin
LastSoundThread.Terminate;
LastSoundThread:=nil;
end;
Slept:=0;
// delete and create new timer
if Timer1 <> nil then begin
timer1.Destroy;
timer1 := TTimer.Create(Mainform1);
end;
Timer1.Enabled := True;
Timer1.Interval := Opt.Waittime*1000;
Timer1.OnTimer := MyTimeHandler;
Ereignisse.DefAttributes.Color := opt.FontColor;
Ereignisse.DefAttributes.name := opt.Fontname;
Ereignisse.DefAttributes.size := opt.FontSize;
Ereignisse.DefAttributes.Style := opt.FontStyles;
Greetings;
if not (SplashForm = nil) then begin
SplashForm.Destroy;
SplashForm := nil
end;
AllCount := 0;
GetAllEvents;
//get list of items
FillList;
// Set Edit-Dialog with Eventfile
//Clipboard.Clear;
DoMakeSound := false;
end;
Ereignisse.ReadOnly:=true;
end;
{------------------------------------------------------------------}
{- Procedure PutAllEvents -}
{- local and remote -}
{------------------------------------------------------------------}
Procedure TMainForm1.PutAllEvents;
begin
if Opt.EditCommon then PutEvents(Opt.CommonDir+EreignisDatei,CommonEvent);
PutEvents(Opt.LocalDir+EreignisDatei,LocalEvent);
end;
{------------------------------------------------------------------}
{- Procedure GetAllEvents -}
{- local and remote -}
{------------------------------------------------------------------}
Procedure TMainForm1.GetAllEvents;
var i:integer;
begin
if not DirectoryExists(Opt.LocalDir) then begin // nur Initialisierung
DefaultOptions;
PutOptions;
end;
for i:=1 to 32 do EventTypes[i] := '';
AllCount:=0;
GetEvents(Opt.LocalDir+EreignisDatei,LocalEvent);
if Opt.CommonDir<>'' then begin
if Fileexists(Opt.CommonDir+EreignisDatei) then
GetEvents(Opt.CommonDir+EreignisDatei,CommonEvent);
end
end;
{------------------------------------------------------------------}
{- Procedure DefaultOptions -}
{- set Options -}
{------------------------------------------------------------------}
Procedure TMainForm1.DefaultOptions;
begin
//hidden sounds
Opt.lang := 1;
if syslocale.fareast then Opt.locale := 'fareast';
if syslocale.MiddleEast then Opt.locale := 'middleeast';
Opt.SoundFile[Kennenlerntag] := 'Arc-enciel.wav';
Opt.SoundFile[MartinasGeburtstag] := 'ChargeCavalerie.wav';
Opt.SoundFile[Hochzeitstag] := 'Anyone.wav';
Opt.SoundFile[BeethovensGeburtstag] := 'Fur Elise.mid';
Opt.SoundFile[BachsGeburtstag] := 'Bach Joy.mp3';
Opt.alarmzeit := 7;
Opt.Fontname := MainForm1.Font.Name;
Opt.FontStyles := [];
Opt.FontSize := MainForm1.Font.Size;
Opt.width := 400;
Opt.height := 300;
Opt.winpos := poScreenCenter;
opt.top := Screen.Height div 5;
Opt.Left := Screen.Width div 5;
Opt.Voice := 0;
Opt.VoiceRate := 1;
Opt.WarnMe := true;
Opt.Waittime := 45; // time until close of program
Opt.WakeTime := 10; // time of day, when program starts
Opt.LastRun := Yesterday;
Opt.Vorname := '';
Opt.Name := '';
Opt.Email := '';
opt.inited := 'J';
Opt.EditCommon := false;
Opt.CommonDir := '';
Opt.PlayMorseCodes := false;
GetAgendaDirectories;
end;{DefaultOpt.s}
{------------------------------------------------------------------}
{- Procedure getOpt.s -}
{- set Opt.s -}
{------------------------------------------------------------------}
Procedure TMainForm1.GetOptions;
var fn:String;fc:FileName;
begin
Fn:=Opt.ProgramDir+OptionsDatei;
if FileExists(Fn) then begin
AssignFile (Opts,Fn);
try
Reset(Opts);
finally
end;
if Not Eof(Opts) then begin
try
Read(Opts,Opt);
CloseFile(Opts)
except
DefaultOptions;
end;
end else begin
StrPCopy(fc,fn);
DeleteFile(fc);
Opt.inited:=' ';
end;
end
else
DefaultOptions;
//initialize from options
if Opt.inited <> 'J' then DefaultOptions;
end;{GetOpt.s}
{------------------------------------------------------------------}
{- Procedure PutOpt.s -}
{- store Opt.s -}
{------------------------------------------------------------------}
Procedure TMainForm1.PutOptions;
var Fn:String;
begin
Fn:=Opt.ProgramDir+OptionsDatei;
DeleteFile(PChar(Fn));
Opt.inited := 'J';
Opt.winpos := MainForm1.Position;
opt.Top := MainForm1.Top;
opt.Left := MainForm1.Left;
Opt.width := MainForm1.Width;
Opt.height := MainForm1.Height;
AssignFile(Opts,Fn);
try
Rewrite(Opts);
if IOResult = 0 then
begin
write(Opts,Opt);
CloseFile(Opts);
end;
finally
end;
end;{Opt.s}
{------------------------------------------------------------------}
{- Procedure Current Time -}
{- for to fetch system time -}
{------------------------------------------------------------------}
Procedure TMainForm1.Current(var Setting : Date);
var Ti : TDateTime;
S : Variant;
begin
Ti := Now;
With Setting do
begin
Minute := MinuteOfTheHour(Ti);
Hour := HourOfTheDay(Ti);
Day := DayOfTheMonth(Ti);
WeekDay := DayOfTheWeek(Ti);
Month := MonthOf(Ti);
Year := YearOf(Ti);
end;
s := Ti;
end; {Current}
{------------------------------------------------------------------}
{ Thread Communicator }
{ work in parallel }
{ for to sound a result or so }
{------------------------------------------------------------------}
Procedure TMainForm1.Communicator(Tx:String);
var
TH: TMyMorseThread;
begin
if Opt.PlayMorseCodes then begin
if (LastMorseThread=nil) then begin
TH := TMyMorseThread.Create(true);
TH.OnTerminate:=ThreadsDone;
TH.this:=1;
TH.id := TH.ThreadID;
TH.Tx[TH.this] := Tx;
TH.Priority := tpLower;
TH.Resume; // 1. resume = beginn, sonst = weitermachen
end // stoppen mit suspend
else begin
TH := LastMorseThread;
TH.Suspend;
TH.this := (TH.this + 1) mod 12;
TH.Tx[TH.this] := Tx;
TH.Resume
end
end;
end;
{------------------------------------------------------------------}
{ Thread Sounder }
{ work in parallel }
{ for to sound a result or so }
{------------------------------------------------------------------}
procedure TMainForm1.Sound1Click(Sender: TObject);
begin
if Opt.Voice>0 then
Opt.Voice:=0;
Sound1.Visible:=Opt.Voice>0;
end;
Procedure TMainForm1.Sounder(so : TSound);
var
TH: TMySoundThread;
begin
if DoMakeSound and Not SoundPlayed[so] then begin
if LastSoundThread= nil then begin
TH := TMySoundThread.Create(true);
TH.OnTerminate:=ThreadsDone;
LastSoundThread := TH;
TH.ptr:=1; TH.this:=1;
StrPCopy(TH.sf[TH.ptr],Opt.SoundFile[so]);
TH.id := TH.ThreadID;
TH.so := so;
TH.Priority := tpLower;
TH.Resume; // 1. resume = beginn, sonst = weitermachen
end // stoppen mit suspend
else begin
TH := LastSoundThread;
TH.Suspend;
TH.ptr := (TH.ptr + 1) mod 12;
StrPCopy(TH.sf[TH.ptr],Opt.SoundFile[so]);
TH.Resume
end
end;
SoundPlayed[so] := true;
end; {Sounder}
procedure TMainForm1.Speech(SText: String);
begin
if not LastMousePosIn then
Utilities.Speak(Opt.Voicerate,SText);
VoiceSpoken := true;
end; {Sounder}
{------------------------------------------------------------------}
{- Procedure DayofYear -}
{- for to find the number of a Day -}
{------------------------------------------------------------------}
Function TMainForm1.DayofYear(AnyTime:Date) : integer;
Var
Sum : 0 .. 366;
begin
Sum := 0;
if AnyTime.Month > 1 then
Sum := Sum + 31;
if AnyTime.Month > 2 then
begin
Sum := Sum + 28;
if AnyTime.Year mod 4 = 0 then
Sum := Sum + 1;
if AnyTime.Year mod 100 = 0 then
Sum := Sum - 1;
end;
if AnyTime.Month > 3 then
Sum := Sum + 31;
if AnyTime.Month > 4 then
Sum := Sum + 30;
if AnyTime.Month > 5 then
Sum := Sum + 31;
if AnyTime.Month > 6 then
Sum := Sum + 30;
if AnyTime.Month > 7 then
Sum := Sum + 31;
if AnyTime.Month > 8 then
Sum := Sum + 31;
if AnyTime.Month > 9 then
Sum := Sum + 30;
if AnyTime.Month > 10 then
Sum := Sum + 31;
if AnyTime.Month > 11 then
Sum := Sum + 30;
Sum := Sum + AnyTime.Day;
DayofYear := Sum
end;{DayofYear}
{------------------------------------------------------------------}
{- Procedure Convert -}
{- for to Convert the input record -}
{------------------------------------------------------------------}
Procedure TMainForm1.Convert(A : TAppoint;var b : Date);
var i : integer;
begin
b := ThisTime;
if a.Month[1]=' ' then a.Month[1]:='0';
if a.Month[2]=' ' then a.Month[2]:='0';
if a.Day[1]=' ' then a.Day[1]:='0';
if a.Day[2]=' ' then a.Day[2]:='0';
if a.Year[1]=' ' then a.Year[1]:='0';
if a.Year[2]=' ' then a.Year[2]:='0';
if a.Year[3]=' ' then a.Year[3]:='0';
if a.Year[4]=' ' then a.Year[4]:='0';
if (a.Month[1] in ['0','1'])
and (a.Month[2] in ['0' .. '9'])
and (a.Day[1] in ['0' .. '3'])
and (a.Day[2] in ['0' .. '9'])
and (a.Year[1] in [' ','0','1','2'])
and (a.Year[2] in [' ','0' .. '9'])
and (a.Year[3] in [' ','0' .. '9'])
and (a.Year[4] in [' ','0' .. '9']) then
begin
i:= (ord(A.Month[1])-ord('0'))*10+ord(a.Month[2])-ord('0');
b.Month := i;
i:= (ord(A.Day[1])-ord('0'))*10+ord(a.Day[2])-ord('0');
b.Day := i;
i := (ord(a.Year[1]) - ord('0'))*1000
+(ord(a.Year[2]) - ord('0'))*100
+(ord(a.Year[3]) - ord('0'))*10
+(ord(a.Year[4]) - ord('0'));
b.Year := i
end
else
begin
b.Month := ThisTime.Month - 1;
b.Day := ThisTime.Day
end;
end;{Convert}
{------------------------------------------------------------------}
{- Procedure Inspect -}
{- for to search for 'UND' -}
{------------------------------------------------------------------}
Function TMainForm1.Inspect(s:string) : boolean;
var Su : string;
Sl : string;
begin
sl := LowerCase(s);
su := LowerCase(D_UND[Opt.lang]);
inspect := Pos(' '+Su+' ',Sl) > 0
end;{Inspect}
{------------------------------------------------------------------}
{- Procedure Event -}
{- for to announce Events -}
{------------------------------------------------------------------}
function Similar(S1,S2:String):boolean;
var i:integer; Se, Se1, Se2 : set of char; tt:boolean;
begin
S1:=Lowercase(Trim(S1));
S2:=Lowercase(Trim(S2));
tt := S1 = S2;
if not tt then begin
Se1 := [];
for i:=1 to Length(S1) do
Se1 := Se1 + [S1[i]];
tt:= true;
for i:=1 to Length(S2) do
tt := tt and (S2[i] in Se1);
if not tt then begin
Se2 := [];
for i:=1 to Length(S2) do
Se2 := Se2 + [S2[i]];
Se := Se2 - Se1;
Se := Se - [' ','.',';',':'];
tt := Se = [];
end
end;
Similar := tt
end;
{------------------------------------------------------------------}
{- Procedure Event -}
{- for to announce Events -}
{------------------------------------------------------------------}
procedure TMainForm1.SendNote(Who :Char36;YearNum:integer;Typ:Char32;Email:Char36;Ind:integer);
var Tex, St, U:String; Num:String;From, ToId, Von:String;Gw:String;Y:Integer;
begin
From:=Trim(Opt.Email);
if From <>'' then begin
ToId:=Trim(Email);
if ToId <> '' then begin
if YearNum>0 then Num:=Inttostr(Yearnum)+'.' else Num:='';
Von:=' von '+Opt.Vorname+' '+Opt.name;
if Opt.Name='' then Von:='';
if From<>'' then begin
GW := Application.Title+'-'+D_Glueckwunsch[Opt.lang];
Tex:=D_Herzlichen[Opt.lang]+' '+D_Glueckwunsch[Opt.lang]+' '+
D_zum[Opt.lang]+' '+Num+' '+Trim(Typ)+Von+'!';
U:=Uppercase(MidStr(Tex,1,1));
Tex:=U+MidStr(TEx,2,Length(TEx));
if All[Ind].Done[3] in ['0' .. '9']then TryStrToInt(All[Ind].Done,Y) else Y:=0;;
if Y < YearNum then begin
St:=SendMail(SMTP,Opt.SMTPHost,Opt.SMTPUser,Opt.SMTPPassword,
From,ToId, GW, Tex);
if St='' then begin
Y:=YearNum;
All[Ind].Done[1]:=chr(ord('0')+Y div 1000);Y:=Y -(Y div 1000)*1000;
All[Ind].Done[2]:=chr(ord('0')+Y div 100); Y:=Y -(Y div 100)*100;
All[Ind].Done[3]:=chr(ord('0')+Y div 10); Y:=Y -(Y div 10)*10;
All[Ind].Done[4]:=chr(ord('0')+Y);
end
else
ShowMessage(St);
end;
end;
end
end;
end;
{------------------------------------------------------------------}
{- Procedure Event -}
{- for to announce Events -}
{------------------------------------------------------------------}
procedure TMainForm1.Event(Ind:integer;Diff : integer);
Var
Who :Char36;
Typ:Char32;
Wish:Char36;
Month:Char2;
Day:Char2;
Year:Char4;
BC:Char;
Email:Char36;
Plural, DoUnderline, VeryImportant : boolean;
YearNum : integer;
Subject, Predicate, Events, Temporal, Additional, Sentence : String;
st,sl,sw,swl,l : integer; Sim : boolean;
begin
Who:=All[Ind].Who;
Typ:=All[Ind].Typ;
Wish:=All[Ind].Wish;
Month:=All[Ind].Month;
Day:=All[Ind].Day;
Year:=All[Ind].Year;
BC:=All[Ind].BC;
Email:=All[Ind].Email;
EventFound := true;
LastWho := Who;
l:=1;
while l<=nolanguages do begin
if similar(Trim(Typ),D_Geburtstag[l]) then begin
StrCopy(@Typ,PChar(D_Geburtstag[opt.lang]));l:=langmax+1;end
else if similar(Trim(Typ),D_Hochzeitstag[l]) then begin
StrCopy(@Typ,PChar(D_Hochzeitstag[opt.lang]));l:=langmax+1;end
else if similar(Trim(Typ),D_Namenstag[l]) then begin
StrCopy(@Typ,PChar(D_Namenstag[opt.lang]));l:=langmax+1;end
else if similar(Trim(Typ),D_Jubilaeum[l]) then begin
StrCopy(@Typ,PChar(D_Jubilaeum[opt.lang]));l:=langmax+1;end;
l:=l+1
end;
DoUnderline := false;
VeryImportant := false;
Subject := Trim(Who);
Plural := Inspect(Trim(Who));
YearNum := StrToInt(StringReplace(Year,' ', '0',[rfReplaceAll ]));
if (BC=' ') or (BC='') then
YearNum := ThisTime.Year - YearNum
else
YearNum := ThisTime.Year + YearNum;
if YearNum = 1 then
Events := StringReplace(Events,'%a', D_Ersten[Opt.lang],[rfReplaceAll ])
else if YearNum = 2 then
Events := StringReplace(Events,'%a', D_Zweiten[Opt.lang],[rfReplaceAll ])
else if YearNum = 3 then
Events := StringReplace(Events,'%a', D_Dritten[Opt.lang],[rfReplaceAll ])
else begin
if (Year = '0000') or (Year = ' ') or (YearNum = 0) then begin
Events := StringReplace(Events,'%a', '',[rfReplaceAll ])
end else begin
Events := D_40th[Opt.lang];
VeryImportant:=Yearnum mod 10 = 0;
Events := StringReplace(Events,'%a', inttostr(YearNum),[rfReplaceAll ])
end
end;
if (Year[1] <> ' ') and (Year[4] <> ' ') then Events := Events + ' ' + Trim(Typ)
else Events := Trim(Typ);
if Diff > 0 then
begin
if Plural then Predicate := D_werdenhaben[Opt.lang]
else Predicate := D_wirdhaben[Opt.lang];
if Diff = 1 then begin
Temporal := D_MORGEN[Opt.lang];
Sounder(DingDong)
end
else begin
Temporal := StringReplace(D_In[Opt.lang],'%t',inttostr(abs(Diff)),[rfReplaceAll ]);
Sounder(Ding)
end;
end;
// Birthday or Similar
if Diff = 0 then begin
if Plural then Predicate := D_HABEN[Opt.lang]
else Predicate := D_HAT[Opt.lang];
Temporal := D_Heute[Opt.lang];
Sim := false;
for l := 1 to langmax do
Sim := Sim or Similar(Trim(Typ),D_Geburtstag[l]);
SendNote(Who,YearNum,Typ,EMail,Ind);
if Sim then begin
DoUnderline := true;
Sounder(HappyBirthday)
end else
Sounder(SongofJoy);
end;
if Diff < 0 then begin
if Plural then Predicate := D_Hatten[Opt.lang]
else Predicate := D_Hatte[Opt.lang];
if abs(Diff) = 1 then Temporal := D_Gestern[Opt.lang]
else Temporal := StringReplace(D_vor[Opt.lang],'%t',inttostr(abs(Diff)),[rfReplaceAll ]);
end;
Additional := '';
if (Trim(Wish) > ' ') then begin
additional := additional +' '+Trim(Wish)
end;
Sentence := D_Syntax[Opt.lang];
Sentence := StringReplace(Sentence,'%s',Subject,[rfReplaceAll ]);
Sentence := StringReplace(Sentence,'%p',Predicate,[rfReplaceAll ]);
Sentence := StringReplace(Sentence,'%e',Events,[rfReplaceAll ]);
Sentence := StringReplace(Sentence,'%t',Temporal,[rfReplaceAll ]);
Sentence := StringReplace(Sentence,'%a',Additional,[rfReplaceAll ]);
if (All[Ind].Done[3] in ['0' .. '9']) or (All[Ind].Done[2] in ['0' .. '9'])then
Sentence:=Sentence+'(@)';
Sentence := Sentence + '.';
Sentence[1] := UpCase(Sentence[1]);
Speech(Sentence);
Communicator(Sentence);
//mark beginnings
st := Length(ereignisse.Lines.GetText);
sl := Length(Sentence);
sw := Pos(Subject,Sentence) - 1;
swl := Length(Subject);
//copy to editor
Clipboard.AsText := Sentence;
Ereignisse.PasteFromClipboard;
ereignisse.SelStart := st;
ereignisse.SelLength := sl;
Ereignisse.SelAttributes.Color := clBlack;
if DoUnderline then
Ereignisse.SelAttributes.Style := Ereignisse.SelAttributes.Style + [fsUnderline];
if VeryImportant then
Ereignisse.SelAttributes.Size := Ereignisse.SelAttributes.Size + 2
else
Ereignisse.SelAttributes.Size := Opt.FontSize;
ereignisse.SelStart := st+sw;
ereignisse.SelLength := swl;
Ereignisse.SelAttributes.Color := clGreen;
ereignisse.SelStart := st+sl;
Clipboard.AsText := crlf;
Ereignisse.PasteFromClipboard;
Ereignisse.SelAttributes.Style := opt.FontStyles;
end;{Event}
{------------------------------------------------------------------}
{- Procedure GetEvents -}
{- for to look up Events -}
{------------------------------------------------------------------}
Procedure TMainForm1.GetEvents(Datei:String;Remote:Char2);
Type
TRecord = record
case boolean of
true : (a : LAppoint);
false: (c: record
b : TAppoint;
end);
end;
Var
Trec : TRecord;
Diff : integer;
Goal : Date;
YearDays : integer;
S : String;Errors:boolean;
procedure addeventtype;
var i,n:integer;found:boolean;
begin
i:=1;found := false;n:=1;
while ((i<=32) and (not found)) do begin
if eventtypes[i]='' then begin n := i; found := true end;
i:=i+1;
end;
found:=false;
for i:=1 to n do
if EventTypes[i]=All[AllCount].Typ then
found := true;
if not found and (n<32) then begin
EventTypes[n] := all[allcount].typ;
end
end;
begin
EventFound := false; Errors:=false;
if FileExists(Datei) then begin
AssignFile(Events,Datei);
try
Reset(Events);
finally
end;
if IOResult = 0 then
begin
TRec.c.b.Month := Blank2;
TRec.c.b.Day := Blank2;
TRec.c.b.Year := Blank4;
TREc.c.b.Typ := Blank32;
TRec.c.b.Who := Blank36;
TRec.c.b.Wish := Blank36;
TRec.c.b.Picture := Blank120;
TRec.c.b.Remote := Blank2;
TRec.c.b.Done := Blank4;
TRec.c.b.Repeats := Blank28;
TRec.c.b.Email := Blank36;
while not Eof(Events) and not Errors do
begin
try
Readln(Events,TRec.a);
finally
if TRec.c.b.repeats[1]<>' ' then
ShouldPutEvents:=true;
end;
Convert(TRec.c.b,Goal);
AllCount := AllCount + 1;
if Allcount > AllCountMax then begin
S := D_OutofMem[Opt.lang] +' >'
+InttoStr(AllcountMax)+
' '+D_Ereignis[Opt.lang];
ShowMessage(S);Errors:=true;
end;
All[AllCount] := TRec.c.b;
All[AllCount].Remote := Remote;
AddeventType;
Goal.Year := ThisTime.Year;
YearDays := 365;
if (ThisTime.Year mod 4 = 0)
and not (ThisTime.Year mod 100 = 0) then
YearDays := 366;
Diff := DayofYear(Goal)-DayofYear(ThisTime);
if abs(Diff) > YearDays-opt.alarmzeit-1 then
Diff := abs(Diff) - YearDays;
if abs(Diff) <= opt.alarmzeit then
Event(AllCount, Diff);
TRec.c.b.Month := Blank2;
TRec.c.b.Day := Blank2;
TRec.c.b.Year := Blank4;
TREc.c.b.Typ := Blank32;
TRec.c.b.Who := Blank36;
TRec.c.b.Wish := Blank36;
TRec.c.b.Picture := Blank120;
TRec.c.b.Remote := Blank2;
TRec.c.b.Done := Blank4;
TRec.c.b.Repeats := Blank28;
TRec.c.b.Email := Blank36;
TRec.c.b.Remote := Remote;
end;
CloseFile(Events)
end;
end;
if (AllCount=0) or (IOResult<>0) then begin
// make at least one event
AllCount := 1;
All[1].Month := '05';
All[1].Day := '01';
All[1].Year := '1949';
strpcopy(@All[1].Typ,D_Firstof[Opt.lang]);
strpcopy(@All[1].Who,D_Everyone[Opt.lang]);
strpcopy(@All[1].Wish,D_WantsFree[Opt.lang]);
All[1].Picture := '';
All[1].Remote := RemoteMark;
PutAllEvents;
end;
end;{GetEvents}
{------------------------------------------------------------------}
{- Procedure PutEvents -}
{- save Events -}
{------------------------------------------------------------------}
Procedure TMainForm1.PutEvents(Datei:String; RM:Char2);
const eoln=chr(13)+chr(10);
type pmem=^mem;
mem=array[0..512] of char;
Var
i,j,k:integer;
S:String;pch:pmem;
Eout:Textfile;
begin
if Fileexists(Datei) then DeleteFile(PChar(Datei));
AssignFile (Eout,Datei);
try
Rewrite(Eout);
for i:=1 to Allcount do begin
if All[i].Remote = RM then begin
S:='';
Pch:=@All[i];k:=sizeof(All[i])-1;
for j:=0 to k do
begin
Write(Eout,Pch^[j]);
end;
Writeln(Eout);
end
end;
CloseFile(Eout);
finally
end;
end;{PutEvents}
{------------------------------------------------------------------}
{- Procedure Fill List -}
{- fill ListView from All -}
{------------------------------------------------------------------}
Procedure TMainForm1.FillList;
var
I: Integer;
ListItem: TListItem;
begin
with ListView1 do
begin
Parent := Self;
Align := alClient;
ViewStyle := vsReport;
Listview1.Columns[0].Caption := '';
Listview1.Columns[1].Caption := D_Netzwerk[Opt.lang];
Listview1.Columns[2].Caption := D_Month[Opt.lang];
Listview1.Columns[3].Caption := D_Day[Opt.lang];
Listview1.Columns[4].Caption := D_Year[Opt.lang];
Listview1.Columns[5].Caption := D_Who[Opt.lang];
Listview1.Columns[6].Caption := D_Typ[Opt.lang];
Listview1.Columns[7].Caption := D_Wish[Opt.lang];
Listview1.Columns[8].Caption := D_Picture[Opt.lang];
Listview1.Columns[9].Caption := D_Email[Opt.lang];
Items.Clear;
for I := 1 to AllCount do
begin
ListItem := Items.Add;
ListItem.Caption:=' '; // first column
if All[i].Remote=' ' then
ListItem.SubItems.Add(' ')
else
ListItem.SubItems.Add('*');
ListItem.SubItems.Add(All[I].Month);
ListItem.SubItems.Add(All[I].Day);
ListItem.SubItems.Add(trim(All[i].BC+All[I].Year));
ListItem.SubItems.Add(All[I].Who);
ListItem.SubItems.Add(All[I].Typ);
ListItem.SubItems.Add(All[I].Wish);
ListItem.SubItems.Add(All[I].Picture);
ListItem.SubItems.Add(All[I].Email);
end;
end;
ListView1.ItemFocused := ListView1.Items[1]
end;
{------------------------------------------------------------------}
{- procedure Greetings -}
{- for to produce greetings -}
{------------------------------------------------------------------}
procedure TMainForm1.Greetings;
var S1, S2, S3 : String;
begin
With ThisTime do
begin
if Hour < 12 then
Greeting := D_GutenMorgen[Opt.lang]
else if Hour < 18 then
Greeting := D_GutenTag[Opt.lang]
else
Greeting := D_GutenAbend[Opt.lang]+' ';
Greeting[1] := UpCase(Greeting[1]);
S1 := Greeting;
S3 := D_DFormats[Opt.lang];
case Day of
1: S3 := StringReplace(S3,'%d', D_Erste[opt.lang],[rfReplaceAll ]);
2: S3 := StringReplace(S3,'%d', D_Zweite[opt.lang],[rfReplaceAll ]);
3: S3 := StringReplace(S3,'%d', D_Dritte[opt.lang],[rfReplaceAll ])
else
S3 := StringReplace(S3,'%d', inttostr(Day),[rfReplaceAll ])
end
;
S3 := StringReplace(S3,'%m', D_Months[Opt.lang,Month],[rfReplaceAll ]);
S3 := StringReplace(S3,'%y', inttostr(Year),[rfReplaceAll ]);
S1 := S1 + ', '+D_Heute[Opt.lang]+' '+D_Ist[Opt.lang]+' '+
D_Days[Opt.lang,WeekDay-1]+' ';
S1 := S1 + S3+'.';
S2 := D_Jetztist[Opt.lang]+' ';
S2[1] := UpCase(S2[1]);
if Hour = 1 then
S2 := S2 + D_Ein[Opt.lang]+' '
else
S2 := S2 +inttostr(Hour);
S2 := S2 + ' '+D_Uhr[Opt.lang]+' ';
if Minute <> 0 then
S2 := S2 + inttostr(Minute)+'.'
else
S2 := S2 +'.';
end;
Speech(S1);
Speech(S2);
//clear previous lines
Ereignisse.SelectAll;
Ereignisse.DefAttributes.Color := clRed;
Ereignisse.CutToClipboard;
//copy to editor
Clipboard.AsText := S1+crlf+S2+crlf+crlf;
ereignisse.SelStart :=0;
Ereignisse.PasteFromClipboard;
end; {Greetings}
{------------------------------------------------------------------}
{- GetLanguages -}
{------------------------------------------------------------------}
procedure TMainForm1.GetLanguages;
begin
LangsDir := readl;
IOLanguages
end;
{------------------------------------------------------------------}
{- GetLanguages -}
{------------------------------------------------------------------}
procedure TMainForm1.PutLanguages;
begin
LangsDir := writel;
IOLanguages
end;
{------------------------------------------------------------------}
{- GetLanguages -}
{------------------------------------------------------------------}
procedure TMainForm1.IOLanguages;
var
S,St : String;
lnr, current,m,d,ind,lind : integer;
procedure Check(var S:String);
begin
try
if Langsdir=readl then begin
readln(Langs,S);
S:=Trim(S);
end
else
writeln(Langs,S);
finally
end;
if (IOResult >= 0) and (S > '') then begin
lnr :=lnr+1;
Str(lnr,St);
if (Langsdir=readl) and not ((Pos('<',S)>0) and (Pos('>',S)>0)) then
raise EFileInvalid.Create(St+D_Incorrect[Opt.lang]+S)
end
else
raise EFileInvalid.Create(St+D_Incorrect[Opt.lang]+S);
end ;
procedure RWs(var S:String);
var T:String;C:Char;
begin
if Langsdir=writel then begin
T:=Tokens.Keys[ind];
C:=T[Length(T)];
if C='>' then
T:=T+'.'+inttostr(lind);
S:=Tokens.Cells[1,ind];
end;
Check(T);
try
If Langsdir=readl then readln(Langs,S) else writeln(Langs,S);
finally
end;
S:=Trim(S);
if (IOResult >= 0) then begin
lnr :=lnr + 1;
St := S;
Str(lnr,St);
if Pos('<',S) > 0 then
raise EFileInvalid.Create(St+D_Incorrect[Opt.lang]+S);
// insert to value editor
if (Langsdir=readl) then
Tokens.InsertRow(T,S,true);
ind := ind+1;
lind:=lind+1;
end;
end ;
begin
ind:=1;lind:=0;
Tokens.TitleCaptions[0]:=D_Lexem[Opt.lang];
Tokens.TitleCaptions[1]:=D_Wertinakt[Opt.lang];
AssignFile (Langs,Opt.ProgramDir+SprachDatei);
try
if LangsDir=readl then
Reset(Langs)
else begin
Rewrite(Langs);
end;
finally
end;
lnr:= 1;
S:=inttostr(nolanguages);
RWs(S);
TryStrToInt(S,nolanguages);
if nolanguages > langmax then
raise EFileInvalid.Create(D_TooMany[Opt.lang]);
for current := 1 to nolanguages do
begin
lind := 1;
RWs(D_Langs[current]);
RWs(D_Foreign[current]);
RWs(D_DFormats[current]);
RWs(D_Syntax[current]);
RWs(D_40th[current]);
for m:=1 to 12 do begin
if langsdir=writel then S := D_Months[current,m] else s:='';
RWs(S);
if langsdir=readl then
D_Months[current,m] := S;
end;
for d:=0 to 6 do begin
if langsdir=writel then S := D_Days[current,d] else s:='';
RWs(S);
if langsdir=readl then
D_Days[current,d] := S;
end;
RWs(D_Geburtstagskalender[current]);
RWs(D_GutenMorgen[current]);
RWs(D_GutenAbend[current]);
RWs(D_GutenTag[current]);
RWs(D_Jetztist[current]);
RWs(D_Und[current]);
RWs(D_Hat[current]);
RWs(D_Haben[current]);
RWs(D_Hatte[current]);
RWs(D_Hatten[current]);
RWs(D_wirdhaben[current]);
RWs(D_werdenhaben[current]);
RWs(D_Gestern[current]);
RWs(D_Heute[current]);
RWs(D_Morgen[current]);
RWs(D_In[current]);
RWs(D_Vor[current]);
RWs(D_Ereignis[current]);
RWs(D_Geburtstag[current]);
RWs(D_Hochzeitstag[current]);
RWs(D_Namenstag[current]);
RWs(D_Jubilaeum[current]);
RWs(D_Ersten[current]);
RWs(D_Zweiten[current]);
RWs(D_Dritten[current]);
RWs(D_Ist[current]);
RWs(D_Erste[current]);
RWs(D_Zweite[current]);
RWs(D_Dritte[current]);
RWs(D_Ein[current]);
RWs(D_Uhr[current]);
RWs(D_Stehtan[current]);
RWs(D_Wirklich[current]);
RWs(D_Geaendert[current]);
RWs(D_Status[current]);
RWs(D_Neu[current]);
RWs(D_Aendern[current]);
RWs(D_Sichern[current]);
RWs(D_Loeschen[current]);
RWs(D_Exportieren[current]);
RWs(D_Importieren[current]);
RWs(D_Drucken[current]);
RWs(D_Ende[current]);
RWs(D_Optionen[current]);
RWs(D_Sprache[current]);
RWs(D_Alarmzeit[current]);
RWs(D_Font[current]);
RWs(D_Hilfe[current]);
RWs(D_Ueber[current]);
RWs(D_Wunschzeit[current]);
RWs(D_Wunschsprache[current]);
RWs(D_Wuenschtsich[current]);
RWs(D_Wuenschensich[current]);
RWs(D_Am[current]);
RWs(D_OK[current]);
RWs(D_Finde[current]);
RWs(D_Abbrechen[current]);
RWs(D_Einfuegen[current]);
RWs(D_setzeSprecher[current]);
RWs(D_leise[current]);
RWs(D_Sprecher[current]);
RWs(D_Sprachausgabe[current]);
RWs(D_Klaenge[current]);
RWs(D_setzeFett[current]);
RWs(D_setzeSchrift[current]);
RWs(D_setzeGroesse[current]);
RWs(D_setzeItalic[current]);
RWs(D_setzeUnterstrichen[current]);
RWs(D_aendereEreignis[current]);
RWs(D_Ereignissedrucken[current]);
RWs(D_loescheEreignis[current]);
RWs(D_neuesEreignis[current]);
RWs(D_setzeSprache[current]);
RWs(D_Warum[current]);
RWs(D_ListEdit[current]);
RWs(D_LangEdit[current]);
RWs(D_Lexem[current]);
RWs(D_Wertinakt[current]);
RWs(D_Month[current]);
RWs(D_Day[current]);
RWs(D_Year[current]);
RWs(D_Who[current]);
RWs(D_Typ[current]);
RWs(D_Wish[current]);
RWs(D_Picture[current]);
RWs(D_Select[current]);
RWs(D_Emaileingeben[current]);
RWs(D_PrintHead[current]);
RWs(D_OutofMem[current]);
RWs(D_Firstof[current]);
RWs(D_Everyone[current]);
RWs(D_WantsFree[current]);
RWs(D_Incorrect[current]);
RWs(D_TooMany[current]);
RWs(S);strpcopy(@D_NotImpl[current],S);
RWs(S);strpcopy(@D_Parameter[current],S);
RWs(D_SoundFiles[current]);
RWs(D_SprachTexte[current]);
RWs(D_EndeZeit[current]);
RWs(D_Warnemich[current]);
RWs(D_Geschwindigkeit[current]);
RWs(D_SprecherTest[current]);
RWs(D_UhrzeitStart[current]);
RWs(D_Spende[current]);
RWs(D_SehrGut[current]);
RWs(D_Gut[current]);
RWs(D_Befriedigend[current]);
RWs(D_Ausreichend[current]);
RWs(D_Schlecht[current]);
RWs(D_SehrSchlecht[current]);
RWs(D_Name[current]);
RWs(D_Vorname[current]);
RWs(D_Urteil[current]);
RWs(D_Kommentar[current]);
RWs(D_Senden[current]);
RWs(D_Abbruch[current]);
RWs(D_Email[current]);
RWs(D_NoInternet[current]);
RWs(D_Lizenz[current]);
RWs(D_Herzlichen[current]);
RWs(D_Glueckwunsch[current]);
RWs(D_von[current]);
RWs(D_zum[current]);
RWs(D_Netzwerk[current]);
RWs(D_Verzeichnis[current]);
RWs(D_Uebertragen[current]);
RWs(D_Server[current]);
RWs(D_User[current]);
RWs(D_Passwort[current]);
RWs(D_Feedback[current]);
RWs(D_Postamt[current]);
RWs(D_SendeMorse[current]);
RWs(D_Filler4[current]);
RWs(D_Filler5[current]);
RWs(D_Filler6[current]);
RWs(D_Filler7[current]);
RWs(D_Filler8[current]);
RWs(D_Filler9[current]);
RWs(D_Filler10[current]);
RWs(D_Filler11[current]);
end;
if (LangsDir=readl) and not eof(Langs) then
raise EFileInvalid.Create(D_Incorrect[Opt.lang]) ;
CloseFile(Langs);
end;
{------------------------------------------------------------------}
{- Delphi generated procedures -}
{------------------------------------------------------------------}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
procedure TMainForm1.GetFontNames;
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
ReleaseDC(0, DC);
end;
{ Event Handlers }
procedure TMainForm1.ForeignLocale;
const
ENGLISH = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
GERMAN = (SUBLANG_GERMAN shl 10) or LANG_GERMAN;
FRENCH = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
SPANISH = (SUBLANG_SPANISH shl 10) or LANG_SPANISH;
ITALIAN = (SUBLANG_ITALIAN shl 10) or LANG_ITALIAN;
PORTUGAIS = 1046;
begin
if Opt.lang = 0 then
case SysLocale.DefaultLCID of
SPANISH: Opt.lang := 5;
ENGLISH: Opt.lang := 2;
FRENCH: Opt.lang := 3;
GERMAN: Opt.lang := 2;
ITALIAN: Opt.lang := 4;
PORTUGAIS: Opt.lang := 6;
else Opt.lang := 1;
end;
GetFormatSettings;
if D_Foreign[opt.lang] = 'fareast' then SysLocale.FarEast := true;
if D_Foreign[opt.lang] = 'middleeast' then SysLocale.MiddleEast := true;
if Screen.Imes.Count>0 then Ereignisse.ImeName := Screen.Imes[0];
end;
procedure TMainForm1.NetzwerkClick(Sender: TObject);
begin
Opt.EditCommon := not Opt.EditCommon;
Netzwerk.Checked := Opt.EditCommon;
if Opt.EditCommon and (Opt.CommonDir='') then Verzeichnis1Click(Sender);
if Opt.EditCommon then RemoteMark := CommonEvent else RemoteMark := LocalEvent;
end;
Procedure TMainForm1.GetAgendaDirectories;
var Drive:String;
begin
Opt.LocalDir := GetEnvironmentVariable('Userprofile')+ '\' + AppName + '\';
if not DirectoryExists(ExtractFileDir(Opt.LocalDir)) then
if not CreateDir(ExtractFileDir(Opt.LocalDir)) then begin
showmessage('Cannot create Home Directory');
ExitProcess(55)
end;
if Not DirectoryExists(Opt.LocalDir) then begin
Opt.LocalDir := GetEnvironmentVariable('Homedir')+ '\';
end;
if not DirectoryExists(ExtractFileDir(Opt.LocalDir)) then
if not CreateDir(ExtractFileDir(Opt.LocalDir)) then begin
showmessage('Cannot create Home Directory');
ExitProcess(55)
end;
if Not DirectoryExists(Opt.LocalDir) then begin
Opt.LocalDir := 'C:' + '\';
end;
if not DirectoryExists(ExtractFileDir(Opt.LocalDir)) then
if not CreateDir(ExtractFileDir(Opt.LocalDir)) then begin
showmessage('Cannot create Home Directory');
ExitProcess(55)
end;
// compatibility with old version
Drive := ExtractFileDrive(Opt.ProgramDir);
case GetDriveType(PChar(Drive)) of { une valeur positive indique un lecteur correct }
DRIVE_REMOVABLE: opt.EditCommon:=true;
DRIVE_FIXED: ;
DRIVE_CDROM: ;
DRIVE_RAMDISK: ;
DRIVE_REMOTE: opt.EditCommon:=true;
end;
Opt.CommonDir := '';
end;
function move(var a:array of char):String;
var i,m:integer;
S:String;
begin
m := length(a)-1;
S:='';
for i:=0 to m do
S := S + a[i];
move := S
end;
procedure TMainForm1.PrintEventFile(Sender: TObject);
var
i:integer;
procedure Insert;
begin
ereignisse.SelStart := ereignisse.SelStart+length(Clipboard.AsText);
ereignisse.PasteFromClipboard;
ereignisse.SelStart := ereignisse.SelStart;
Ereignisse.SelLength := Length(Clipboard.AsText);
end;
begin
if PrintDialog.Execute then begin
Clipboard.Clear;
Ereignisse.Clear;
Ereignisse.SelAttributes.Name := 'FixedSys';
Ereignisse.DefAttributes.Name := 'FixedSys';
Ereignisse.SelAttributes.Color := Opt.FontColor;
Ereignisse.SelAttributes.Style := opt.FontStyles;
Clipboard.AsText := D_PrintHead[Opt.lang]+Crlf;
Insert;
Clipboard.AsText :=
'----------------------------------------------'
+'----------------------------------------------'
+'------------------- '+Crlf;
Insert;
for i:=1 to AllCount do
begin
Clipboard.AsText := All[i].Month+'/'+All[i].Day+' ';
Insert;
Clipboard.AsText := All[i].Year+' ';
insert;
Ereignisse.DefAttributes.Color := clGreen;
Clipboard.AsText := All[i].Who;
insert;
Ereignisse.DefAttributes.Color := clBlack;
Clipboard.AsText := All[i].Typ+' '+All[i].Wish+crlf;
insert;
end;
Ereignisse.Print(D_Stehtan[Opt.lang]);
Ereignisse.Clear;
Clipboard.Clear;
FormPaint(Sender);
end
end;
procedure TMainForm1.FileExit(Sender: TObject);
begin
Close;
end;
procedure TMainForm1.EditUndo(Sender: TObject);
begin
with Ereignisse do
if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;
procedure TMainForm1.EditCut(Sender: TObject);
begin
Ereignisse.CutToClipboard;
end;
procedure TMainForm1.EditCopy(Sender: TObject);
begin
Ereignisse.CopyToClipboard;
end;
procedure TMainForm1.EditPaste(Sender: TObject);
begin
Ereignisse.PasteFromClipboard;
end;
procedure TMainForm1.HelpAbout(Sender: TObject);
begin
AboutBox := TAboutBox.Create(Self);
with AboutBox do
try
AboutBox.Label1.Caption := AppName+' '+Version+' '+SubVersion;
AboutBox.Caption := D_Ueber[Opt.lang];
AboutBox.OKButton.Caption := D_OK[Opt.lang];
// kill timer meanwhile
StopTimer(sender);
ShowModal;
finally
StartTimer(Sender)
end;
AboutBox.Destroy;
end;
procedure TMainForm1.FontChange(Sender: TObject);
begin
tokens.Visible := false;
ListView1.Visible := false;
Ereignisse.Visible := true;
if (Sender=FontSize) then begin
// Name and Size of Font
// Achtung: Fehler in Delphi 7 ?????
if strtoint(Fontsize.text) <> opt.FontSize then begin
if Fontsize.Text > '0' then begin
opt.FontSize := strtoint(FontSize.Text);
ereignisse.DefAttributes.Size := strtoint(fontsize.Text)
end;
end
end
else if sender=fontname then begin
Ereignisse.DefAttributes.Name := FontName.Items[FontName.ItemIndex];
Opt.Fontname := FontName.Items[FontName.ItemIndex];
end
else begin
if UnderlineButton.Down then Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style + [fsUnderline]
else Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style - [fsUnderline];
if BoldButton.Down then Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style + [fsBold]
else Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style - [fsBold];
if ItalicButton.Down then Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style + [fsItalic]
else Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style - [fsItalic];
Opt.fontStyles := ereignisse.DefAttributes.Style;
end;
end;
procedure TMainForm1.LanguageChange(Sender: TObject);
var i:integer;
begin
for i:=1 to nolanguages do
if LanguageBox.Items [LanguageBox.ItemIndex] = D_Langs[i] then
Opt.lang := i;
MenuLanguageChange(Sender);
Repaint;
Opt.lang := LanguageBox.ItemIndex +1;
FormPaint(Sender);
end;
procedure TMainForm1.MenuLanguageChange(Sender: TObject);
begin
MainForm1.Caption := Application.Title;
FileMenu.Caption := D_Ereignis[Opt.lang];
EventNewItem.Caption := D_Neu[Opt.lang];
EventChangeItem.Caption := D_Aendern[Opt.lang];
EventDeleteItem.Caption := D_Loeschen[Opt.lang];
PrintEvents.Caption := D_Drucken[Opt.lang]+ ' ' + D_Ereignis[Opt.lang];
PrintAllEvents.Caption := D_EreignisseDrucken[Opt.lang];
EventExitItem.Caption := D_Ende[Opt.lang];
Editmenu.Caption := D_Optionen[Opt.lang];
Language.Caption := D_Sprache[Opt.lang];
Alarmzeit.Caption := D_Alarmzeit[Opt.lang];
Sprachausgabe2.Caption := D_Sprachausgabe[Opt.lang];
Klnge1.Caption := D_Klaenge[Opt.lang];
MiEditFont.Caption := D_Font[Opt.lang];
HelpMenu.Caption := D_Hilfe[Opt.lang];
Hilfe1.Caption := D_Hilfe[Opt.lang];
DonateItem.Caption := D_Spende[Opt.lang];
HelpAboutItem.Caption := D_Ueber[Opt.lang];
Netzwerk.Caption := D_Netzwerk[Opt.lang];
Verzeichnis.Caption := D_Verzeichnis[Opt.lang];
Postamt.Caption := D_Postamt[Opt.lang];
BoldButton.Hint := D_setzeFett[Opt.lang];
FontName.Hint := D_setzeSchrift[Opt.lang];
FontSize.Hint := D_setzeGroesse[Opt.lang];
ItalicButton.Hint := D_setzeItalic[Opt.lang];
UnderlineButton.Hint := D_setzeUnterstrichen[Opt.lang];
ButtonChange.Hint := D_aendereEreignis[Opt.lang];
PrintButton.Hint := D_Drucken[Opt.lang]+' '+D_Ereignis[Opt.lang];
ButtonDelete.Hint := D_loescheEreignis[Opt.lang];
ButtonNew.Hint := D_neuesEreignis[Opt.lang];
LanguageBox.Hint := D_setzeSprache[Opt.lang];
VoiceBox.Hint := D_setzeSprecher[Opt.lang];
Utilities.EnumVoices(Opt.Voice,D_Leise[Opt.lang],VoiceBox);
Sprachtextendern1.Caption := D_SprachTexte[Opt.lang];
end;
procedure TMainForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var SaveResp:integer;
begin
if ShouldPutEvents then
PutAllEvents;
PutOptions;
CanClose := true;
if Opt.WarnMe then begin
SaveResp := MessageBox(WindowHandle,
PChar(D_Stehtan[Opt.lang]),
PChar(Application.title),
MB_YESNO);
case SaveResp of
IDYES : Canclose := true;
IDNO : begin
Canclose := false;
StartTimer(Sender);
LastMouseTime := Now
end
else
CanClose := false
end;
end
else if (Mouse.CursorPos.y >= MainForm1.Top+50)
and (Mouse.CursorPos.y <= MainForm1.Top+MainForm1.Height)
and (Mouse.CursorPos.x >= MainForm1.left)
and (Mouse.CursorPos.x <= MainForm1.left+MainForm1.Width) then
CanClose := false;
if CanClose then begin
if LastMorseThread<>nil then LastMorseThread.Terminate;
if LastSoundThread<>nil then LastSoundThread.Terminate;
if LastVoiceThread<>nil then LastVoiceThread.Terminate;
if Timer1<>nil then Timer1.Enabled:=false;
end;
end;
{ Ruler Indent Dragging }
procedure TMainForm1.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragOfs := (TLabel(Sender).Width div 2);
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
FDragging := True;
end;
procedure TMainForm1.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FDragging then
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs
end;
procedure TMainForm1.FormShow(Sender: TObject);
var i:integer;
begin
// wird nur bei just started aufgerufen ?
//acoustical part
for i:=1 to nolanguages do
if D_Langs[i] > ' ' then
LanguageBox.Items.Add(D_Langs[i]);
LanguageBox.ItemIndex := opt.lang-1;
MenuLanguageChange(sender);
// set itemindex and size
Fontname.Text := opt.Fontname;
UpDown1.Position := opt.FontSize;
FontSize.Text := inttostr(opt.FontSize);
//check buttons
if fsUnderline in opt.fontstyles then UnderlineButton.Down := true;
if fsBold in opt.fontstyles then BoldButton.down := true;
if fsItalic in opt.fontstyles then ItalicButton.down := true;
tokens.Visible := false;
ListView1.Visible := false;
Ereignisse.Visible := true;
Ereignisse.font.Color := opt.FontColor;
Ereignisse.font.name := opt.Fontname;
Ereignisse.font.size := opt.FontSize;
Ereignisse.font.Style := opt.FontStyles;
Ereignisse.DefAttributes.Color := opt.FontColor;
Ereignisse.DefAttributes.name := opt.Fontname;
Ereignisse.DefAttributes.size := opt.FontSize;
Ereignisse.DefAttributes.Style := opt.FontStyles;
FontName.OnChange := FontChange;
FontSize.OnChange := FontChange;
end;
procedure TMainForm1.AlarmzeitClick(Sender: TObject);
var S : String;
DV, DN : integer;
begin
AlertBox := TAlertBox.Create(Self);
AlertBox.Caption := D_Alarmzeit[Opt.lang];
AlertBox.OKButton1.Caption := D_OK[Opt.lang];
AlertBox.Alarmzeit.Caption := D_Wunschzeit[Opt.lang];
AlertBox.Label1.Caption := D_EndeZeit[Opt.lang];
AlertBox.CheckBox1.Caption := D_Warnemich[Opt.lang];
AlertBox.Alerttime.Text := IntToStr(opt.alarmzeit);
DV := Opt.alarmzeit;
AlertBox.Waittimer.Text := inttostr(Opt.Waittime);
Alertbox.CheckBox1.checked := Opt.WarnMe;
AlertBox.Label2.Caption := D_UhrZeitStart[Opt.lang];
AlertBox.WakeTime.Text := inttostr(Opt.WakeTime);
// kill timer meanwhile
StopTimer(sender);
AlertBox.ShowModal;
StartTimer(Sender);
TryStrtoint(AlertBox.WakeTime.Text,Opt.WakeTime);
TryStrtoint(AlertBox.Waittimer.Text,Opt.Waittime);
Opt.WarnMe := ALertBox.CheckBox1.Checked;
S := AlertBox.Alerttime.Text;
DN := StrToInt(S);
if not (DV = DN) and (0 <= DN) and (DN <= 365) then
opt.alarmzeit := DN;
Opt.alarmzeit := Opt.alarmzeit;
AlertBox.Destroy;
//MakeAT;
FormPaint(Sender);
end;
procedure TMainForm1.LanguageClick(Sender: TObject);
var i : integer;
begin
LangBox := TLangBox.Create(Self);
LangBox.Caption := D_Sprache[Opt.lang];
LangBox.Copyright.Caption := D_Wunschsprache[Opt.lang];
LangBox.OKButton.Caption := D_OK[opt.lang];
for i:=1 to nolanguages do
if D_Langs[i] > '' then
LangBox.LanguageBox.Items.Add(D_Langs[i]);
LangBox.LanguageBox.ItemIndex := Opt.lang -1;
// kill timer meanwhile
StopTimer(sender);
LangBox.ShowModal;
StartTimer(Sender);
Opt.lang := LangBox.LanguageBox.ItemIndex+1;
MenuLanguageChange(Sender);
FormPaint(Sender);
LangBox.Destroy;
end;
procedure TMainForm1.liClick(Sender: TObject);
Var Site,Count:String;
begin
Count:=InttoStr(SysLocale.PriLangID);
Site:= 'http://www.cococo.de/index.jsp?act=lizenz?product=agenda?country='+Count;
ShellExecute(Handle, 'open',PChar(Site),nil,nil, SW_SHOWNORMAL);
end;
procedure TMainForm1.Sprachausgabe2Click(Sender: TObject);
begin
SpeechBox := TSpeechBox.Create(Self);
SpeechBox.Caption := D_Sprecher[Opt.lang];
SpeechBox.Copyright.Caption := D_setzeSprecher[Opt.lang];
SpeechBox.Label1.Caption := D_Geschwindigkeit[Opt.lang];
SpeechBox.Label2.Caption := D_SprecherTest[Opt.lang];
SpeechBox.OKButton.Caption := D_OK[Opt.lang];
Utilities.EnumVoices(Opt.Voice, D_Leise[Opt.lang],SpeechBox.SpeakerBox);
SpeechBox.SpeechRate.Position := Opt.VoiceRate;
// kill timer meanwhile
StopTimer(sender);
SpeechBox.ShowModal;
StartTimer(Sender);
Utilities.Speaker := SpeechBox.SpeakerBox.ItemIndex;
Opt.VoiceRate := SpeechBox.SpeechRate.Position;
VoiceBox.ItemIndex := SpeechBox.SpeakerBox.ItemIndex;
Opt.Voice := Utilities.Speaker;
Repaint;
SpeechBox.Destroy;
FormPaint(Sender);
end;
procedure TMainForm1.Klnge1Click(Sender: TObject);
begin
SoundsBox := TSoundsBox.Create(Self);
SoundsBox.Caption := D_Klaenge[Opt.lang];
SoundsBox.OKButton.Caption := D_OK[Opt.lang];
SoundsBox.Label1.Caption := D_Geburtstag[Opt.lang];
SoundsBox.Label2.Caption := D_Ereignis[Opt.lang];
SoundsBox.Button1.Caption := D_Finde[Opt.lang];
SoundsBox.Button2.Caption := D_Finde[Opt.lang];
SoundsBox.Button3.Caption := D_Finde[Opt.lang];
SoundsBox.Button4.Caption := D_Finde[Opt.lang];
SoundsBox.MorseCheckBox.Caption := D_SendeMorse[Opt.lang];
OpenDialog.Filter := D_SoundFiles[Opt.lang]+'|*.wav|';
OpenDialog.InitialDir := Opt.ProgramDir + SoundsDir;
SoundsBox.Edit1.text := Opt.SoundFile[HappyBirthDay];
SoundsBox.Edit2.text := Opt.SoundFile[SongofJoy];
SoundsBox.Edit3.text := Opt.SoundFile[Ding];
SoundsBox.Edit4.text := Opt.SoundFile[DingDong];
// kill timer meanwhile
StopTimer(sender);
SoundsBox.ShowModal;
If not Opt.PlayMorseCodes and (LastMorseThread<>nil) then begin
LastMorseThread.Terminate;
LastMorseThread:=nil;
end;
StartTimer(Sender);
StrPCopy(Opt.SoundFile[HappyBirthDay],SoundsBox.Edit1.text);
StrPCopy(Opt.SoundFile[SongofJoy],SoundsBox.Edit2.text);
StrPCopy(Opt.SoundFile[Ding],SoundsBox.Edit3.text);
StrPCopy(Opt.SoundFile[DingDong],SoundsBox.Edit4.text);
SoundsBox.Destroy;
FormPaint(Sender);
end;
procedure TMainForm1.Verzeichnis1Click(Sender: TObject);
begin
if Opt.CommonDir='' then begin
CommonDialog1.InitialDir := Opt.CommonDir;
CommonDialog1.FileName := EreignisDatei;
if Commondialog1.InitialDir='' then
CommonDialog1.InitialDir :='C:\';
CommonDialog1.Options := [ofPathMustExist, ofOverwritePrompt];
CommonDialog1.Filter := D_Ereignis[Opt.lang]+'|*.dat|';
CommonDialog1.FilterIndex := 1;
if CommonDialog1.Execute then begin
Opt.CommonDir:=ExtractFileDir(CommonDialog1.FileName)+'\';
if (not fileexists(CommonDialog1.FileName)) then
FileCreate(CommonDialog1.FileName)
else begin
GetEvents(Opt.CommonDir+EreignisDatei,CommonEvent);
FillList;
end
end;
if Opt.CommonDir<>'' then
Verzeichnis.Checked:=true;
end
else begin
Opt.CommonDir:='';
Verzeichnis.Checked:=false;
end;
end;
procedure TMainForm1.Voice1Click(Sender: TObject);
begin
if Opt.Voice=0 then Opt.Voice:=min(1,VoiceBox.Items.Count);
Voice1.Visible := DoMakeSound and (Opt.Voice>0);
DoMakeSound := not DoMakeSound;
end;
procedure TMainForm1.VoiceBoxChange(Sender: TObject);
begin
Opt.Voice := VoiceBox.ItemIndex;
Utilities.Speaker := Opt.Voice;
end;
procedure TMainForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ord(Key)=13 then begin //Enter
EventChangeItemClick(Sender);
end
else if ord(Key)=45 then begin //Ins
EventNewItemClick(Sender);
end
else if ord(Key)=46 then begin //Del
EventDeleteItemClick(Sender);
end
else if ord(Key)=114 then begin //F3
Posit(LastSearchText);
end;
end;
procedure TMainForm1.EventNewItemClick(Sender: TObject);
begin
Modus := Neu;
Editor := TEditor.Create(Self);
Tokens.Visible := false;
Ereignisse.Visible := false;
Listview1.Visible := true;
StandardToolBar.Visible := true;
if ListView1.Selected = nil then Editor.ScrollBar1.Position:=1
else Editor.ScrollBar1.Position:=Listview1.Selected.Index;
// kill timer meanwhile
StopTimer(sender);
Editor.ShowModal;
StartTimer(Sender);
FillList;
PutAllEvents;
Editor.Destroy;
end;
procedure TMainForm1.EventChangeItemClick(Sender: TObject);
begin
if tokens.Visible or ListView1.Visible then begin
Tokens.Visible := false;
ListView1.Visible := false;
Ereignisse.Visible := true;
StandardToolBar.Visible := false;
ButtonChange.Hint := D_ListEDIT[Opt.lang];
end else if Ereignisse.Visible then begin
Ereignisse.Visible := false;
Tokens.Visible := false;
ListView1.Visible := true;
StandardToolBar.Visible := true;
Listview1.ItemIndex := 0;
Modus := Aendern;
ButtonChange.Hint := D_ListEDIT[Opt.lang];
Posit(LastWho);
end
end;
procedure TMainForm1.EventDeleteItemClick(Sender: TObject);
begin
if listview1.Visible then begin
if ListView1.Selected <> nil then begin
Modus := Loeschen;
Editor := TEditor.Create(Self);
Editor.ScrollBar1.Position := Listview1.Selected.Index;
// kill timer meanwhile
StopTimer(sender);
Editor.ShowModal;
StartTimer(Sender);
FillList;
PutAllEvents;
Editor.Destroy;
end else
showmessage(D_Select[Opt.lang]);
end
end;
// if Listview visible and item selected
procedure TMainForm1.EventEdit(Sender: TObject);
var sav:integer;
begin
if listview1.Visible then begin
if ListView1.Selected <> nil then begin
Modus := Aendern;
Editor := TEditor.Create(Self);
Editor.ScrollBar1.Position := Listview1.Selected.Index;
Editor.Caption := D_Ereignis[Opt.lang]+' '+D_Neu[Opt.lang];
sav := listview1.Selected.Index;
// kill timer meanwhile
StopTimer(sender);
Editor.ShowModal;
StartTimer(Sender);
FillList;
PutAllEvents;
listview1.ItemIndex := sav mod (ListView1.Items.Count);
Editor.Destroy;
end else
showmessage('pls select item');
end
end;
procedure TMainForm1.MailData(Sender: TObject);
Type s24=String[24];
procedure decrypt(var S:S24);
var i:integer;begin for i:=1 to Length(S) do S[i]:=chr(ord(S[i])-7); end;
procedure encrypt(var S:String);
var i:integer;begin for i:=1 to Length(S) do S[i]:=chr(ord(S[i])+7); end;
var S:String;
begin
MailDa := TMailForm.Create(Self);
with MailDa do try
Label1.Caption := D_Server[Opt.Lang];
Label2.Caption := D_User[Opt.Lang];
Label3.Caption := D_Passwort[Opt.Lang];
Absenden.Caption := D_OK[opt.lang];
Verwerfen.Caption := D_Abbruch[opt.lang];
MailServer.Text := OPt.SMTPHost;
User.Text := OPt.SMTPUser;
Email.Text := Opt.Email;
Decrypt(Opt.SMTPPassword);
Password.Text := Opt.SMTPPassword;
Caption := 'SMTP '+D_Email[opt.lang]+' '+Application.Title+' ';
Sent := false;
MailDa.ShowModal;
if MailDa.Sent then begin
if MailServerTest(SMTP,MailServer.Text,User.text,Password.text) then begin
Opt.SMTPHost := Mailserver.text;
Opt.SMTPUser := user.text;
S:=Password.text;Encrypt(S);Opt.SMTPPAssword := S;
Opt.Email:=Email.Text;
end;
end;
finally
end;
MailDa.Destroy;
end;
procedure TMainForm1.Feedback1Click(Sender: TObject);
Var Success,Count, SO:String;
begin
// do a ping to activate router !!
SO:=Opt.ProgramDir;
ShellExecute(Handle, 'open','ping www.cococo.de',nil,PChar(SO), SW_SHOWNORMAL);
Feedb := TFeedform.Create(Self);
with Feedb do
try
bewertung.Items.Clear;
bewertung.Items.Add(D_sehrgut[Opt.lang]);
bewertung.Items.Add(D_gut[Opt.lang]);
bewertung.Items.Add(D_befriedigend[Opt.lang]);
bewertung.Items.Add(D_ausreichend[Opt.lang]);
bewertung.Items.Add(D_schlecht[Opt.lang]);
bewertung.Items.Add(D_sehrschlecht[Opt.lang]);
Bewertung.Text := D_Urteil[Opt.lang];
Label1.Caption := d_name[opt.lang];
Vorname.Text := OPt.Vorname;
Name.Text := Opt.Name;
Email.Text := Opt.Email;
Label2.Caption := d_Vorname[opt.lang];
Label3.Caption := d_Email[opt.lang];
Label6.Caption := d_Urteil[opt.lang];
Label7.Caption := d_Kommentar[opt.lang];
Absenden.Caption := D_Senden[opt.lang];
Verwerfen.Caption := D_Abbruch[opt.lang];
Caption := 'Feedback '+Application.Title+' ';
Count:=InttoStr(SysLocale.PriLangID);
// kill timer meanwhile
StopTimer(sender);
Feedb.Sent:=false;
ShowModal;
StartTimer(Sender);
if Feedb.Sent then begin
Opt.Vorname := Vorname.text;
Opt.Name := Name.text;
Opt.Email := Email.text;
if (Pos('@',Feedb.Email.text)>0) and (Pos('.',Feedb.Email.text)>0) then begin
Success:=D_Uebertragen[Opt.lang];
try
MySQLFeedback(SQ,Feedb.Vorname.Text,Feedb.Name.Text,
Feedb.Email.Text,Application.Title,Version,
inttostr(Feedb.Bewertung.ItemIndex),
Feedb.Kommentar.Text,'127.0.0.1',Count)
except
Success := D_NoInternet[Opt.lang];
end;
ShowMessage(Success);
end else
showmessage(D_Emaileingeben[Opt.lang]);
end;
finally
end;
Feedb.Destroy;
end;
procedure TMainForm1.MyIdleHandler(Sender: TObject; var Done: Boolean);
begin
Sleep(1000);
Slept:=Slept+1;
if Slept > 10 then begin
Application.Restore;
Close;
end;
end;
procedure TMainForm1.StopTimer(Sender: TObject);
begin
if Timer1 <> nil then
timer1.Enabled := false;
end;
procedure TMainForm1.StartTimer(Sender: TObject);
begin
StopTimer(Sender);
if Timer1 = nil then
Timer1 := TTimer.Create(Mainform1);
Timer1.Enabled:=true;
Timer1.Interval := Opt.Waittime*1000;
Timer1.OnTimer:=MyTimeHandler;
end;
procedure TMainForm1.MyTimeHandler(Sender: TObject);
begin
Application.Restore;
if Opt.Waittime>0 then Close;
end;
procedure TMainForm1.Hilfe1Click(Sender: TObject);
begin
WinHelp(0,PChar(Application.helpfile),HELP_CONTENTS,0);
//Application.HelpCommand(HELP_CONTENTS, 0);
end;
procedure TMainForm1.TextEditieren(Sender: TObject);
var i,no,p:integer;
begin
Ereignisse.Visible := false;
ListView1.Visible := false;
Tokens.Visible := true;
StandardToolBar.Visible := false;
no := (tokens.RowCount+1) div nolanguages;
p := (Opt.lang - 1) * no + 1;
Tokens.SetFocus;
for i:= 1 to p do Tokens.RowHeights[i] := -1;
for i:= p+no+1 to Tokens.RowCount-1 do Tokens.RowHeights[i] := -1;
end;
procedure TMainForm1.StandardToolBarMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
StandardToolBar.Height := 30;
end;
procedure TMainForm1.EreignisseMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var m:TPoint; Eve:TDateTime; Diff:Integer;
mw,mh:integer;
IsIn : boolean;
begin
if Ereignisse.Visible then begin
m.x := Mouse.CursorPos.x;
m.y := Mouse.CursorPos.y;
mw := MainForm1.width;
mh := 2*StandardToolBar.Height;
Eve := Now;
IsIn := (m.y >= MainForm1.Top-mh)
and (m.y <= MainForm1.Top+mh)
and (m.x > mainform1.Left)
and (m.x < mainform1.Left+mw);
Diff := MilliSecondOf(Eve - LastMouseTime);
if (Diff>300)
and ((LastMousePos.x<>m.x) or (LastMousePos.y<>m.y)) then begin
if IsIn then begin
StandardToolBar.Visible := true;
end else if Not IsIn then begin
StandardToolBar.Visible := false;
VertScrollBar.Position :=0;
end
end;
LastMousePos := m;
LastMousePosIn := IsIn;
LastMouseTime := Eve
end;
end;
procedure TMainForm1.Finden1Click(Sender: TObject);
var S:String;
begin
S := InputBox('',D_Finde[opt.lang], LastSearchText);
Posit(S);
LastSearchText := S;
end;
procedure TMainForm1.Posit(S: String);
var i,p,pp,ps,through:integer;Pa:PAnsiChar;Si:String;
begin
through := 0;
Tokens.Visible := false;
Ereignisse.Visible := false;
ListView1.Visible := true;
StandardToolBar.Visible := true;
i:=AllCount+1;
if (LastSearchText<>'') and (S=LastSearchText) then i:=ListView1.Selected.Index+2;
if i>AllCount then i:=1;
p:=-1;
while (i<= AllCount) and (through < AllCount) do begin
Through := Through + 1;
Pa := @All[i];
Si := Pa;
Si := LowerCase(Si);
S := LowerCase(S);
pp := Pos(s,si);
if pp > 0then begin
p := i; through :=AllCount+1;
end;
i := (i+1) mod (AllCount+1);
if (i=0) then i:=1;
end;
if p >= 1 then begin
ListView1.SetFocus;
ListView1.Selected := ListView1.Items[p-1];
if p > 5 then begin
ps:=p-5;
ps := ListView1.items.Item[ps].GetPosition.Y;
ListView1.Scroll(0,ps);
end else
ListView1.Scroll(0,-1000);
end
end;
procedure TMainForm1.TokensExit(Sender: TObject);
begin
PutLanguages;
GetLanguages;
FormPaint(Sender);
end;
procedure TMainForm1.UpdateVersion1Click(Sender: TObject);
Var Site,Count:String;
begin
Count:=InttoStr(SysLocale.PriLangID);
Site:= 'http://www.cococo.de/index.jsp?act=update?product=agenda?country='+Count;
ShellExecute(Handle, 'open',PChar(site),nil,nil, SW_SHOWNORMAL);
end;
//----------------------------------------------------------------
//
// generate task manager entry
//
//----------------------------------------------------------------
Procedure TMainForm1.MakeAT;
var Ti, Pars, MySelf, Res, Days, SO:String;
Kennung, atcmd:TextFile; i:integer;
begin
// first delete old entry
DeleteAT;
Ti := ' '+inttostr(opt.WakeTime)+':00 ';
Days:=' ';
for i:=1 to 31 do Days := Days + inttostr(i)+' ';
MySelf := Opt.ProgramDir+ObjectFile+' auto';
Pars := Ti+'/Every:'+Days+'"'+MySelf+'" > '+KennungsDatei;
//write bat file
AssignFile(atcmd,Opt.ProgramDir+ATCommand);
try
Rewrite(atcmd);
writeln(atcmd,'at'+Pars);
CloseFile(atcmd);
finally
end;
SO:=Opt.ProgramDir;
ShellExecute(Handle,'open','atcmd.bat',nil,PChar(SO),SW_MINIMIZE);
AssignFile(Kennung,Opt.ProgramDir+KennungsDatei);
try
Reset(Kennung);
Readln(Kennung,Res);
i:= Pos('=',Res)+1;
if i > 0 then begin
res := MidStr(Res,i,5);
Trystrtoint(Res,Opt.ATKennung);
end;
CloseFile(Kennung);
finally
end;
end;
//----------------------------------------------------------------
//
// delete task manager entry
//
//----------------------------------------------------------------
Procedure TMainForm1.DeleteAT;
var Pars, MySelf, SO :String;atcmd:TextFile;
begin
if Opt.ATKennung > 0 then begin
MySelf := Opt.ProgramDir+ObjectFile;
Pars := inttostr(Opt.ATKennung)+' /delete /yes';
//write bat file
AssignFile(atcmd,Opt.ProgramDir+ATCommand);
try
Rewrite(atcmd);
writeln(atcmd,'at'+Pars);
CloseFile(atcmd);
finally
end;
SO:=Opt.ProgramDir;
ShellExecute(Handle,'open','atcmd.bat',nil,PChar(SO),SW_MINIMIZE);
end
end;
procedure TMainForm1.PrintButtonClick(Sender: TObject);
begin
if PrintDialog.Execute then begin
if Ereignisse.Visible then
ereignisse.Print(D_Ereignis[opt.lang]+' '+DateToStr(Now))
else if ListView1.Visible then
PrintEventFile(Sender);
end
end;
procedure TMainForm1.EreignisseMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
EventChangeItemClick(Sender);
end;
procedure TMainForm1.UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FontChange(Sender);
end;
procedure TMainForm1.miEditFontClick(Sender: TObject);
begin
FontDialog1.Font.Name:=opt.Fontname;
FontDialog1.Font.Size:=opt.FontSize;
FontDialog1.Font.Style:=opt.FontStyles;
FontDialog1.Font.Color:=opt.FontColor;
FontDialog1.Execute;
opt.FontColor := FontDialog1.Font.Color;
opt.FontSize := FontDialog1.Font.Size;
opt.Fontname := FontDialog1.Font.Name;
opt.FontStyles := FontDialog1.Font.Style;
FontName.Text := FontDialog1.Font.Name;
FontSize.Text := inttostr(opt.FontSize);
BoldButton.Down := fsBold in opt.FontStyles;
UnderlineButton.Down := fsUnderline in opt.FontStyles;
ItalicButton.Down := fsItalic in opt.FontStyles;
ereignisse.DefAttributes.Size := opt.FontSize;
ereignisse.DefAttributes.Name := opt.Fontname;
ereignisse.DefAttributes.Size := opt.FontSize;
Ereignisse.DefAttributes.Style := opt.FontStyles;
Repaint
end;
procedure TMainForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ShowMessage('MM');
end;
procedure TMainForm1.PrintEventsClick(Sender: TObject);
begin
if PrintDialog.Execute then
Ereignisse.Print(Application.Title+' '+DateToStr(Now));
end;
procedure TMainForm1.DonateItemClick(Sender: TObject);
Var Site,Count:String;
begin
Count:=InttoStr(SysLocale.PriLangID);
Site:= 'http://www.cococo.de/CoCoCo/index.jsp?act=donation?country='+Count;
ShellExecute(Handle, 'open',PChar(Site),nil,nil, SW_SHOWNORMAL);
end;
procedure TMainForm1.SQBeforeConnect(Sender: TObject);
begin
DBaccess.SQBeforeConnect(SQ,Passw,Crypt);
end;
procedure TMainForm1.ThreadsDone(Sender: TObject);
begin
Pro(88,'Thread done ');
end;
end.
[Dauer der Verarbeitung: 0.46 Sekunden, vorverarbeitet 2026-04-28]
|
2026-05-26
|