[SOLVED] THUMBBUTTON does not work in Laz 64

[Xenno]

My code below is to show thumb buttons on taskbar.

Code: Pascal  [Select][+][-]

1. uses ... ShlObj
2.  
3. ..
4. // in class
5. FTaskbarList: ITaskbarList;
6. FTaskbarList3: ITaskbarList3;  
7. ..
8.  
9. ..
10. // in FormCreate or FormShow
11. if (CheckWin32Version(6, 1)) then begin
12.   FTaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList;
13.   FTaskbarList.HrInit;
14.   if (Supports(FTaskbarList, ITaskbarList3, FTaskbarList3)) then begin
15.     FTaskbarList3 := CreateComObject(CLSID_TaskbarList) as ITaskbarList3;
16.   end;
17. end;          
18. ..
19.  
20. procedure TFormMain.PrcThumbButtons;
21. var
22.   Buttons: array [1..2] of THUMBBUTTON;
23.   i: Integer;
24. begin
25.   Buttons[1].iId := 41;
26.   if (FilePrior1.Enabled) then begin
27.     Buttons[1].dwFlags := THBF_ENABLED;
28.     Buttons[1].iBitmap := 0;
29.     StrCopy(Buttons[1].szTip, 'Prior');
30.   end else begin
31.     Buttons[1].dwFlags := THBF_DISABLED;
32.     Buttons[1].iBitmap := 1;
33.     StrCopy(Buttons[1].szTip, '');
34.   end;
35.  
36.   Buttons[2].iId := 42;
37.   if (FileNext1.Enabled) then begin
38.     Buttons[2].dwFlags := THBF_ENABLED;
39.     Buttons[2].iBitmap := 2;
40.     StrCopy(Buttons[2].szTip, 'Next');
41.   end else begin
42.     Buttons[2].dwFlags := THBF_DISABLED;
43.     Buttons[2].iBitmap := 3;
44.     StrCopy(Buttons[2].szTip, '');
45.   end;
46.  
47.   {$IFDEF FPC}
48.   if (FThumbButtonsFlag = '') then begin
49.     FTaskbarList3.ThumbBarSetImageList(Application.Handle, ImageList2.Reference[0].Handle);
50.     FTaskbarList3.ThumbBarAddButtons(Application.Handle, Length(Buttons), @Buttons);
51.   end else
52.     FTaskbarList3.ThumbBarUpdateButtons(Application.Handle, Length(Buttons), @Buttons);
53.   {$ELSE}
54.   if (FThumbButtonsFlag = '') then begin
55.     FTaskbarList3.ThumbBarSetImageList(Handle, ImageList2.Handle);
56.     FTaskbarList3.ThumbBarAddButtons(Handle, Length(Buttons), @Buttons);
57.   end else
58.     FTaskbarList3.ThumbBarUpdateButtons(Handle, Length(Buttons), @Buttons);  
59.   {$ENDIF}
60.  
61.   FThumbButtonsFlag := NewFlag;
62. end;    
63.  

It works on Delphi 32-bits, Delphi 64-bits, and Lazarus 32-bits but it fails on Lazarus 64-bits. I tried many things but still same result. It looks like Laz 64 feed different size of THUMBBUTTON.

Does anyone have experience and solution?

TIA,

[ASerge]

My code below is to show thumb buttons on taskbar.

Please make an example that can be compiled.
By the way in

Code: Pascal  [Select][+][-]

1.   if (Supports(FTaskbarList, ITaskbarList3, FTaskbarList3)) then begin
2.     FTaskbarList3 := CreateComObject(CLSID_TaskbarList) as ITaskbarList3;

why are you calling CreateComObject again? FTaskbarList3 has already been initialized with the Supports function.

[Xenno]

Please make an example that can be compiled.

Sure, attached.
32 bits in Laz 3.8 (OK)
64 bits in Laz 4.0 (not OK)

why are you calling CreateComObject again? FTaskbarList3 has already been initialized with the Supports function.

You are right. I was modifying the code in trying to find solution. Please refer to the attached code,

TIA,

[ASerge]

Sure, attached.
32 bits in Laz 3.8 (OK)
64 bits in Laz 4.0 (not OK)

Yes, it won't work in 64-bit.
Workaround: copy the definition of "THUMBBUTTON" and delete "packed" from it.
These are the new last lines of the example:

Code: Pascal  [Select][+][-]

