TTrayicon shows wrong (self painted) icon

Forum > LCL

(1/1)

Germo:
In my app I use a Trayicon, and to make it clear that there is some action needed i want the image on the Trayicon to display a number.
Creating this image and assigning it to the icon works most of the time. But sometimes there is a wrong number displayed. A number that has already been shown before.

I have been searching for some time now, but i can't seem to find a solution. Anyone here can point me in the right direction?

I created a small test program to display this behaviour.
It has an Image1 that is the default (numberless) icon, and a Image2 that is a faded version of Image1
I binded some click events to ClickVoorGetal procedure.

I am using: Free Pascal Compiler version 3.2.2-r0d122c49 [2024/02/09] for x86_64 on Ubuntu 22.04.5

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---Unit unittesticon;{$mode objfpc}{$H+}InterfaceUses 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 itFunction 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 centerBegin 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.

Navigation

[0] Message Index