We gaan de puntjes op de i zetten.
In deze laatste aflevering gaan we de volgende punten behandelen:
- Bestaande waarden van het alarm bij opstarten frmAlarmSettings meenemen;
- Alleen de naam van de externe sound tonen en het pad daarvan in de Hint;
- De knop Snooze van frmAlarm implementeren;
- Hint met datum toevoegen aan de klok;
- Icoontjes menu uitbreiden;
- Reset mogelijkheid inbouwen;
- Icoontje toevoegen aan het Project;
- Compiler opties minimaliseren voor een “kleine” executable.
Genoeg te doen dus.
Alarm-instellingen met de juiste waardes
Wanneer we via frmAlarmSettings zaken hebben veranderd en we keren terug naar de klok, dan worden er allerlei globale variabelen van een waarde voorzien. Keren we echter terug naar het Settings-scherm dan zien we deze waarden niet terug. Dit moeten we dus even aanpassen.
– Ga naar de code van frmAlarmSettings (Unit4).
– Ga naar FromActivate.
– De eerste twee regels moeten worden omgedraaid en als volgt worden aangepast:
– SoundNameTmp := SoundName;
– lblAlarm.Caption := SoundNameTmp;
– Voeg hierna de volgende twee regels toe:
– edtAlarmText.Text := AlarmTekst;
– dtpAlarmTijd.Time := AlarmTijd;
– Run het klokje en experimenteer met de instellingen en kijk of deze nu goed staan wanneer Settings opnieuw wordt geopend.
– Laad tot slot nog even een externe sound en klik daarna op de knop OK.
Na de laatste handeling staat nu de volledige naam van het externe bestand op het venster, inclusief het pad en onze eigen toevoeging FILE:. Dit is niet de bedoeling. We willen alleen de bestandsnaam zien.
Hints
De padverwijzing kan dan in de Hint (dit is het gele labeltje in Windows als je met de muis iets aanwijst). En uiteraard moet de toevoeging FILE: al helemaal niet zichtbaar zijn.
Nu wordt lblAlarm op drie verschillende plaatsen veranderd. We moeten dus een generieke oplossing voor het Label hebben. We zouden hier profijt hebben als er een Label-OnChange event zou bestaan, maar helaas, deze bestaat niet. Dus maar gewoon een procedure maken.
– Ga naar de code van frmAlarmSettings (Unit4).
– Voeg in de class-definitie in de sectie private de volgende regel toe:
– procedure HintAan;
– Ga naar de implementation-sectie en voeg na de function StopAlarm (na { TfrmAlarmSettings }) de volgende code toe:
– procedure TfrmAlarmSettings.HintAan;
– var
– s: String;
– begin
– if LeftStr(UpperCase(SoundNameTmp),5) = ‘FILE:’ then
– begin
– s := Copy(SoundNameTmp,6,Length(SoundNameTmp));
– lblAlarm.Caption := ExtractFileName(s);
– lblAlarm.Hint := ExtractFilePath(s);
– lblAlarm.ShowHint := True;
– end
– else
– begin
– lblAlarm.ShowHint := False;
– lblAlarm.Caption := SoundNamenTmp;
– end;
– end;
– Ga naar het event btnOtherAlarmClick.
– Haal de regel lblAlarm.Caption := … weg.
– Verander de regel SoundNameTmp := … als volgt:
– SoundNameTmp := ‘FILE:’ + dlgOpenFile.FileName;
– Voeg hierna de volgende regel toe:
– HintAan;
– Ga naar FormActivate.
– Vervang de regel lblAlarm.Caption := … door:
– HintAan;
– Ga naar lstAlarmClick.
– Vervang de code door de volgende regels:
– SoundNameTmp := lstAlarm.Items[lstAlarm.ItemIndex];
– HintAan;
– Run het klokje en kijk of bovenstaande werkt.
In de property Hint staat wat er in het gele labeltje moet komen te staan. Met de property ShowHint activeert of deactiveert u de Hint.
Snooze
We gaan nu de Snooze-knop implementeren. Als het alarm afgaat en de gebruiker klikt op Snooze dan moet het alarm na 5 minuten nogmaals afgaan. Uiteraard is deze 5 minuten arbitrair en het staat u natuurlijk vrij om hier een andere tijdseenheid voor te kiezen of deze zelfs variabel te maken. Met al uw kennis die u nu heeft moet dat te doen zijn.
– Ga naar de code van frmAlarm (Unit5).
– Activeer het event lblSnoozeClick.
– Voeg de volgende variabele toe:
– var
– u,m,s,ms: Word;
– Voeg (na begin) de volgende regels code toe:
– DecodeTime(Now,u,m,s,ms);
– if (m + 5) >= 60 then
– begin
– m := (m + 5) mod 60;
– u := u + 5;
– end
– else
– m := m + 5;
– AlarmTijd := EncodeTime(u,m,s,ms);
– AlarmAan := True;
– close;
– Run de klok en test de code. (Om “snel” te testen kunt u even de regel m := m + 1; voor AlarmTijd := … toevoegen).
Datum als Hint
Het is ook netjes om de datum weer te geven wanneer de klok wordt aangewezen.
– Ga naar de code van frmKlokje (Unit1).
– Ga naar FormActivate.
– Voeg de volgende regel code toe voor de regel LeesIni;:
– frmKlokje.Hint := FormatDateTime(‘dddd dd mmmm yyyy’,Now);
– Ga naar de Obejct Inspector en zet de property ShowHint van frmKlokje op True.
– Merk op dat nu ook (automatisch) de ShowHint-properties van lblTijd ene imgFace op True staan.
– Run de klok en wijs deze aan.
Dat zowel het Label als de ImageBox de Hint laten zien komt door de property ParentShowHint die default op True staat en de Hint van de Parent (hier frmKlokje) laat zien.
Dit was dus niet moeilijk. Alleen komt er een probleem wanneer de klok 00:00:00 slaat (ofwel op middernacht), want dan verandert de datum. Dit moet worden ondervangen in het Timer event tmrTijdTimer.
– Ga naar tmrTijdTimer.
– Voeg als laatste regels code toe (dus voor end;):
– if FormatDateTime(‘hh:mm:ss’,Now) = ’00:00:00′ then
– frmKlokje.Hint := FormatDateTime(‘dddd dd mmmm yyyy’,Now);
Menu-optie-icoontjes van een kleur voorzien
We hebben inmiddels aardig wat menu-opties toegevoegd en velen daarvan hebben nog geen icoontjes. U weet inmiddels hoe u deze kunt toevoegen: Icoontjes toevoegen aan ilstIconen en daarna de juiste index toevoegen aan de property ImageIndex van de menu opties.
Het zou mooi zijn als de kleur van de opties Hour, Minute en Second ook als icoontje zichtbaar zou zijn. Dit is echter niet zo eenvoudig.
Nu heeft een menu optie een property Bitmap, waarin een bitmap kan worden geladen als icoontje. En hiervan gaan we gebruik maken.
– Ga naar de code van frmKlokje (Unit1).
– Ga naar LeesIni.
– Voeg de volgende variabele toe:
– bm: TBitmap;
– Ga onder de regels staan waar u de indent ColorHour heeft verwerkt.
– Voeg daar de volgende regels toe:
– bm := TBitmap.Create;
– bm.Width := 16;
– bm.Height := 16;
– bm.Canvas.Brush.Color := ColorHour;
– bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
– popAnalogColorsHour.Bitmap := bm;
– bm.Free;
Doe ditzelfde onder de regels voor ColorMinute en ColorSecond, waarbij ColorHour en popAnalogColorsHour natuurlijk mee moeten veranderen.
Run het klokje en wijs in het menu de optie Analog–>Colors aan.
FloodFill
De kleurtjes staan er. Met de property Brush stelt u, o.a., de kleur in waarmee moet worden “geschilderd”. Met de method FloodFill schildert u de oppervlakte (16×16) van de bitmap. FloodFill heeft 4 paramters. De eerste twee zijn de x- en de y-coördinaat die de positie aangeven vanaf waar geschilderd moet worden. De derde parameter leest de kleur uit op een bepaalde plaats. De vierde parameter bepaalt waar de FloodFill moet stoppen. Als deze fsSurface is dan wordt er gevuld vanuit het aangegeven punt totdat er een andere kleur dan de derde parameter wordt gevonden. Als deze fsBorder is dan wordt er gevuld totdat dezelfde kleur is gevonden.
Met deze methode kan dus een willekeurig figuur met een bepaalde kleur worden gevuld.
De icoontjes moeten natuurlijk van kleur veranderen als er een andere kleur wordt gekozen. Dit gebeurt in het popAnalogColorsClick event.
– Ga naar popAnalogColorsClick.
– Voeg in het if dlgColor.Execute then-blok na de case-constructie de volgende regels toe:
– bm := TBitmap.Create;
– bm.Width := 16;
– bm.Height := 16;
– bm.Canvas.Brush.Color := c;
– bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
– (Sender as TMenuItem).Bitmap := bm;
– bm.Free;
– Run het klokje en kijk of de kleur van de icoontjes mee veranderen als u de kleur van een wijzer verandert.
Voeg naar smaak nog andere icoontjes voor de menu opties toe, behalve voor de opties met al dan niet een vinkje!
Reset klokje
Het kan voorkomen dat bij het starten het klokje niet zichtbaar wordt. Bijvoorbeeld als de laatste keer het klokje op het tweede scherm stond en bij het opnieuw starten het tweede scherm niet actief is.
Command-line Switch
We moeten dus een “reset” mogelijkheid inbouwen. Dit is gelukkig niet zo erg ingewikkeld. We gaan een zogenaamde command-line-switch implementeren: -reset. Wanneer iemand nu klokje.exe -reset gebruikt dan moet het cfg-bestand default-waardes krijgen. Het is dan wel zo netjes om een copy van het bestaande cfg-bestand te bewaren.
Een en ander gaan we implementeren in het FormCreate-event. Dit event wordt uitgevoerd bij het aanmaken van het Form, dus nog voordat het Form is getekend.
– Ga naar de code van frmKlokje (Unit1).
– Activeer het FormCreate-event.
– Voeg de volgende variabelen toe:
– var
– pad: string;
– membuf: TMemoryStream;
– cf: TextFile;
– Voeg na begin de volgende code toe:
– if FindCmdLineSwitch(‘reset’,[‘ ‘,’-‘,’\’,’/’],False) then
– begin
– pad := GetAppConfigDir(True);
– if RightStr(pad,1) <> ‘\’ then
– pad := pad + ‘\’;
– if FileExists(pad + ‘klokje.cfg’) then
– begin
– membuf := TMemoryStream.Create;
– membuf.LoadFromFile(pad + ‘klokje.cfg’);
– membuf.SaveToFile(pad + ‘klokje_’ + FormatDateTime(‘yyyymmdd_hh_nn_ss’,Now) + ‘.cfg’);
– membuf.Free;
– end;
– AssignFile(cf,pad + ‘klokje.cfg’);
– ReWrite(cf);
– Writeln(cf,'[CLOCK]’);
– Writeln(cf,’OnTop=-1′);
– Writeln(cf,’Position-X=60′);
– Writeln(cf,’Position-Y=5′);
– Writeln(cf,’Analog=0′);
– Writeln(cf,”);
– Writeln(cf,'[FONT]’);
– Writeln(cf,’Name=Microsoft Sans Serif’);
– Writeln(cf,’Size=16′);
– Writeln(cf,’ForeColor=0′);
– Writeln(cf,’BackColor=536870912′);
– Writeln(cf,’Style=Standard’);
– Writeln(cf,”);
– Writeln(cf,'[OPACITY]’);
– Writeln(cf,’Percentage=75′);
– Writeln(cf,”);
– Writeln(cf,'[ANALOG]’);
– Writeln(cf,’ColorHour=32768′);
– Writeln(cf,’ColorMinute=16711680′);
– Writeln(cf,’ColorSecond=255′);
– Writeln(cf,’ClockFace=0′);
– Writeln(cf,’ClockSize=Medium’);
– Writeln(cf,”);
– Writeln(cf,'[ALARM]’);
– Writeln(cf,’Sound=Alarm01′);
– Writeln(cf,’Text=Wake up!’);
– Writeln(cf,’Time=12:00:00′);
– Writeln(cf,’Fixed=0′);
– Writeln(cf,’On=0′);
– CloseFile(cf);
– ShowMessage(‘Klokje reset. Start program without switches.’);
– Halt(0);
– end;
Even wat uitleg bij de code.
Met FindCmdLineSwitch wordt er gekeken of de applicatie met een switch is geopend. De eerste parameter geeft de naam van de switch aan, de tweede is een verzameling van mogelijke scheidingstekens tussen de exe en de switch en de derde geeft aan of er onderscheid moet worden gemaakt tussen hoofd– en kleine letters.
Als de switch reset is gebruikt dan wordt er eerste een copy gemaakt van het huidige cfg-bestand. Hiervoor maken we gebruik van de methods LoadFromFile en SaveToFile van een MemoryStream. We gebruiken de MemoryStream dus verder niet.
Vervolgens maken we een nieuw cgf-bestand aan met default-waardes. Hiervoor gebruiken we een gewone TextFile.
Als dit allemaal gedaan is dan laat de applicatie een melding zien.
Tot slot wordt de applicatie weer afgesloten met de opdracht Halt. De parameter 0 geeft aan dat de applicatie goed (zonder fouten) is afgesloten (in Windows wordt deze waarde in ErrorLevel gezet, hiermee kunnen o.a. batch-files hun voordeel mee doen).
Klokje krijgt eigen icoon
Als het klokje is gestart dan ziet u in de taakbalk een knop met het (standaard) icoontje van Lazarus. Uiteraard wilt u hier uw eigen icoon. En dit gaan we nu doen.
– Ga in het Lazarus menu naar Project–>Project Opties… .
– Klik op de knop Load Icon.
– Kies een icoon naar keuze (max. 32 x 32 met 32 bits per pixel).
– Klik op de knop OK.
– Run het klokje en kijk in de taakbalk.
Dit was niet het moeilijkste. En het volgende is dat ook niet.
Exe(cutable) verkleinen
Wanneer u nu in de Verkenner naar de grootte van de executable kijkt dan ziet u dat deze rond de 30 MB zit. Dit komt mede door de resources die we hebben toegevoegd, zoals de icoontjes, de muziekjes en de klokwijzers, maar ook doordat Lazarus nogal wat debug-informatie heeft toegevoegd. Als de applicatie los wordt gebruikt dan heeft u deze debug-informatie niet nodig. Via de compiler-opties kunt u deze informatie “eruit” gooien.
– Ga in het Lazarus menu naar Project–>Project Opties… .
– Klik in de linker Listbox op de optie Debugging.
– Zet het vinkje voor Generate debugging info for GDB uit.
– Zet het vinkje voor de optie Strip symbols from executable aan.
– Klik op de knop OK.
– Run het klokje.
In de Verkenner kunt u nu zien dat uw klokje nog maar rond de 10 MB groot is, toch een besparing van zo’n 60 à 70%.
We zijn klaar met al onze puntjes.
Ik hoop dat u er veel van geleerd heeft. Het is een eenvoudig projectje, maar met heel veel technieken die u in een groter project ook zeker zal willen gebruiken.
Natuurlijk kunt u het klokje naar believen aanpassen en uitbreiden.
Code
Rest mij niets anders dan u nog alle code te geven:
Hieronder de code voor Unit1 t/m Unit5:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Menus, Unit2, Unit3, Unit4, Unit5;
type
{ TfrmKlokje }
TfrmKlokje = class(TForm)
dlgColor: TColorDialog;
dlgFont: TFontDialog;
ilstIconen: TImageList;
ilstFaces: TImageList;
imgFace: TImage;
lblTijd: TLabel;
popAlarmSettings: TMenuItem;
popAnalogClockface: TMenuItem;
popSep2: TMenuItem;
popAbout: TMenuItem;
popAnalogColorsSecond: TMenuItem;
popAnalogColorsMinute: TMenuItem;
popAnalogColorsHour: TMenuItem;
popAnalogColors: TMenuItem;
popAnalogSizeSmall: TMenuItem;
popAnalogSizeMedium: TMenuItem;
popAnalogSizeBig: TMenuItem;
popAnalogSize: TMenuItem;
popAnalogOn: TMenuItem;
popAnalog: TMenuItem;
popFontForeColor: TMenuItem;
popFontBackColor: TMenuItem;
popFontFont: TMenuItem;
popFont: TMenuItem;
popSluit: TMenuItem;
popSep1: TMenuItem;
popOpacity25: TMenuItem;
popOpacity50: TMenuItem;
popOpacity75: TMenuItem;
popOpacity100: TMenuItem;
popOpacity: TMenuItem;
popOnTop: TMenuItem;
popMenu: TPopupMenu;
tmrTijd: TTimer;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure lblTijdDblClick(Sender: TObject);
procedure lblTijdMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lblTijdMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lblTijdMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lblTijdResize(Sender: TObject);
procedure popAboutClick(Sender: TObject);
procedure popAlarmSettingsClick(Sender: TObject);
procedure popAnalogClockfaceClick(Sender: TObject);
procedure popAnalogColorsClick(Sender: TObject);
procedure popAnalogOnClick(Sender: TObject);
procedure popAnalogSizeClick(Sender: TObject);
procedure popFontBackColorClick(Sender: TObject);
procedure popFontFontClick(Sender: TObject);
procedure popFontForeColorClick(Sender: TObject);
procedure popOnTopClick(Sender: TObject);
procedure popOpacity100Click(Sender: TObject);
procedure popOpacity25Click(Sender: TObject);
procedure popOpacity50Click(Sender: TObject);
procedure popOpacity75Click(Sender: TObject);
procedure popSluitClick(Sender: TObject);
procedure tmrTijdTimer(Sender: TObject);
private
{ private declarations }
procedure LeesIni;
procedure SchrijfIni;
public
{ public declarations }
end;
var
frmKlokje: TfrmKlokje;
FaceIndex: integer;
SoundName: String;
AlarmAan: Boolean;
AlarmTijd: TDateTime;
AlarmTekst: String;
AlarmFixed: Boolean;
implementation
{$R *.lfm}
Uses
IniFiles, Math;
var
MD, Analoog: Boolean;
MyX, MyY, ClockSize: integer;
ColorHour, ColorMinute, ColorSecond: TColor;
{ TfrmKlokje }
procedure TfrmKlokje.LeesIni;
var
ini: TINIFile;
s, h: String;
i: integer;
bm: TBitmap;
begin
ini := TINIFile.Create(GetAppConfigFile(True));
try
s := ini.ReadString(‘CLOCK’,’OnTop’,”);
if s = ‘-1’ then
begin
frmKlokje.FormStyle := fsSystemStayOnTop;
popOnTop.Checked := True;
end
else
begin
frmKlokje.FormStyle := fsNormal;
popOnTop.Checked := False;
end;
s := ini.ReadString(‘CLOCK’,’Position-X’,”);
if TryStrToInt(s,i) then
frmKlokje.Left := i
else
frmKlokje.Left := 256;
s := ini.ReadString(‘CLOCK’,’Position-Y’,”);
if TryStrToInt(s,i) then
frmKlokje.Top := i
else
frmKlokje.Top := 130;
s := ini.ReadString(‘CLOCK’,’Analog’,”);
Analoog := (s = ‘-1’);
popAnalogOn.Checked := Analoog;
s := ini.ReadString(‘FONT’,’Name’,’Arial’);
lblTijd.Font.Name := s;
s := ini.ReadString(‘FONT’,’Size’,”);
if TryStrToInt(s,i) then
lblTijd.Font.Size := i
else
lblTijd.Font.Size := 14;
lblTijd.Font.Style := [];
s := ini.ReadString(‘FONT’,’Style’,”);
s := s + ‘,’;
i := Pos(‘,’, s);
while i > 0 do
begin
h := Trim(Copy(s,1,i-1));
if UpperCase(h) = ‘BOLD’ then
lblTijd.Font.Style := lblTijd.Font.Style + [fsBold];
if UpperCase(h) = ‘ITALIC’ then
lblTijd.Font.Style := lblTijd.Font.Style + [fsItalic];
if UpperCase(h) = ‘STRIKEOUT’ then
lblTijd.Font.Style := lblTijd.Font.Style + [fsStrikeOut];
if UpperCase(h) = ‘UNDERLINE’ then
lblTijd.Font.Style := lblTijd.Font.Style + [fsUnderline];
s := Copy(s,i+1,Length(s));
i := Pos(‘,’, s);
end;
s := ini.ReadString(‘FONT’,’ForeColor’,”);
if TryStrToInt(s,i) then
lblTijd.Font.Color := i
else
lblTijd.Font.Color := RGBToColor(0, 0, 0); //zwart
s := ini.ReadString(‘FONT’,’BackColor’,”);
if TryStrToInt(s,i) then
frmKlokje.Color := i
else
frmKlokje.Color := RGBToColor(127, 127, 127); //grijs
popOpacity100.Checked := True;
popOpacity75.Checked := False;
popOpacity50.Checked := False;
popOpacity25.Checked := False;
frmKlokje.AlphaBlendValue := 255;
s := ini.ReadString(‘OPACITY’,’Percentage’,”);
if s = ’25’ then
begin
popOpacity100.Checked := False;
popOpacity25.Checked := True;
frmKlokje.AlphaBlendValue := 64;
end;
if s = ’50’ then
begin
popOpacity100.Checked := False;
popOpacity50.Checked := True;
frmKlokje.AlphaBlendValue := 128;
end;
if s = ’75’ then
begin
popOpacity100.Checked := False;
popOpacity75.Checked := True;
frmKlokje.AlphaBlendValue := 191;
end;
popAnalogSizeSmall.Checked := False;
popAnalogSizeMedium.Checked := False;
popAnalogSizeBig.Checked := False;
s := UpperCase(ini.ReadString(‘ANALOG’,’ClockSize’,”));
case s of
‘MEDIUM’:
begin
ClockSize := 160;
popAnalogSizeMedium.Checked := True;
end;
‘BIG’:
begin
ClockSize := 200;
popAnalogSizeBig.Checked := True;
end
else
begin
ClockSize := 120;
popAnalogSizeSmall.Checked := True;
end;
end;
s := ini.ReadString(‘ANALOG’,’ColorHour’,”);
if TryStrToInt(s,i) then
ColorHour := i
else
ColorHour := clGreen;
bm := TBitmap.Create;
bm.Width := 16;
bm.Height := 16;
bm.Canvas.Brush.Color := ColorHour;
bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
popAnalogColorsHour.Bitmap := bm;
bm.Free;
s := ini.ReadString(‘ANALOG’,’ColorMinute’,”);
if TryStrToInt(s,i) then
ColorMinute := i
else
ColorMinute := clBlue;
bm := TBitmap.Create;
bm.Width := 16;
bm.Height := 16;
bm.Canvas.Brush.Color := ColorMinute;
bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
popAnalogColorsMinute.Bitmap := bm;
bm.Free;
s := ini.ReadString(‘ANALOG’,’ColorSecond’,”);
if TryStrToInt(s,i) then
ColorSecond := i
else
ColorSecond := clRed;
bm := TBitmap.Create;
bm.Width := 16;
bm.Height := 16;
bm.Canvas.Brush.Color := ColorSecond;
bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
popAnalogColorsSecond.Bitmap := bm;
bm.Free;
s := ini.ReadString(‘ANALOG’,’ClockFace’,”);
if TryStrToInt(s,i) then
FaceIndex := i
else
FaceIndex := 0;
ilstFaces.GetBitmap(FaceIndex,imgFace.Picture.Bitmap);
s := ini.ReadString(‘ALARM’,’Sound’,”);
if s <> ” then
SoundName := s
else
SoundName := ‘Alarm01’;
s := ini.ReadString(‘ALARM’,’Text’,”);
if s <> ” then
AlarmTekst := s
else
AlarmTekst := ‘Wake up!!!’;
s := ini.ReadString(‘ALARM’,’Time’,”);
try
if s <> ” then
AlarmTijd := StrToTime(s)
else
AlarmTijd := StrToTime(’12:00:00′);
except
AlarmTijd := StrToTime(’12:00:00′);
end;
s := ini.ReadString(‘ALARM’,’Fixed’,”);
AlarmFixed := (s = ‘-1’);
s := ini.ReadString(‘ALARM’,’On’,”);
AlarmAan := (s = ‘-1’);
finally
ini.Free;
end;
end;
procedure TfrmKlokje.SchrijfIni;
var
ini: TINIFile;
opacperc, fstyle, cs: String;
begin
ini := TINIFile.Create(GetAppConfigFile(True));
try
ini.WriteString(‘CLOCK’,’OnTop’,BoolToStr(frmKlokje.FormStyle = fsSystemStayOnTop));
ini.WriteString(‘CLOCK’,’Position-X’,IntToStr(frmKlokje.Left));
ini.WriteString(‘CLOCK’,’Position-Y’,IntToStr(frmKlokje.Top));
ini.WriteString(‘CLOCK’,’Analog’,BoolToStr(Analoog));
ini.WriteString(‘FONT’,’Name’,lblTijd.Font.Name);
ini.WriteString(‘FONT’,’Size’,IntToStr(lblTijd.Font.Size));
fstyle := ‘Standard, ‘;
if fsBold in lblTijd.Font.Style then
fstyle := fstyle + ‘Bold, ‘;
if fsItalic in lblTijd.Font.Style then
fstyle := fstyle + ‘Italic, ‘;
if fsStrikeOut in lblTijd.Font.Style then
fstyle := fstyle + ‘StrikeOut, ‘;
if fsUnderline in lblTijd.Font.Style then
fstyle := fstyle + ‘Underline, ‘;
fstyle := Copy(fstyle,1,Length(fstyle)-2);
ini.WriteString(‘FONT’,’Style’,fstyle);
ini.WriteString(‘FONT’,’ForeColor’,IntToStr(lblTijd.Font.Color));
ini.WriteString(‘FONT’,’BackColor’,IntToStr(frmKlokje.Color));
if popOpacity100.Checked then
opacperc := ‘100’;
if popOpacity75.Checked then
opacperc := ’75’;
if popOpacity50.Checked then
opacperc := ’50’;
if popOpacity25.Checked then
opacperc := ’25’;
ini.WriteString(‘OPACITY’,’Percentage’,opacperc);
case ClockSize of
160: cs := ‘Medium’;
200: cs := ‘Big’
else
cs := ‘Small’
end;
ini.WriteString(‘ANALOG’,’ClockSize’,cs);
ini.WriteString(‘ANALOG’,’ColorHour’,IntToStr(ColorHour));
ini.WriteString(‘ANALOG’,’ColorMinute’,IntToStr(ColorMinute));
ini.WriteString(‘ANALOG’,’ColorSecond’,IntToStr(ColorSecond));
ini.WriteString(‘ANALOG’,’ClockFace’,IntToStr(FaceIndex));
ini.WriteString(‘ALARM’,’Sound’,SoundName);
ini.WriteString(‘ALARM’,’Text’,AlarmTekst);
ini.WriteString(‘ALARM’,’Time’,TimeToStr(AlarmTijd));
ini.WriteString(‘ALARM’,’Fixed’,BoolToStr(AlarmFixed));
ini.WriteString(‘ALARM’,’On’,BoolToStr(AlarmAan));
finally
ini.Free;
end;
end;
procedure TfrmKlokje.tmrTijdTimer(Sender: TObject);
const
fhw: Real = 0.4;
fmw: Real = 0.6;
fsw: Real = 0.8;
var
h,m,s,ms: Word;
wx, wy, c: integer;
begin
if Analoog then
begin
c := ClockSize div 2;
frmKlokje.Repaint;
DecodeTime(Now,h,m,s,ms);
frmKlokje.Canvas.Pen.Color := ColorHour;
frmKlokje.Canvas.Pen.Width := 5;
wx := Round(Cos(DegToRad(h * 30 + (m div 6) * 3 – 90)) * c * fhw) + c;
wy := Round(Sin(DegToRad(h * 30 + (m div 6) * 3 – 90)) * c * fhw) + c;
frmKlokje.Canvas.Line(c,c,wx,wy);
frmKlokje.Canvas.Pen.Color := ColorMinute;
frmKlokje.Canvas.Pen.Width := 3;
wx := Round(Cos(DegToRad(m * 6 – 90)) * c * fmw) + c;
wy := Round(Sin(DegToRad(m * 6 – 90)) * c * fmw) + c;
frmKlokje.Canvas.Line(c,c,wx,wy);
frmKlokje.Canvas.Pen.Color := ColorSecond;
frmKlokje.Canvas.Pen.Width := 1;
wx := Round(Cos(DegToRad(s * 6 – 90)) * c * fsw) + c;
wy := Round(Sin(DegToRad(s * 6 – 90)) * c * fsw) + c;
frmKlokje.Canvas.Line(c,c,wx,wy);
end
else
begin
lblTijd.Caption := FormatDateTime(‘hh:mm:ss’, Now);
end;
if AlarmAan then
if Time > AlarmTijd then
begin
AlarmAan := False;
frmAlarm.ShowModal;
end;
if FormatDateTime(‘hh:mm:ss’,Now) = ’00:00:00′ then
frmKlokje.Hint := FormatDateTime(‘dddd dd mmmm yyyy’,Now);
end;
procedure TfrmKlokje.lblTijdResize(Sender: TObject);
begin
frmKlokje.Width := lblTijd.Width;
frmKlokje.Height := lblTijd.Height;
end;
procedure TfrmKlokje.popAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;
procedure TfrmKlokje.popAlarmSettingsClick(Sender: TObject);
begin
frmAlarmSettings.ShowModal;
end;
procedure TfrmKlokje.popAnalogClockfaceClick(Sender: TObject);
begin
frmFaces.ShowModal;
ilstFaces.GetBitmap(FaceIndex,imgFace.Picture.Bitmap);
end;
procedure TfrmKlokje.popAnalogColorsClick(Sender: TObject);
var
s: String;
c: TColor;
bm: TBitmap;
begin
s := (Sender as TMenuItem).Name;
s := UpperCase(Copy(s,16,Length(s)));
case s of
‘HOUR’: c := ColorHour;
‘MINUTE’: c := ColorMinute;
‘SECOND’: c := ColorSecond;
end;
if s <> ” then
begin
dlgColor.Color := c;
if dlgColor.Execute then
begin
c := dlgColor.Color;
case s of
‘HOUR’: ColorHour := c;
‘MINUTE’: ColorMinute := c;
‘SECOND’: ColorSecond := c;
end;
bm := TBitmap.Create;
bm.Width := 16;
bm.Height := 16;
bm.Canvas.Brush.Color := c;
bm.Canvas.FloodFill(8,8,bm.Canvas.Pixels[8,8],fsSurface);
(Sender as TMenuItem).Bitmap := bm;
bm.Free;
end;
end;
end;
procedure TfrmKlokje.popAnalogOnClick(Sender: TObject);
begin
popAnalogOn.Checked := not popAnalogOn.Checked;
Analoog := popAnalogOn.Checked;
frmKlokje.Repaint;
end;
procedure TfrmKlokje.popAnalogSizeClick(Sender: TObject);
var
s: String;
begin
popAnalogSizeSmall.Checked := False;
popAnalogSizeMedium.Checked := False;
popAnalogSizeBig.Checked := False;
(Sender as TMenuItem).Checked := True;
s := (Sender as TMenuItem).Name;
s := Uppercase(Trim(Copy(s,14,Length(s))));
Case s of
‘MEDIUM’: ClockSize := 160;
‘BIG’: ClockSize := 200;
else
ClockSize := 120;
end;
frmKlokje.Repaint;
end;
procedure TfrmKlokje.popFontBackColorClick(Sender: TObject);
begin
dlgColor.Color := lblTijd.Color;
if dlgColor.Execute then
lblTijd.Color := dlgColor.Color;
end;
procedure TfrmKlokje.popFontFontClick(Sender: TObject);
begin
dlgFont.Font := lblTijd.Font;
if dlgFont.Execute then
lblTijd.Font := dlgFont.Font;
end;
procedure TfrmKlokje.popFontForeColorClick(Sender: TObject);
begin
dlgColor.Color := lblTijd.Font.Color;
if dlgColor.Execute then
lblTijd.Font.Color := dlgColor.Color;
end;
procedure TfrmKlokje.popOnTopClick(Sender: TObject);
begin
popOnTop.Checked := not popOnTop.Checked;
if popOnTop.Checked then
frmKlokje.FormStyle := fsSystemStayOnTop
else
frmKlokje.FormStyle := fsNormal;
end;
procedure TfrmKlokje.popOpacity100Click(Sender: TObject);
begin
popOpacity100.Checked := True;
popOpacity75.Checked := False;
popOpacity50.Checked := False;
popOpacity25.Checked := False;
frmKlokje.AlphaBlendValue := 255;
end;
procedure TfrmKlokje.popOpacity25Click(Sender: TObject);
begin
popOpacity100.Checked := False;
popOpacity75.Checked := False;
popOpacity50.Checked := False;
popOpacity25.Checked := True;
frmKlokje.AlphaBlendValue := 64;
end;
procedure TfrmKlokje.popOpacity50Click(Sender: TObject);
begin
popOpacity100.Checked := False;
popOpacity75.Checked := False;
popOpacity50.Checked := True;
popOpacity25.Checked := False;
frmKlokje.AlphaBlendValue := 128;
end;
procedure TfrmKlokje.popOpacity75Click(Sender: TObject);
begin
popOpacity100.Checked := False;
popOpacity75.Checked := True;
popOpacity50.Checked := False;
popOpacity25.Checked := False;
frmKlokje.AlphaBlendValue := 191;
end;
procedure TfrmKlokje.popSluitClick(Sender: TObject);
begin
close;
end;
procedure TfrmKlokje.lblTijdDblClick(Sender: TObject);
begin
close;
end;
procedure TfrmKlokje.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SchrijfIni;
end;
procedure TfrmKlokje.FormCreate(Sender: TObject);
var
pad: string;
membuf: TMemoryStream;
cf: TextFile;
begin
if FindCmdLineSwitch(‘reset’,[‘ ‘,’-‘,’\’,’/’],False) then
begin
pad := GetAppConfigDir(True);
if RightStr(pad,1) <> ‘\’ then
pad := pad + ‘\’;
if FileExists(pad + ‘klokje.cfg’) then
begin
membuf := TMemoryStream.Create;
membuf.LoadFromFile(pad + ‘klokje.cfg’);
membuf.SaveToFile(pad + ‘klokje_’ + FormatDateTime(‘yyyymmdd_hh_nn_ss’,Now) + ‘.cfg’);
membuf.Free;
end;
AssignFile(cf,pad + ‘klokje.cfg’);
ReWrite(cf);
Writeln(cf,'[CLOCK]’);
Writeln(cf,’OnTop=-1′);
Writeln(cf,’Position-X=60′);
Writeln(cf,’Position-Y=5′);
Writeln(cf,’Analog=0′);
Writeln(cf,”);
Writeln(cf,'[FONT]’);
Writeln(cf,’Name=Microsoft Sans Serif’);
Writeln(cf,’Size=16′);
Writeln(cf,’ForeColor=0′);
Writeln(cf,’BackColor=536870912′);
Writeln(cf,’Style=Standard’);
Writeln(cf,”);
Writeln(cf,'[OPACITY]’);
Writeln(cf,’Percentage=75′);
Writeln(cf,”);
Writeln(cf,'[ANALOG]’);
Writeln(cf,’ColorHour=32768′);
Writeln(cf,’ColorMinute=16711680′);
Writeln(cf,’ColorSecond=255′);
Writeln(cf,’ClockFace=0′);
Writeln(cf,’ClockSize=Medium’);
Writeln(cf,”);
Writeln(cf,'[ALARM]’);
Writeln(cf,’Sound=Alarm01′);
Writeln(cf,’Text=Wake up!’);
Writeln(cf,’Time=12:00:00′);
Writeln(cf,’Fixed=0′);
Writeln(cf,’On=0′);
CloseFile(cf);
ShowMessage(‘Klokje reset. Start program without switches.’);
Halt(0);
end;
end;
procedure TfrmKlokje.FormPaint(Sender: TObject);
var
aBitmap: TBitmap;
begin
if Analoog then
begin
aBitmap := TBitmap.Create;
aBitmap.Width := ClockSize; //frmKlokje.Width;
aBitmap.Height := ClockSize; //frmKlokje.Height;
aBitmap.Canvas.Brush.Color := clWhite;
aBitmap.Canvas.Ellipse(-1,-1,ClockSize+1,ClockSize+1);
SetShape(aBitmap);
aBitmap.Free;
lblTijd.Visible := False;
imgFace.Width := ClockSize;
imgFace.Height := ClockSize;
imgFace.Visible := True;
frmKlokje.Width := ClockSize;
frmKlokje.Height := ClockSize;
frmKlokje.Canvas.Pen.Color := clBlack;
frmKlokje.Canvas.Pen.Width := 1;
end
else
begin
imgFace.Visible := False;
frmKlokje.Width := lblTijd.Width;
frmKlokje.Height := lblTijd.Height;
aBitmap := TBitmap.Create;
aBitmap.Width := lblTijd.Width;
aBitmap.Height := lblTijd.Height;
aBitmap.Canvas.Brush.Color := clWhite;
aBitmap.Canvas.Rectangle(0,0,lblTijd.Width,lblTijd.Height);
SetShape(aBitmap);
aBitmap.Free;
lblTijd.Visible := True;
end;
end;
procedure TfrmKlokje.FormActivate(Sender: TObject);
begin
Analoog := False;
ClockSize := 120;
imgFace.Left := 0;
imgFace.Top := 0;
imgFace.Width := ClockSize;
imgFace.Height := ClockSize;
imgFace.Visible := False;
ColorHour := clGreen;
ColorMinute := clBlue;
ColorSecond := clRed;
FaceIndex := 0;
frmKlokje.Hint := FormatDateTime(‘dddd dd mmmm yyyy’,Now);
LeesIni;
end;
procedure TfrmKlokje.lblTijdMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MD := (Button = mbLeft);
MyX := X;
MyY := Y;
end;
procedure TfrmKlokje.lblTijdMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MD then
begin
frmKlokje.Left := frmKlokje.Left + (X – MyX);
frmKlokje.Top := frmKlokje.Top + (Y -MyY);
end;
end;
procedure TfrmKlokje.lblTijdMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MD := False;
end;
end.
unit Unit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls
,lclIntf
;
type
{ TfrmAbout }
TfrmAbout = class(TForm)
btnOK: TButton;
Label1: TLabel;
lblWebsite: TLabel;
procedure btnOKClick(Sender: TObject);
procedure lblWebsiteClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmAbout: TfrmAbout;
implementation
{$R *.lfm}
{ TfrmAbout }
procedure TfrmAbout.btnOKClick(Sender: TObject);
begin
close;
end;
procedure TfrmAbout.lblWebsiteClick(Sender: TObject);
begin
OpenURL(‘https://hjgsoft.nl’);
end;
end.
unit Unit3;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
{ TfrmFaces }
TfrmFaces = class(TForm)
btnLeft: TButton;
btnRight: TButton;
btnOK: TButton;
btnCancel: TButton;
imgFace: TImage;
lblIndex: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure btnLeftClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnRightClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure BrowseImages;
end;
var
frmFaces: TfrmFaces;
implementation
{$R *.lfm}
Uses
Unit1;
var
fi: integer;
{ TfrmFaces }
procedure TfrmFaces.BrowseImages;
begin
frmKlokje.ilstFaces.GetBitmap(fi,imgFace.Picture.Bitmap);
lblIndex.Caption := IntToStr(fi);
end;
procedure TfrmFaces.FormActivate(Sender: TObject);
begin
fi := FaceIndex;
BrowseImages;
end;
procedure TfrmFaces.btnLeftClick(Sender: TObject);
begin
Dec(fi);
if fi <0 then
fi := frmKlokje.ilstFaces.Count – 1;
BrowseImages;
end;
procedure TfrmFaces.btnCancelClick(Sender: TObject);
begin
close;
end;
procedure TfrmFaces.btnOKClick(Sender: TObject);
begin
FaceIndex := fi;
close;
end;
procedure TfrmFaces.btnRightClick(Sender: TObject);
begin
Inc(fi);
if fi >= frmKlokje.ilstFaces.Count then
fi := 0;
BrowseImages;
end;
end.
unit Unit4;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics,
Dialogs, StdCtrls, EditBtn, Calendar;
type
{ TfrmAlarmSettings }
TfrmAlarmSettings = class(TForm)
btnOtherAlarm: TButton;
btnPlay: TButton;
btnOK: TButton;
btnCancel: TButton;
chkAlarmOn: TCheckBox;
chkFixedTime: TCheckBox;
dtpAlarmTijd: TDateTimePicker;
edtAlarmText: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
lblAlarm: TLabel;
lstAlarm: TListBox;
dlgOpenFile: TOpenDialog;
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnOtherAlarmClick(Sender: TObject);
procedure btnPlayClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure lstAlarmClick(Sender: TObject);
private
{ private declarations }
procedure HintAan;
public
{ public declarations }
end;
function PlayAlarm(AlarmNaam: String): Boolean;
function StopAlarm: Boolean;
var
frmAlarmSettings: TfrmAlarmSettings;
implementation
{$R *.lfm}
Uses
Unit1, LResources, MMSystem;
var
SoundNameTmp: String;
function PlayAlarm(AlarmNaam: String): Boolean;
var
s: AnsiString;
begin
Result := True;
if AlarmNaam = ” then
Result := False;
try
if LeftStr(UpperCase(AlarmNaam),5) = ‘FILE:’ then
begin
PlaySound(PChar(Copy(AlarmNaam,6,Length(AlarmNaam))), 0,Snd_Async or Snd_FileName or Snd_NoDefault or Snd_Loop)
end
else
begin
s := LazarusResources.Find(AlarmNaam).Value;
if s <> ” then
PlaySound(@s[1], 0, Snd_Async or Snd_Memory or Snd_Loop)
else
Result := False;
end;
except
Result := False;
end;
end;
function StopAlarm: Boolean;
begin
Result := True;
try
PlaySound(nil, 0 ,0);
except
Result := False;
end;
end;
{ TfrmAlarmSettings }
procedure TfrmAlarmSettings.HintAan;
var
s: String;
begin
if LeftStr(UpperCase(SoundNameTmp),5) = ‘FILE:’ then
begin
s := Copy(SoundNameTmp,6,Length(SoundNameTmp));
lblAlarm.Caption := ExtractFileName(s);
lblAlarm.Hint := ExtractFilePath(s);
lblAlarm.ShowHint := True;
end
else
begin
lblAlarm.ShowHint := False;
lblAlarm.Caption := SoundNameTmp;
end;
end;
procedure TfrmAlarmSettings.btnCancelClick(Sender: TObject);
begin
close;
end;
procedure TfrmAlarmSettings.btnOKClick(Sender: TObject);
begin
SoundName := SoundNameTmp;
AlarmAan := chkAlarmOn.Checked;
AlarmTijd := dtpAlarmTijd.Time;
AlarmTekst := edtAlarmText.Text;
AlarmFixed := chkFixedTime.Checked;
close;
end;
procedure TfrmAlarmSettings.btnOtherAlarmClick(Sender: TObject);
begin
dlgOpenFile.Filter := ‘WAV|*.WAV’;
if dlgOpenFile.Execute then
begin
lstAlarm.ItemIndex := -1;
SoundNameTmp := ‘FILE:’ + dlgOpenFile.FileName;
HintAan;
end;
end;
procedure TfrmAlarmSettings.btnPlayClick(Sender: TObject);
begin
if btnPlay.Caption = ‘Play alarm’ then
begin
btnPlay.Caption := ‘Stop alarm’;
lstAlarm.Enabled := False;
if not PlayAlarm(SoundNameTmp) then
begin
ShowMessage(‘Alarm niet gevonden’);
btnPlay.Caption := ‘Play alarm’;
lstAlarm.Enabled := True;
end;
end
else
begin
btnPlay.Caption := ‘Play alarm’;
lstAlarm.Enabled := True;
StopAlarm;
end;
end;
procedure TfrmAlarmSettings.FormActivate(Sender: TObject);
var
i: integer;
u,m,s,ms: Word;
begin
SoundNameTmp := SoundName;
HintAan;
edtAlarmText.Text := AlarmTekst;
dtpAlarmTijd.Time := AlarmTijd;
lstAlarm.Clear;
for i := 1 to 10 do
if i < 10 then
lstAlarm.Items.Add(‘Alarm0’ + IntToStr(i))
else
lstAlarm.Items.Add(‘Alarm10’);
lstAlarm.ItemIndex := 0;
if not AlarmAan and not AlarmFixed then
begin
DecodeTime(Now,u,m,s,ms);
ms := 0;
s := 0;
if m >= 30 then
begin
u := u + 1;
m := 0;
end
else
m := 30;
dtpAlarmTijd.Time := EncodeTime(u,m,s,ms);
end;
end;
procedure TfrmAlarmSettings.lstAlarmClick(Sender: TObject);
begin
SoundNameTmp := lstAlarm.Items[lstAlarm.ItemIndex];
HintAan;
end;
initialization
{$I sounds.lrs}
end.
unit Unit5;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TfrmAlarm }
TfrmAlarm = class(TForm)
lblSnooze: TLabel;
lblOK: TLabel;
lblAlarmText: TLabel;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure lblOKClick(Sender: TObject);
procedure lblSnoozeClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmAlarm: TfrmAlarm;
implementation
{$R *.lfm}
Uses
Unit4, Unit1;
{ TfrmAlarm }
procedure TfrmAlarm.FormActivate(Sender: TObject);
begin
lblAlarmText.Caption := AlarmTekst;
PlayAlarm(SoundName);
end;
procedure TfrmAlarm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
StopAlarm;
end;
procedure TfrmAlarm.lblOKClick(Sender: TObject);
begin
close;
end;
procedure TfrmAlarm.lblSnoozeClick(Sender: TObject);
var
u,m,s,ms: Word;
begin
DecodeTime(Now,u,m,s,ms);
if (m + 5) >= 60 then
begin
m := (m + 5) mod 60;
u := u + 5;
end
else
m := m + 5;
AlarmTijd := EncodeTime(u,m,s,ms);
AlarmAan := True;
close;
end;
end.
Wellicht tot een volgende serie…