| products/Sources/formale Sprachen/Delphi/Agenda 1.1/Sources/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: Hsdis.gmk 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; 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)),[rfReplaceA 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.DefAttribut else Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style - [fsUnderline] if BoldButton.Down then Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.St else Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes.Style - [fsBold]; if ItalicButton.Down then Ereignisse.DefAttributes.Style := Ereignisse.DefAttributes. 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 --> -------------------- ¤ Dauer der Verarbeitung: 0.74 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
