| 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: g_congruence.mlg Sprache: Unknown
|
Untersuchungsergebnis.~pas Download desBAT {BAT[168] Ada[259] Abap[796]}zum Wurzelverzeichnis wechseln //------------------------------------------------------------------ // // Bugs: // 1. Andreas und Kornelia haben heute ten Hochzeitstag ?? // 2. Antwort b ei Feedback : "Danke" in 6 Sprachen // 3. Mehrere Dateien zulassen, eine auf Server, eine lokal // (z.B. im Homeverzeichnis und auf Server - Problem des konkurrenten Updates) // //------------------------------------------------------------------ unit remain; 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 ; {------------------------------------------------------------------} {- Type Declarations -} {------------------------------------------------------------------} Const langmax = 24; AllCountMax = 1024; AppName = 'Geburtstagskalender'; Version = '2.9.1'; EreignisDatei = 'Ereignis.Dat'; ObjectFile = 'ansawi.exe'; OptionsDatei = 'Options.Dat'; SprachDatei = 'Language.dat'; ATCommand = 'atcmd.bat'; KennungsDatei = 'Kennung.dat'; SoundsDir = 'Sounds'; ImageDir = 'Images'; Type Char2 = array[1..2] of char; Char4 = array[1..4] 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; 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; Fill7 : Char4; Remote : Char2; Fill8 : Char2; Repeats : Char32; //every, 1., 2., 3. etc end; 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] end; TMainForm1 = class(TForm) MainMenu: TMainMenu; FileMenu : TMenuItem; EventNewItem: TMenuItem; EventChangeItem: TMenuItem; EventDeleteItem: TMenuItem; Importieren: 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; Exportieren: 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; procedure GetOptions; procedure PutOptions; procedure DefaultOptions; procedure ForeignLocale; procedure MakeAT; procedure DeleteAT; procedure Email; procedure GetLocalDir; 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 Speech(sText : String); function DayofYear(AnyTime:Date) : integer; procedure Convert(A : TAppoint;var b : Date); function Inspect(s:string) : boolean; procedure Event(Who :Char36;Typ:Char32;Wish:Char36; Month:Char2;Day:Char2;Year:Char4;BC:Char; Diff : 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 PerformFileOpen(const AFileName: string); 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 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); 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; SaveQuery : Boolean; Crypt : String; Passw : String; RemoteMark : Char2; end; EFileInvalid = class(Exception); var MainForm1 : TMainForm1; LastSoundThread : TMySoundThread; LastVoiceThread : TMySpeechThread; ProgramDir : String; LocalDir : String; All : array[1..1024] of TAppoint; AllCount : integer; nolanguages : integer; Feedb : TFeedform; Modus : (Neu, Aendern, Loeschen); Events : TextFile; Langs : TextFile; LangsDir : (readl,writel); Opt : TOption; FDragOfs : Integer; FDragging : Boolean; Slept : integer; EventFound : boolean; WinEvent : boolean; ThisTime : Date; Greeting : String[20]; Blank2 : Char2; Blank4 : Char4; Blank32 : Char32; Blank36 : Char36; Blank120 : FileName; EventTypes : array[1..32] of String; SoundPlayed : array[TSound] of boolean; VoiceSpoken : boolean; // //Parameters for translation // D_Langs : LangArray; D_Foreign : LangArray; D_DFormats : LangArray; D_Syntax : LangArray; D_Months : array [1..12] of LangArray; D_Days : array [0..6] of LangArray; 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_Email : 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_EmailAdr : LangArray; D_Urteil : LangArray; D_Kommentar : LangArray; D_Senden : LangArray; D_Abbruch : LangArray; D_NoInternet : LangArray; implementation uses reSplash, reSounds, reSpeech, reDialogue, ReLang, ReAlert, Reabout, ReOption, RichEdit, R Math; const RulerAdj = 4/3; GutterWid = 6; {$R *.dfm} {------------------------------------------------------------------} {- 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'; end;{DefaultOpt.s} {------------------------------------------------------------------} {- Procedure getOpt.s -} {- set Opt.s -} {------------------------------------------------------------------} Procedure TMainForm1.GetOptions; var fn:String;fc:FileName; begin if LocalDir <> '' then Fn:=LocalDir+OptionsDatei else Fn:=ProgramDir+OptionsDatei; AssignFile (Opts,Fn); {$I-}Reset(Opts);{$I+} if IOResult = 0 then begin {$I-}Read(Opts,Opt);{$I+} if IOResult<>0 then DefaultOptions; CloseFile(Opts) end else begin StrPCopy(fc,fn); DeleteFile(fc); Opt.inited:=' '; end; //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 if LocalDir <> '' then Fn:=LocalDir+OptionsDatei else Fn:=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); {$I-}Rewrite(Opts);{$I+} if IOResult = 0 then begin write(Opts,Opt); CloseFile(Opts); 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 Sounder } { work in parallel } { for to sound a result or so } {------------------------------------------------------------------} 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); 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.Event(Who :Char36;Typ:Char32;Wish:Char36; Month:Char2;Day:Char2;Year:Char4;BC:Char; Diff : integer); Var Plural, DoUnderline : boolean; YearNum : integer; Subject, Predicate, Events, Temporal, Additional, Sentence : String; st,sl,sw,swl,l : integer; Sim : boolean; begin 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; Subject := Trim(Who); Plural := Inspect(Trim(Who)); YearNum := StrToInt(StringReplace(Year,' ', '0',[rfReplaceAll ])); if 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 Events := D_40th[Opt.lang]; if (Year = '0000') or (Year = ' ') or (YearNum = 0) then Events := StringReplace(Events,'%a', ' ',[rfReplaceAll ]) else Events := StringReplace(Events,'%a', inttostr(YearNum),[rfReplaceAll ]) 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; 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]); 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 ]); Sentence := Sentence + '.'; Sentence[1] := UpCase(Sentence[1]); Speech(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]; 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 : string[244]); false: (c: record c1 : char; b : TAppoint end); end; Var Trec : TRecord; Diff : integer; Goal : Date; YearDays : integer; S : String; 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; AssignFile(Events,Datei); {$I-}Reset(Events);{$I+} 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; while not Eof(Events) do begin Readln(Events,TRec.a); Convert(TRec.c.b,Goal); AllCount := AllCount + 1; if Allcount > AllCountMax then begin S := D_OutofMem[Opt.lang] +InttoStr(AllcountMax)+ ' '+D_Ereignis[Opt.lang]; raise EFileInvalid.Create(S) 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(TRec.c.b.Who,TRec.c.b.Typ, TRec.c.b.Wish, TREc.c.b.Month,TREc.c.b.Day, TRec.c.b.Year,TRec.c.b.BC,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; end; CloseFile(Events) 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 PutAllEvents -} {- local and remote -} {------------------------------------------------------------------} Procedure TMainForm1.PutAllEvents; begin PutEvents(ProgramDir+EreignisDatei,' '); if LocalDir <> '' then begin PutEvents(LocalDir+EreignisDatei,RemoteMark); end; end; {------------------------------------------------------------------} {- Procedure GetAllEvents -} {- local and remote -} {------------------------------------------------------------------} Procedure TMainForm1.GetAllEvents; var i:integer; begin for i:=1 to 32 do EventTypes[i] := ''; GetEvents(ProgramDir+EreignisDatei,' '); if LocalDir <> '' then begin RemoteMark := 'RR'; GetEvents(LocalDir+EreignisDatei,RemoteMark); Dialogue.SortEvents; end else RemoteMark := ' ';; end; {------------------------------------------------------------------} {- 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 DeleteFile(PChar(Datei)); AssignFile (Eout,Datei); {$I-}Rewrite(Eout);{$I+} 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); end;{GetEvents} {------------------------------------------------------------------} {- 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_Month[Opt.lang]; Listview1.Columns[2].Caption := D_Day[Opt.lang]; Listview1.Columns[3].Caption := D_Year[Opt.lang]; Listview1.Columns[4].Caption := D_Who[Opt.lang]; Listview1.Columns[5].Caption := D_Typ[Opt.lang]; Listview1.Columns[6].Caption := D_Wish[Opt.lang]; Listview1.Columns[7].Caption := D_Picture[Opt.lang]; Items.Clear; for I := 1 to AllCount do begin ListItem := Items.Add; ListItem.Caption:=' '; // first column 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); 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 if Langsdir=readl then begin readln(Langs,S); S:=Trim(S); end else writeln(Langs,S); 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); If Langsdir=readl then readln(Langs,S) else writeln(Langs,S); 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,ProgramDir+SprachDatei); if LangsDir=readl then begin {$I-}Reset(Langs);{$I+} end else begin {$I-}Rewrite(Langs);{$I+} 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[m][current] 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[d][current] 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_Email[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_EmailAdr[current]); RWs(D_NoInternet[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.GetLocalDir; begin LocalDir := GetEnvironmentVariable('HOMEDRIVE')+GetEnvironmentVariable('HOMEPATH') if Not DirectoryExists(LocalDir) then begin LocalDir := GetEnvironmentVariable('TEMP')+ '\'; end; if Not DirectoryExists(LocalDir) then begin LocalDir := 'C:' + '\'; end; LocalDir := LocalDir + '.' + AppName + Version + '\'; if not DirectoryExists(ExtractFileDir(LocalDir)) then if not CreateDir(ExtractFileDir(LocalDir)) then begin showmessage('Cannot create Home Directory'); ExitProcess(55) end end; procedure TMainForm1.FormCreate(Sender: TObject); var S, Drive: String;i:integer; begin ProgramDir := GetCurrentDir+ '\'; Drive := ExtractFileDrive(ProgramDir); LocalDir := ''; case GetDriveType(PChar(Drive)) of { une valeur positive indique un lecteur correct } DRIVE_REMOVABLE: { ajoute un onglet } getLocalDir; DRIVE_FIXED: ; { ajoute un onglet } DRIVE_REMOTE: { ajoute un onglet } getLocalDir; end; DoMakeSound := true; SaveQuery := false; // set Title Application.Title := 'Geburtstagskalender' + ' ' + Version; //language processing ForeignLocale; getLanguages; //init last thread LastSoundThread := nil; // for SQ passord etc. Crypt := AppName; Passw := ''; 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 Close; //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 32 do Blank32[i] := ' '; for i:= 1 to 36 do Blank36[i] := ' '; for i:= 1 to 120 do Blank120[i] := ' '; //builtin gimmicks Current(ThisTime); with ThisTime do begin if (Month=5) and (Day=1) Then if SecondOf(Now) mod 12 = 0 then Utilities.PCSounder(Internationale) else Utilities.PCSounder(DieGedankensindfrei); if (Month=3) and (Day=29) Then Sounder(Kennenlerntag); if (Month=8) and (Day=6) Then Sounder(Hochzeitstag); if (Month=11) and (Day=7) Then Sounder(MartinasGeburtstag); if (Month=3) and (Day=21) Then Sounder(BachsGeburtstag); if (Month=12) and (Day=16) Then Sounder(BeethovensGeburtstag); end; // 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(programDir); SaveDialog.InitialDir := OpenDialog.InitialDir; Caption := Format('%s - %s', [ExtractFileName(S), Application.Title]); // ----- 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; end; procedure TMainForm1.PerformFileOpen(const AFileName: string); begin Ereignisse.Lines.LoadFromFile(AFileName); Caption := Format('%s - %s', [ExtractFileName(AFileName), Application.Title]); Ereignisse.Modified := False; 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); var AboutBox : TAboutBox; begin AboutBox := TAboutBox.Create(Self); with AboutBox do try AboutBox.Caption := D_Ueber[Opt.lang]; // kill timer meanwhile StopTimer(sender); ShowModal; finally Free; StartTimer(Sender) end; 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 Caption := D_Geburtstagskalender[Opt.lang]+' '+Version; FileMenu.Caption := D_Ereignis[Opt.lang]; EventNewItem.Caption := D_Neu[Opt.lang]; EventChangeItem.Caption := D_Aendern[Opt.lang]; EventDeleteItem.Caption := D_Loeschen[Opt.lang]; Exportieren.Caption := D_Exportieren[Opt.lang]; Importieren.Caption := D_Importieren[Opt.lang]; PrintEvents.Caption := D_Drucken[Opt.lang]+ ' ' + D_Ereignis[Opt.lang]; PrintAllEvents.Caption := D_EreignisseDrucken[Opt.lang]; EventExitItem.Caption := D_Ende[Opt.lang]; Editmenu.Caption := D_Optionen[Opt.lang]; Language.Caption := D_Sprache[Opt.lang]; Alarmzeit.Caption := D_Alarmzeit[Opt.lang]; Sprachausgabe2.Caption := D_Sprachausgabe[Opt.lang]; Klnge1.Caption := D_Klaenge[Opt.lang]; MiEditFont.Caption := D_Font[Opt.lang]; HelpMenu.Caption := D_Hilfe[Opt.lang]; Hilfe1.Caption := D_Hilfe[Opt.lang]; DonateItem.Caption := D_Spende[Opt.lang]; HelpAboutItem.Caption := D_Ueber[Opt.lang]; BoldButton.Hint := D_setzeFett[Opt.lang]; FontName.Hint := D_setzeSchrift[Opt.lang]; FontSize.Hint := D_setzeGroesse[Opt.lang]; ItalicButton.Hint := D_setzeItalic[Opt.lang]; UnderlineButton.Hint := D_setzeUnterstrichen[Opt.lang]; ButtonChange.Hint := D_aendereEreignis[Opt.lang]; PrintButton.Hint := D_Drucken[Opt.lang]+' '+D_Ereignis[Opt.lang]; ButtonDelete.Hint := D_loescheEreignis[Opt.lang]; ButtonNew.Hint := D_neuesEreignis[Opt.lang]; LanguageBox.Hint := D_setzeSprache[Opt.lang]; VoiceBox.Hint := D_setzeSprecher[Opt.lang]; Utilities.EnumVoices(Opt.Voice,D_Leise[Opt.lang],VoiceBox); Sprachtextendern1.Caption := D_SprachTexte[Opt.lang]; end; procedure TMainForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var SaveResp:integer; begin PutLanguages; PutOptions; Canclose := true; if not EventFound then Exit; If SaveQuery then CanClose := false else if Opt.WarnMe then begin SaveQuery := true; SaveResp := MessageBox(WindowHandle, PChar(D_Stehtan[Opt.lang]), PChar(Application.title), MB_YESNO); SaveQuery := false; case SaveResp of IDYES : Canclose := true; IDNO : begin Canclose := false; StartTimer(Sender); LastMouseTime := Now end else CanClose := false end; end else if (Mouse.CursorPos.y >= MainForm1.Top+50) and (Mouse.CursorPos.y <= MainForm1.Top+MainForm1.Height) and (Mouse.CursorPos.x >= MainForm1.left) and (Mouse.CursorPos.x <= MainForm1.left+MainForm1.Width) then CanClose := false end; { Ruler Indent Dragging } procedure TMainForm1.RulerItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDragOfs := (TLabel(Sender).Width div 2); TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs; FDragging := True; end; procedure TMainForm1.RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if FDragging then TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs end; procedure TMainForm1.FormShow(Sender: TObject); var i:integer; begin // wird nur bei just started aufgerufen ? //acoustical part for i:=1 to nolanguages do if D_Langs[i] > ' ' then LanguageBox.Items.Add(D_Langs[i]); LanguageBox.ItemIndex := opt.lang-1; MenuLanguageChange(sender); // set itemindex and size Fontname.Text := opt.Fontname; UpDown1.Position := opt.FontSize; FontSize.Text := inttostr(opt.FontSize); //check buttons if fsUnderline in opt.fontstyles then UnderlineButton.Down := true; if fsBold in opt.fontstyles then BoldButton.down := true; if fsItalic in opt.fontstyles then ItalicButton.down := true; tokens.Visible := false; ListView1.Visible := false; Ereignisse.Visible := true; Ereignisse.font.Color := opt.FontColor; Ereignisse.font.name := opt.Fontname; Ereignisse.font.size := opt.FontSize; Ereignisse.font.Style := opt.FontStyles; Ereignisse.DefAttributes.Color := opt.FontColor; Ereignisse.DefAttributes.name := opt.Fontname; Ereignisse.DefAttributes.size := opt.FontSize; Ereignisse.DefAttributes.Style := opt.FontStyles; FontName.OnChange:=FontChange; FontSize.OnChange:=FontChange; end; procedure TMainForm1.AlarmzeitClick(Sender: TObject); var S : String; DV, DN : integer; begin AlertBox := TAlertBox.Create(Self); AlertBox.Caption := D_Alarmzeit[Opt.lang]; AlertBox.Alarmzeit.Caption := D_Wunschzeit[Opt.lang]; AlertBox.Label1.Caption := D_EndeZeit[Opt.lang]; AlertBox.CheckBox1.Caption := D_Warnemich[Opt.lang]; AlertBox.Alerttime.Text := IntToStr(opt.alarmzeit); DV := Opt.alarmzeit; AlertBox.Waittimer.Text := inttostr(Opt.Waittime); Alertbox.CheckBox1.checked := Opt.WarnMe; AlertBox.Label2.Caption := D_UhrZeitStart[Opt.lang]; AlertBox.WakeTime.Text := inttostr(Opt.WakeTime); // kill timer meanwhile StopTimer(sender); AlertBox.ShowModal; StartTimer(Sender); TryStrtoint(AlertBox.WakeTime.Text,Opt.WakeTime); TryStrtoint(AlertBox.Waittimer.Text,Opt.Waittime); Opt.WarnMe := ALertBox.CheckBox1.Checked; S := AlertBox.Alerttime.Text; DN := StrToInt(S); if not (DV = DN) and (0 <= DN) and (DN <= 365) then opt.alarmzeit := DN; Opt.alarmzeit := Opt.alarmzeit; //MakeAT; FormPaint(Sender); end; procedure TMainForm1.LanguageClick(Sender: TObject); var i : integer; begin LangBox := TLangBox.Create(Self); LangBox.Caption := D_Sprache[Opt.lang]; LangBox.Copyright.Caption := D_Wunschsprache[Opt.lang]; for i:=1 to nolanguages do if D_Langs[i] > '' then LangBox.LanguageBox.Items.Add(D_Langs[i]); LangBox.LanguageBox.ItemIndex := Opt.lang -1; // kill timer meanwhile StopTimer(sender); LangBox.ShowModal; StartTimer(Sender); Opt.lang := LangBox.LanguageBox.ItemIndex+1; MenuLanguageChange(Sender); FormPaint(Sender); end; procedure TMainForm1.Sprachausgabe2Click(Sender: TObject); begin SpeechBox := TSpeechBox.Create(Self); SpeechBox.Caption := D_Sprecher[Opt.lang]; SpeechBox.Copyright.Caption := D_setzeSprecher[Opt.lang]; SpeechBox.Label1.Caption := D_Geschwindigkeit[Opt.lang]; SpeechBox.Label2.Caption := D_SprecherTest[Opt.lang]; Utilities.EnumVoices(Opt.Voice, D_Leise[Opt.lang-1],SpeechBox.SpeakerBox); SpeechBox.SpeechRate.Position := Opt.VoiceRate; // kill timer meanwhile StopTimer(sender); SpeechBox.ShowModal; StartTimer(Sender); Utilities.Speaker := SpeechBox.SpeakerBox.ItemIndex; Opt.VoiceRate := SpeechBox.SpeechRate.Position; VoiceBox.ItemIndex := SpeechBox.SpeakerBox.ItemIndex; Opt.Voice := Utilities.Speaker; Repaint; FormPaint(Sender); end; procedure TMainForm1.Klnge1Click(Sender: TObject); begin SoundsBox := TSoundsBox.Create(Self); SoundsBox.Caption := D_Klaenge[Opt.lang]; SoundsBox.Label1.Caption := D_Geburtstag[Opt.lang]; SoundsBox.Label2.Caption := D_Ereignis[Opt.lang]; SoundsBox.Button1.Caption := D_Finde[Opt.lang]; SoundsBox.Button2.Caption := D_Finde[Opt.lang]; SoundsBox.Button3.Caption := D_Finde[Opt.lang]; SoundsBox.Button4.Caption := D_Finde[Opt.lang]; OpenDialog.Filter := D_SoundFiles[Opt.lang]; OpenDialog.InitialDir := ProgramDir + SoundsDir; SoundsBox.Edit1.text := Opt.SoundFile[HappyBirthDay]; SoundsBox.Edit2.text := Opt.SoundFile[SongofJoy]; SoundsBox.Edit3.text := Opt.SoundFile[Ding]; SoundsBox.Edit4.text := Opt.SoundFile[DingDong]; // kill timer meanwhile StopTimer(sender); SoundsBox.ShowModal; StartTimer(Sender); StrPCopy(Opt.SoundFile[HappyBirthDay],SoundsBox.Edit1.text); StrPCopy(Opt.SoundFile[SongofJoy],SoundsBox.Edit2.text); StrPCopy(Opt.SoundFile[Ding],SoundsBox.Edit3.text); StrPCopy(Opt.SoundFile[DingDong],SoundsBox.Edit4.text); FormPaint(Sender); end; procedure TMainForm1.VoiceBoxChange(Sender: TObject); begin Opt.Voice := VoiceBox.ItemIndex; Utilities.Speaker:=Opt.Voice; end; procedure TMainForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if ord(Key)=13 then begin //Enter EventChangeItemClick(Sender); end else if ord(Key)=45 then begin //Ins EventNewItemClick(Sender); end else if ord(Key)=46 then begin //Del EventDeleteItemClick(Sender); end else if ord(Key)=114 then begin //F3 Posit(LastSearchText); end; end; procedure TMainForm1.EventNewItemClick(Sender: TObject); begin Tokens.Visible := false; Ereignisse.Visible := false; Listview1.Visible := true; StandardToolBar.Visible := true; Dialogue.Caption := D_Ereignis[Opt.lang]+' '+D_Aendern[Opt.lang]; Modus := Neu; if ListView1.Selected = nil then Dialogue.ScrollBar1.Position:=1 else Dialogue.ScrollBar1.Position:=Listview1.Selected.Index; // kill timer meanwhile StopTimer(sender); Dialogue.RemoteMark := RemoteMark; Dialogue.ShowModal; PutAllEvents; StartTimer(Sender); FillList end; procedure TMainForm1.EventChangeItemClick(Sender: TObject); begin if tokens.Visible or ListView1.Visible then begin Tokens.Visible := false; ListView1.Visible := false; Ereignisse.Visible := true; StandardToolBar.Visible := false; ButtonChange.Hint := D_ListEDIT[Opt.lang]; end else if Ereignisse.Visible then begin Ereignisse.Visible := false; Tokens.Visible := false; ListView1.Visible := true; StandardToolBar.Visible := true; Listview1.ItemIndex := 0; Dialogue.Caption := D_Ereignis[Opt.lang]+' '+D_Neu[Opt.lang]; Modus := Aendern; ButtonChange.Hint := D_ListEDIT[Opt.lang]; Posit(LastWho); end end; procedure TMainForm1.EventDeleteItemClick(Sender: TObject); begin if listview1.Visible then begin if ListView1.Selected <> nil then begin Dialogue.ScrollBar1.Position:=Listview1.Selected.Index; Dialogue.Caption := D_Ereignis[Opt.lang]+' '+D_Neu[Opt.lang]; Modus := Loeschen; // kill timer meanwhile StopTimer(sender); Dialogue.RemoteMark := RemoteMark; Dialogue.ShowModal; PutAllEvents; StartTimer(Sender); --> -------------------- --> maximum size reached --> -------------------- [ Dauer der Verarbeitung: 0.284 Sekunden ] |