Unit unittesticon;
{$mode objfpc}{$H+}
Interface
Uses
Classes, Sysutils, Forms, Controls, Graphics, Dialogs, Menus, ExtCtrls,
StdCtrls;
Type
{ TTestForm }
TTestForm = Class(Tform)
Image1 : Timage;
Image2 : Timage;
Listbox : Tlistbox;
Trayicon : Ttrayicon;
PuM_TrayIcon : Tpopupmenu;
Menuitem1 : Tmenuitem;
Menuitem2 : Tmenuitem;
Procedure ClickVoorGetal(Sender : Tobject);
Public
Getal : Integer;
Procedure UpdateTrayIcon;
End;
Var
TestForm : TTestForm;
Implementation
{$R *.lfm}
{ TTestForm }
Procedure TTestForm.ClickVoorGetal(Sender : Tobject);
Begin
Getal := Random(1000);
Caption := IntToStr(Getal);
Listbox.Items.Add(IntToStr(Getal));
ListBox.Invalidate;
UpdateTrayIcon;
End;
Procedure TTestForm.Updatetrayicon;
// Function to create an icon with a number on it
Function NewIcon(Aantal : Integer) : TIcon;
Var
WorkBitmap : TBitMap = nil; // Bitmap for creating Image
CountText : String = ''; // text to display
DesiredWidth, // optimal width
CountTextWidth, // width after font adjust
CountTextHeight, // height after font adjust
WidthOfset, // h-ofset to place text in center
HeightOfset : Integer; // v-ofset to place text in center
Begin
Result := TIcon.Create; // we have to return an icon
If Aantal = 0 Then Begin // Default image as result
Result.Assign(Image1.Picture.Bitmap); // standaard icoon
End
Else Begin // we create our own image
WorkBitmap := TBitmap.Create; // create a WorkBitmap
Try
WorkBitmap.Assign(Image2.Picture.Bitmap); // faded icoon as base
WorkBitmap.Canvas.Brush.Style := bsClear; // no background with text
WorkBitmap.Canvas.font.name := 'FreeSans'; // font settings
WorkBitmap.Canvas.font.Bold := True;
WorkBitmap.Canvas.font.Size := 60;
CountText := Format('%d',[Aantal]); // text we want to display
// we want the text to fill 80% of the icon
DesiredWidth := Trunc(WorkBitmap.Width * 0.8);
// while text is to small => increase font size
While (WorkBitmap.Canvas.TextWidth(CountText) < DesiredWidth) And
(WorkBitmap.Canvas.TextHeight(CountText) < DesiredWidth) Do
WorkBitmap.Canvas.font.size := WorkBitmap.Canvas.font.size + 2;
// in case the text is to big => decrease font size
While (WorkBitmap.Canvas.TextWidth(CountText) > DesiredWidth) And
(WorkBitmap.Canvas.TextHeight(CountText) > DesiredWidth) And
(WorkBitmap.Canvas.font.size > 10) Do
WorkBitmap.Canvas.font.size := WorkBitmap.Canvas.font.size - 2;
// calculate position
CountTextWidth := WorkBitmap.Canvas.TextWidth(CountText);
CountTextHeight := WorkBitmap.Canvas.TextHeight(CountText);
WidthOfset := (WorkBitmap.Width - CountTextWidth) Div 2;
HeightOfset := (WorkBitmap.Height - CountTextHeight) div 2;
// draw text (a little to the topleft) in white
WorkBitmap.Canvas.font.color := clWhite;
WorkBitmap.Canvas.TextOut(WidthOfset-8,HeightOfset-8,CountText);
// draw text (a little to the bottomright) in black
WorkBitmap.Canvas.font.color := clBlack;
WorkBitmap.Canvas.TextOut(WidthOfset+8,HeightOfset+8,CountText);
// draw the text in red
WorkBitmap.Canvas.font.color := clRed;
WorkBitmap.Canvas.TextOut(WidthOfset,HeightOfset,CountText);
// assign the resulting (bitmap) to our function-return
Result.Assign(WorkBitmap);
finally
// cleanup our working bitmap
FreeAndNil(WorkBitmap);
End;
End;
End;
Var
NumberIcon : TICon;
begin
// check-text in menuitem-caption
Menuitem2.Caption := Format('Aantal = %d',[Getal]);
// create a new icon with a number
NumberIcon := newicon(Getal);
Try
// clear the icon in the trayicon
TrayIcon.Icon.Clear;
// assign our newly created icon
TrayIcon.Icon.Assign(NumberIcon);
// let TrayIcon update itself
TrayIcon.InternalUpdate;
Finally
// cleanup our working icon
FreeandNil(NumberIcon);
End;
end;
End.