1.   if FThumbButtonsFlag = '' then
2.   begin
3.     FTaskbarList3.ThumbBarSetImageList(Application.Handle, ImageList1.Reference[0].Handle);
4.     FTaskbarList3.ThumbBarAddButtons(Application.Handle, Length(Buttons), Pointer(@Buttons[1]));
5.   end
6.   else
7.     FTaskbarList3.ThumbBarUpdateButtons(Application.Handle, Length(Buttons), Pointer(@Buttons[1]));

You are right. I was modifying the code in trying to find solution. Please refer to the attached code,

Better:

Code: Pascal  [Select][+][-]

1.   FTaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList;
2.   FTaskbarList.HrInit;
3.   if not Supports(FTaskbarList, ITaskbarList3, FTaskbarList3) then
4.     FTaskbarList3 := nil;
5.   FThumbButtonsFlag := '';

Please add the issue to the FPC bug list.

[Xenno]

Confirmed. This workaround solves the issue.
The iId values are also correct in WMSYSCOMMAND WM_COMMAND.

Note: @Buttons also works instead of Pointer(@Buttons[1])

Thank you very much, ASerge.

[ASerge]

Note: @Buttons also works instead of Pointer(@Buttons[1])

I always test with {$T+} (in Project/Project Options.../Compiler Options/Parsing)
In this case, the compiler throws an error:
Error: Incompatible type for arg no. 3: Got "^Array[1..2] Of THUMBBUTTON", expected "LPTHUMBBUTTON"

[ASerge]

Added issue 41333 to the buglist.

[Xenno]

Thank you again, ASerge.

If anyone needs to implement THUMBBUTTON further, allow me to share code.

1. Add a private procedure to handle THUMBBUTTON when clicked and implement it, for example:

Code: Pascal  [Select][+][-]

1.   ...
2.   private
3.     procedure PrcThumbButtonClick(PrmId: Integer);
4.   ...
5.  
6. procedure TFormMain.PrcThumbButtonClick(PrmId: Integer);
7. begin
8.   ShowMessage('ID: ' + IntToStr(PrmId)); // replace this with yours
9. end;      

2. Add form's Windows message handler in public part of form class and implement it, for example:     

Code: Pascal  [Select][+][-]

1.   ...
2.   public
3.     function FncAppWndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
4.       lParam: LParam): LRESULT;  
5.   ...
6.  
7. function TFormMain.FncAppWndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
8.   lParam: LParam): LRESULT;
9. begin
10.   case uMsg of
11.     WM_COMMAND: begin
12.       if (HIWORD(WParam) = THBN_CLICKED) then
13.         PrcThumbButtonClick(LOWORD(WParam));
14.     end;
15.   end;
16.   Result := CallWindowProc(PrevAppWndProc, Ahwnd, uMsg, WParam, LParam);
17. end;

3. Add application's Windows message handler in unit's implementation section:

Code: Pascal  [Select][+][-]

1. var
2.   PrevAppWndProc: WNDPROC;
3.  
4. function AppWndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
5.   lParam: LParam): LRESULT; stdcall;
6. begin
7.   Result := FormMain.FncAppWndCallback(Ahwnd, uMsg, WParam, LParam);
8. end;

4. Insert code in Form show:

Code: Pascal  [Select][+][-]

1. PrevAppWndProc := Windows.WNDPROC(SetWindowLongPtr(Application.Handle, GWL_WNDPROC, PtrUInt(@AppWndCallback)));

 

Done. The application is ready to respond when a thumb button is clicked.


Cheers,

[ASerge]

If anyone needs to implement THUMBBUTTON further, allow me to share code.

Safer:

Code: Pascal  [Select][+][-]

1. uses Windows, Messages, CommCtrl, ComObj;
2. //...
3. function AppSubClassProc(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM;
4.   uISubClass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
5. var
6.   Self: TFormMain absolute dwRefData;
7. begin
8.   if (Msg = WM_COMMAND) and (HIWORD(WParam) = THBN_CLICKED) then
9.     Self.PrcThumbButtonClick(LOWORD(WParam));
10.   Result := DefSubclassProc(Wnd, Msg, WParam, LParam);
11. end;
12.  
13. procedure TFormMain.FormShow(Sender: TObject);
14. begin
15.   SetWindowSubclass(Application.Handle, @AppSubClassProc, 1, DWORD_PTR(Self));
16. end;