Quelle  reAgenda.pas   Sprache: Delphi

//------------------------------------------------------------------
//
//   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.1';
  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];
--> --------------------

--> maximum size reached

--> --------------------