|
{-----------------------------------------------------------------}
{- Program Header -}
{------------------------------------------------------------------}
program Vorlage;
{$R ANSAGE.RES}
Uses
WinDOS, WinProcs, WinTypes, WObjects, Strings;
{------------------------------------------------------------------}
{- Number of Days in Advance -}
{------------------------------------------------------------------}
Const
Alert = 2; { Days before and after event }
Version = '1.7';
Dateof = ' Mai 1994';
cm_New = 101;
cm_Change = 102;
cm_Delete = 103;
cm_End = 104;
cm_Help = 201;
cm_About = 202;
id_BN1 = 301;
{------------------------------------------------------------------}
{- Type Declarations -}
{------------------------------------------------------------------}
Type
Sounds = (SongofJoy,Bourree,RadioHamburg,Alarm,HappyBirthDay,
Sailing, Ding, DingDong);
Char2 = array[1..2] of char;
Char4 = array[1..4] of char;
Char32 = array[1 ..32] of char;
Char36 = array[1..36] of char;
Date = Record
Minute : 0 .. 59;
Hour : 0 .. 23;
Day : 1 .. 31;
WeekDay: 0 .. 6;
Month : 1 .. 12;
Year : 1200 .. 2200
end;
Appoint = Record
Month : Char2;
Fill1 : char;
Day : Char2;
Fill2 : char;
Year : Char4;
Fill3 : char;
Typ : Char32;
Fill4 : char;
Who : Char36
end;
PTestDialog = ^TTestDialog;
TTestDialog = object(TDialog)
{ procedure IDBN1(var Msg: TMessage); virtual id_First + id_BN1; }
end;
TMyApplication = object(TApplication)
procedure InitMainWindow; virtual;
end;
PMyWindow = ^TMainForm;
TMainForm = object(TWindow)
Just_Started : boolean;
EventFound : boolean;
WinEvent : boolean;
Texts : Text;
Events : Text;
ThisTime : Date;
Greeting : string[20];
Months : array [1 .. 12] of string[10];
Days : array [0 .. 6] of string[10];
Blank2 : Char2;
Blank4 : Char4;
Blank32 : Char32;
Blank36 : Char36;
constructor Init(AParent: PWindowsObject; ATitle: PChar);
destructor Done; virtual;
function CanClose: Boolean; virtual;
procedure WMLButtonDown(var Msg: TMessage);
virtual wm_First + wm_LButtonDown;
procedure WMLButtonUp(var Msg: TMessage);
virtual wm_First + wm_LButtonUp;
procedure WMMouseMove(var Msg: TMessage);
virtual wm_First + wm_MouseMove;
procedure WMRButtonDown(var Msg: TMessage);
virtual wm_First + wm_RButtonDown;
Procedure Current(var Setting : Date);virtual;
Procedure Sounder(i : Sounds);virtual;
Function DayofYear(AnyTime:Date) : integer;virtual;
Procedure Convert(A : Appoint;var b : Date);virtual;
function ShortWho(Who:Char36) : string;virtual;
function ShortTyp(Typ:Char32) : string;virtual;
Function Inspect(s:string) : boolean;virtual;
Procedure Event(Who :Char36;Typ:Char32;
Month:Char2;Day:Char2;Year:Char4;
Diff : integer);virtual;
Procedure Appointment;virtual;
procedure Greetings;virtual;
procedure TextWindow;virtual;
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
procedure FileNew(var Msg: TMessage);
virtual cm_First + cm_New;
procedure FileChange(var Msg: TMessage);
virtual cm_First + cm_Change;
procedure FileDelete(var Msg: TMessage);
virtual cm_First + cm_Delete;
procedure FileEnd(var Msg: TMessage);
virtual cm_First + cm_End;
procedure FileHelp(var Msg: TMessage);
virtual cm_First + cm_Help;
procedure About(var Msg: TMessage);
virtual cm_First + cm_About;
end;
{------------------------------------------------------------------}
{- Procedure Current Time -}
{- for to fetch system time -}
{------------------------------------------------------------------}
Procedure TMainForm.Current(var Setting : Date);
var
H,M,S,C : word;
Y,Mo,D,W : word;
begin
GetTime(H,M,S,C);
GetDate(Y,Mo,D,W);
With Setting do
begin
Minute := M;
Hour := H;
Day := D;
WeekDay := W;
Month := Mo;
Year := Y
end;
end; {Current}
{------------------------------------------------------------------}
{ Procedure Sounder }
{ for to sound a result or so }
{------------------------------------------------------------------}
Procedure TMainForm.Sounder(i : Sounds);
const
c000 = 32.70;
c00 = 65.41;
c0 = 130.81;
c = 261.63;
cis = 277.18;
d = 293.67;
es = 311.13;
e = 329.63;
f = 349.23;
fis = 369.99;
g = 392.0;
as = 415.31;
gis = as;
a = 440.0;
b = 466.16;
h = 493.88;
c1 = 261.63;
c2 = 523.25;
c3 = 1046.51;
c4 = 2093.02;
c5 = 4186.03;
full = 512;
half = 256;
Quart = 128;
eigth = 64;
var
Hz : real;
j : integer;
BaseTone : integer;
Offset : integer;
Tempo : real;
Voices : integer;
procedure Tone(f : real;d : integer);
var
frequency : longint;
begin
frequency := trunc(f* 65536);
SetVoiceSound(1,frequency,trunc(d*Tempo))
end; {Tone}
procedure Pause(d : integer;Tempo : real);
var
frequency : longint;
begin
if NOT Winevent then
begin
frequency := 65536;
SetVoiceSound(1,frequency,trunc(d*Tempo))
end
end; {Pause}
begin
Voices := OpenSound;
SetVoiceQueueSize(1,1024);
SetVoiceAccent(1,180,200,s_Staccato,83);
SetVoiceEnvelope(1,5,2);
case i of
HappyBirthDay :
begin
Tempo := 1;
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(a,half);
Tone(g,half);
Tone(c2,half);
Tone(h,full);
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(a,half);
Tone(g,half);
Tone(2*d,half);
Tone(c2,full);
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(g*2,half);
Tone(e*2,half);
Tone(c2,quart);
Tone(c2,quart);
Tone(c2,half);
Tone(a,half);
Tone(f*2,quart+eigth);
Tone(f*2,eigth);
Tone(e*2,half);
Tone(c2,half);
Tone(d*2,half);
Tone(c2,full);
end;
SongofJoy :
begin
Tempo := 4.0 / 3.0;
Tone(e,quart);
Tone(e,quart);
Tone(f,quart);
Tone(g,quart);
Tone(g,quart);
Tone(f,quart);
Tone(e,quart);
Tone(d,quart);
Tone(c,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,quart);
Tone(e,quart+eigth);
Tone(d,eigth);
Tone(d,half+quart);
Tone(e,quart);
Tone(e,quart);
Tone(f,quart);
Tone(g,quart);
Tone(g,quart);
Tone(f,quart);
Tone(e,quart);
Tone(d,quart);
Tone(c,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,quart);
Tone(d,quart+eigth);
Tone(c,eigth);
Tone(c,half+quart);
Tone(d,quart);
Tone(d,quart);
Tone(e,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,eigth);
Tone(f,eigth);
Tone(e,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,eigth);
Tone(f,eigth);
Tone(e,quart);
Tone(d,quart);
Tone(c,quart);
Tone(d,quart);
Tone(g/2,half);
Tone(e,half);
Tone(f,quart);
Tone(g,quart);
Tone(g,quart);
Tone(f,quart);
Tone(e,quart);
Tone(d,quart);
Tone(c,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,quart);
Tone(d,quart+eigth);
Tone(c,eigth);
Tone(c,half+quart);
end;
Bourree :
begin
Tempo := 1.0;
Tone(a,quart);
Tone(h,quart);
Tone(2*c,quart+eigth);
Tone(h,eigth);
Tone(a,quart+eigth);
Tone(gis,quart+eigth);
Tone(a,eigth);
Tone(h,quart+eigth);
Tone(e,quart+eigth);
Tone(fis,eigth);
Tone(gis,quart+eigth);
Tone(a,quart+eigth);
Pause(quart,Tempo);
Tone(g,quart);
Tone(f,quart);
Tone(e,quart+eigth);
Tone(d,eigth);
Tone(c,quart+eigth);
Tone(h/2,quart+eigth);
Tone(c,eigth);
Tone(d,quart+eigth);
Tone(e,quart+eigth);
Tone(d,quart);
Tone(c,quart);
Tone(h/2,quart);
Tone(a/2,half);
Pause(quart,Tempo)
end;
RadioHamburg :
begin
Tempo := 1.0;
Tone(f,quart);
Tone(d,quart);
Tone(g,quart);
Tone(e,half);
Tone(c,quart);
Pause(half,Tempo);
end;
Sailing :
begin
Tempo := 4.0 / 3.0;
Tone(e,quart);
Tone(g,quart);
Tone(a,half);
Tone(a,quart);
Pause(quart,Tempo);
Tone(h,quart);
Tone(d*2,quart);
Tone(e*2,half);
Tone(e*2,quart);
Pause(quart,Tempo);
Tone(e*2,quart+eigth);
Tone(d*2,eigth);
Tone(d*2,half);
Tone(c*2,quart+eigth);
Pause(eigth,Tempo);
Tone(c*2,quart+eigth);
Tone(h,eigth);
Tone(h,half);
Pause(eigth,Tempo);
Tone(c*2,quart);
Tone(h,quart);
Tone(a,half);
Tone(a,quart+eigth);
Pause(eigth,Tempo);
Tone(h,quart);
Tone(a,quart);
Tone(g,half);
Tone(g,quart+eigth);
Pause(eigth,Tempo);
Tone(e,quart);
Tone(e,quart);
Tone(h,half);
Tone(a,quart+eigth);
Pause(eigth,Tempo);
Tone(a,quart);
Tone(g,quart);
Tone(g,half);
Pause(quart,Tempo)
end;
Ding :
begin
Tempo := 1.5;
Tone(e,eigth);
Tone(e,eigth)
end;
DingDong :
begin
Tempo := 1.5;
Tone(e,eigth);
Tone(e,eigth);
Tone(c,eigth);
Tone(c,eigth)
end;
Alarm :
begin
BaseTone := 880;
Offset := 440;
for j := 1 to 200 do
begin
Hz := BaseTone + sin(j*2*3.1415/300)*Offset;
SetVoiceSound(1,trunc(Hz),10+j div 4)
end;
end;
end;
If Not Winevent then
StartSound
end; {Sounder}
{------------------------------------------------------------------}
{- Procedure DayofYear -}
{- for to find the number of a Day -}
{------------------------------------------------------------------}
Function TMainForm.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 TMainForm.Convert(A : Appoint;var b : Date);
var i : integer;
begin
b := ThisTime;
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 ShortWho -}
{- for to produce output without blanks -}
{------------------------------------------------------------------}
function TMainForm.ShortWho(Who:Char36) : string;
var i,Lasti : integer;
Last : boolean;
Result : String[36];
begin
Last := false;
Lasti:= 36;
for i:= 36 downto 1 do
if (Who[i] <> ' ') and not Last then
begin
Last := true;
Lasti := i;
end;
Result := '';
for i:= 1 to Lasti do
Result := Result + Who[i];
ShortWho := Result;
end;{ShortWho}
{------------------------------------------------------------------}
{- Procedure ShortTyp -}
{- for to produce output without blanks -}
{------------------------------------------------------------------}
function TMainForm.ShortTyp(Typ:Char32) : string;
var i,Lasti : integer;
Last : boolean;
Result : String[32];
begin
Last := false;
Lasti:= 32;
for i:= 32 downto 1 do
if (Typ[i] <> ' ') and not Last then
begin
Last := true;
Lasti := i;
end;
Result := '';
for i:= 1 to Lasti do
Result := Result + Typ[i];
ShortTyp := Result;
end;{ShortTyp}
{------------------------------------------------------------------}
{- Procedure Inspect -}
{- for to search for 'UND' -}
{------------------------------------------------------------------}
Function TMainForm.Inspect(s:string) : boolean;
var i : integer;
begin
Inspect := false;
for i:= 1 to 34 do
if UpCase(s[i]) = ' ' then
if UpCase(S[i+1]) = 'U' then
if UpCase(s[i+2]) = 'N' then
if UpCase(s[i+3]) = 'D' then
if UpCase(s[i+4]) = ' ' then
Inspect := true;
end;{Inspect}
{------------------------------------------------------------------}
{- Procedure Event -}
{- for to announce Events -}
{------------------------------------------------------------------}
Procedure TMainForm.Event(Who :Char36;Typ:Char32;
Month:Char2;Day:Char2;Year:Char4;
Diff : integer);
Var
Plural : boolean;
YearNum : integer;
begin
EventFound := true;
write(Texts,ShortWho(Who));
Plural := false;
Plural := Inspect(ShortWho(Who));
if Diff > 0 then
begin
if Diff = 1 then
begin
if Plural then
write(Texts,' haben morgen ')
else
write(Texts,' hat morgen ');
Sounder(DingDong)
end
else
begin
if Plural then
write(Texts,' haben in ',Diff:2,' Tagen ')
else
write(Texts,' hat in ',Diff:2,' Tagen ');
Sounder(Ding)
end;
writeln(Texts,ShortTyp(Typ),'.')
end;
if Diff = 0 then
begin
if Plural then
write(Texts,' haben heute ')
else
write(Texts,' hat heute ');
YearNum := (ord(Year[1])-ord('0'))*1000
+(ord(Year[2])-ord('0'))*100
+(ord(Year[3])-ord('0'))*10
+(ord(Year[4])-ord('0'));
YearNum := ThisTime.Year - YearNum;
if (Year = '0000') or (Year = ' ') or (YearNum = 0) then
writeln(Texts,ShortTyp(Typ),'.')
else if YearNum = 1 then
writeln(Texts,'ersten ',ShortTyp(Typ),'.')
else if YearNum = 3 then
writeln(Texts,'dritten ',ShortTyp(Typ),'.')
else
begin
if (YearNum mod 100) > 20 then
writeln(Texts,YearNum,'sten ',ShortTyp(Typ),'.')
else
writeln(Texts,YearNum,'ten ',ShortTyp(Typ),'.')
end;
if ShortTyp(Typ) = 'Geburtstag' then
Sounder(HappyBirthday)
else
Sounder(SongofJoy);
end;
if Diff < 0 then
begin
if abs(Diff) = 1 then
if Plural then
write(Texts,' hatten gestern ')
else
write(Texts,' hatte gestern ')
else
if Plural then
write(Texts,' hatten vor ',abs(Diff):2,' Tagen ')
else
write(Texts,' hatte vor ',abs(Diff):2,' Tagen ');
writeln(Texts,ShortTyp(Typ),'.')
end;
writeln(Texts);
end;{Event}
{------------------------------------------------------------------}
{- Procedure Appointment -}
{- for to look up Appointments -}
{------------------------------------------------------------------}
Procedure TMainForm.Appointment;
Type
TRecord = record
case boolean of
true : (a : string[80]);
false: (c: record
c1 : char;
b : Appoint
end);
end;
Var
Trec : TRecord;
i,Diff : integer;
Goal : Date;
YearDays : integer;
begin
ASSIGN(Events,'EREIGNIS.DAT');
{$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;
while not EOF(Events) do
begin
Readln(Events,TRec.a);
Convert(TRec.c.b,Goal);
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-Alert-1 then
Diff := Diff + YearDays;
if abs(Diff) <= Alert then
Event(TRec.c.b.Who,TRec.c.b.Typ,
TREc.c.b.Month,TREc.c.b.Day,
TRec.c.b.Year,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;
end;
Close(Events)
end;
Close(Texts);
end;{Appointment}
{------------------------------------------------------------------}
{- procedure Greetings -}
{- for to produce greetings -}
{------------------------------------------------------------------}
procedure TMainForm.Greetings;
begin
With ThisTime do
begin
if Hour < 12 then
Greeting := 'Guten Morgen'
else if Hour < 18 then
Greeting := 'Guten Tag'
else
Greeting := 'Guten Abend';
Assign(Texts,'Ansage.txt');
Rewrite(Texts);
write (Texts,Greeting,', heute ist ',Days[WeekDay],
', der ');
if Day = 1 then
write(texts,'erste ')
else if Day = 3 then
write(texts,'dritte ')
else
write(Texts,Day,'te ');
writeln(Texts,Months[Month],' ',Year,'.');
write(Texts,'Es ist jetzt ');
if Hour = 1 then
write(Texts,'ein')
else
write(Texts,Hour);
write(Texts,' Uhr ');
if Minute <> 0 then
writeln(Texts,Minute,'.')
else
writeln(Texts,'.');
end;
writeln(Texts)
end; {Greetings}
{------------------------------------------------------------------}
{- TextWindow -}
{------------------------------------------------------------------}
procedure TMainForm.TextWindow;
var
Lines : array[0..132] of char;
DC : HDC;
i : integer;
begin
{$I-} Reset(Texts);{$I+}
DC := GetDC(HWindow);
i := 1;
StrCopy(Lines,' ');
Textout(DC,1,i,Lines,StrLen(Lines));
While not Eof(Texts) do
begin
readln(Texts,Lines);
i := i + 24;
Textout(DC,1,i,Lines,StrLen(Lines));
end;
Close(Texts);
ReleaseDC(HWindow,DC)
end;{TexttoWindow}
{------------}
{ TTestDialog }
{-------------}
{procedure TTestDialog.IDBN1(var Msg: TMessage);
var
TextItem : PChar;
begin
TextItem := 'Item 1';
end;}
{--------------------------------------------------}
{ TMainForm's method implementations: }
{--------------------------------------------------}
constructor TMainForm.Init(AParent: PWindowsObject; ATitle: PChar);
var i : integer;
s : string;
begin
TWindow.Init(AParent, ATitle);
Attr.Menu := LoadMenu(HInstance, 'GEBURTSTAG');
EventFound := False;
WinEvent := false;
i := ParamCount;
if i > 0 then
begin
s := ParamStr(1);
for i := 1 to 20 do
s[i] := UpCase(S[i]);
if ParamCount > 0 then
begin
MessageBox(HWindow, 'Feature not implemented',
'Parameter', mb_Ok);Halt;
end;
end;
Months[1] := 'Januar';
Months[2] := 'Februar';
Months[3] := 'März';
Months[4] := 'April';
Months[5] := 'Mai';
Months[6] := 'Juni';
Months[7] := 'Juli';
Months[8] := 'August';
Months[9] := 'September';
Months[10] := 'Oktober';
Months[11] := 'November';
Months[12] := 'Dezember';
Days[1] := 'Montag';
Days[2] := 'Dienstag';
Days[3] := 'Mittwoch';
Days[4] := 'Donnerstag';
Days[5] := 'Freitag';
Days[6] := 'Sonnabend';
Days[0] := 'Sonntag';
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] := ' ';
Current(ThisTime);
if (ThisTime.Month = 11) and (ThisTime.Day = 6) Then
begin
Sounder(RadioHamburg);
Sounder(Bourree);
Sounder(RadioHamburg);
end
else if (ThisTime.Month = 2) and (ThisTime.Day = 12) Then
begin
Sounder(RadioHamburg);
Sounder(Sailing);
Sounder(RadioHamburg);
end
else if (ThisTime.Month = 3) and (ThisTime.Day = 21) Then
Sounder(Bourree)
else if (ThisTime.Month = 12) and (ThisTime.Day = 16) Then
Sounder(SongofJoy);
Greetings;
Appointment;
Just_started := TRUE;
end;
destructor TMainForm.Done;
begin
TWindow.Done;
end;
function TMainForm.CanClose: Boolean;
var
Reply: Integer;
begin
CanClose := False;
If EventFound then
begin
Reply := MessageBox(HWindow, 'Wirklich beenden ?',
'Es ist steht ein Ereignis an', mb_YesNo);
if Reply = id_No then
CanClose := False
else
CanClose := True;
end
else
CanClose := True
end;
procedure TMainForm.WMLButtonDown(var Msg: TMessage);
begin
MessageBox(HWindow, 'Wirklich beenden ?',
'Mausklick', mb_YesNo);
StopSound
end;
procedure TMainForm.WMMouseMove(var Msg: TMessage);
begin
StopSound
end;
procedure TMainForm.WMLButtonUp(var Msg: TMessage);
begin
StopSound
end;
procedure TMainForm.WMRButtonDown(var Msg: TMessage);
begin
StopSound
end;
procedure TMainForm.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
First: Boolean;
begin
If not Just_Started then
begin
Greetings;
Appointment;
end
else
Just_Started := FALSE;
TextWindow;
WaitSoundState(s_QueueEmpty);
StopSound;
CloseSound
end;
procedure Edit;
type
path = array[0..144] of char;
var
P,Q : path;
Buffer : PChar;
Editor : PChar;
begin
Buffer := @P;
Editor := @Q;
StrCopy(Editor, '');
GetCurDir(Buffer,0);
StrCopy(Editor, 'notepad.exe ');
StrCat(Editor,Buffer);
StrCat(Editor,'\');
StrCopy(Buffer, 'ereignis.dat');
StrCat(Editor,Buffer);
WinExec(Editor, sw_Normal)
end;
procedure TMainForm.FileNew(var Msg: TMessage);
begin
Edit;
end;
procedure TMainForm.FileChange(var Msg: TMessage);
begin
Edit;
end;
procedure TMainForm.FileDelete(var Msg: TMessage);
begin
Edit;
end;
procedure TMainForm.FileEnd(var Msg: TMessage);
begin
if CanClose then
Done
end;
procedure TMainForm.FileHelp(var Msg: TMessage);
var
HelpWnd : PWindow;
begin
HelpWnd := New(PWindow,Init(@Self,'Help System'));
With HelpWnd^.Attr do
begin
Style := Style or ws_PopupWindow or ws_Caption;
X := 100;
Y := 100;
W := 300;
H := 300
end;
Application^.MakeWindow(HelpWnd);
end;
{------------------------------------------------------------------}
{- procedure Help -}
{------------------------------------------------------------------}
procedure TMainForm.About(var Msg: TMessage);
begin
Application^.ExecDialog(New(PTestDialog, Init(@Self, 'ABOUT')));
end;{Help}
{--------------------------------------------------}
{ TMyApplication's method implementations: }
{--------------------------------------------------}
procedure TMyApplication.InitMainWindow;
begin
MainWindow := New(PMyWindow, Init(nil, 'Geburtstagsprogramm '+Version));
end;
{--------------------------------------------------}
{ Main program: }
{--------------------------------------------------}
var
MyApp : TMyApplication;
begin
MyApp.Init('MyProgram');
MyApp.Run;
MyApp.Done;
end.
{------------------------------------------------------------------}
{- End of program m -}
{------------------------------------------------------------------}
¤ Dauer der Verarbeitung: 0.100 Sekunden
(vorverarbeitet)
¤
|
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.
Die farbliche Syntaxdarstellung ist noch experimentell.
|
