PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

SetToolbarItemText()

https://www.purebasic.fr/english/viewtopic.php?t=30229

Page 1 of 1

SetToolbarItemText()

Posted: Mon Dec 24, 2007 12:07 pm
by gnozal
This code enables toolbar items with icon + text

Code: Select all

; 
; SetToolbarItemText() 
; 
Procedure.l SetToolbarItemText(Toolbar.l, TolbarItem.l, Text.s) 
  Protected i.l, hdc.l, hToolbar.l, ButtonInfo.TBBUTTONINFO, Size.SIZE , hFont.l, hFontOld.l
  Static *FakeButtonStrings 
  If *FakeButtonStrings = #Null 
    *FakeButtonStrings = AllocateMemory(256) ; should be enough [127 icons] 
    If *FakeButtonStrings 
      For i = 0 To 254 Step 2 
        PokeB(*FakeButtonStrings + i, 32) 
      Next 
    EndIf 
  EndIf 
  hToolbar = ToolBarID(Toolbar) 
  If hToolbar 
    ButtonInfo\cbSize = SizeOf(TBBUTTONINFO) 
    ButtonInfo\dwMask = #TBIF_TEXT | #TBIF_COMMAND |#TBIF_SIZE 
    ButtonInfo\pszText = @Text 
    ButtonInfo\idCommand = TolbarItem 
    hdc = GetDC_(hToolbar) 
    If hdc 
      hFont = SendMessage_(hToolbar, #WM_GETFONT, 0, 0)
      hFontOld = SelectObject_(hdc, hFont)
      CompilerIf #PB_Compiler_Unicode 
        GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_UTF8), @Size) 
      CompilerElse 
        GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_Ascii), @Size) 
      CompilerEndIf 
      ButtonInfo\cx = Size\cx + 10 
      SelectObject_(hdc, hFontOld)
      ReleaseDC_(hToolbar, hdc) 
    EndIf 
    If *FakeButtonStrings 
      SendMessage_(hToolbar, #TB_ADDSTRING, 0, *FakeButtonStrings) 
    EndIf 
    SendMessage_(hToolbar, #TB_SETBUTTONINFO, TolbarItem, @ButtonInfo) 
    SendMessage_(hToolbar, #TB_AUTOSIZE, 0, 0) 
  EndIf 
EndProcedure 
;  
; Test //////////////////////////////////////////////////////// 
; 
DataSection ;> 
    ToolbarImage_1: 
    ; [Packed]IncludeBinary "C:\PureBasic394\Program\16x16.ico" 
    ;{Original size = 894 bytes [packed = 558] 
    Data.l $0000037E 
    Data.l $037E434A,$A2060000,$2301B560,$81202091,$004D0098,$0411208C,$2328A206,$2691600C,$08284088,$06A09011,$A2B5C110,$421440C8 
    Data.l $88491D0A,$21056429,$8421D086,$A1494208,$696014A1,$43884024,$0E020924,$34488741,$C6A11CA4,$E68555D0,$39D78942,$450EFD01 
    Data.l $54050027,$009CEA1C,$6870477E,$213ED437,$86A5D0D5,$18C4430E,$50000BDA,$DB000217,$0FD1810B,$DDE040A9,$284E6903,$12CE020D 
    Data.l $0BEACEC0,$D096865D,$3A080332,$54B4AC01,$0A690608,$B085B4C6,$0A178012,$2852090B,$A1C5E430,$831850D0,$004E43B2,$D43429BE 
    Data.l $90D2121B,$4344E86A,$0D1AA1A0,$D1B08679,$82CD00AA,$B704A2B4,$496F7E6E,$3C408AEE,$3A050184,$820D6F80,$14150413,$E08085C1 
    Data.l $050758C0,$AC97272D,$3BFD0E67,$2A028003,$248AE004,$14F7C4BD,$F1247C89,$4BBA9229,$300553C0,$A78E3E9C,$89676301,$48A04054 
    Data.l $C900FF6E,$14C502FE,$9224D03A,$48A71229,$4F09531E,$CCB6E091,$20D92EF0,$8EDD0418,$FAC6C804,$14858897,$016B4BFA,$5389C034 
    Data.l $1201C48A,$C49114F2,$2EFE9FED,$18677FC9,$72F8E893,$3C25CC97,$B02F4BFF,$3057FE52,$2BA47624,$014A7245,$F2858A06,$B12EF92F 
    Data.l $8C61017F,$5DCBFB64,$6EF29F52,$9B24A920,$4836922F,$0A6552B2,$583C9458,$62174914,$8C16FF28,$B9666C91,$A8126903,$D12225FF 
    Data.l $452C0C2C,$54C995B2,$1229048A,$FEB714F7,$FC255225,$BCE0122F,$8770E150,$4783860A,$1FD16071,$3720B204,$49B1E0FE,$A8535EF2 
    Data.l $A2C3A280,$312F0048,$05FB614C,$BB40E357,$A1C904BA,$80AE04A4,$EC0343A8,$187B79FF,$50F0AC1B,$7A52592B,$D4DF1259,$A1902652 
    Data.l $4718B4C4,$3D80506E,$DB700118,$00836547,$8860A67C,$F8540244,$00003026 
    Data.b $00,$A8 
    ;} 
EndDataSection ;< 
; 
Procedure CatchPackedImage(ImageNumber.l, *Label) 
  Protected *Buffer, BufferLen.l, ReturnValue.l 
  BufferLen = PeekL(*Label) 
  If BufferLen 
    *Buffer = AllocateMemory(BufferLen) 
    If *Buffer 
      If UnpackMemory(*Label + 4, *Buffer) 
        ReturnValue = CatchImage(ImageNumber, *Buffer) 
      EndIf 
      FreeMemory(*Buffer) 
    EndIf 
  Else 
    ReturnValue = CatchImage(ImageNumber, *Label + 4) 
  EndIf 
  ProcedureReturn ReturnValue 
EndProcedure 
; 
If OpenWindow(0, 100, 200, 220, 150, "ToolBar text example", #PB_Window_SystemMenu) 
  If CreateToolBar(0, WindowID(0)) 
    ToolBarStandardButton(0,#PB_ToolBarIcon_New) 
    ToolBarStandardButton(1,#PB_ToolBarIcon_Open) 
    ToolBarStandardButton(2,#PB_ToolBarIcon_Save) 
    ToolBarImageButton(3, CatchPackedImage(0, ?ToolbarImage_1)) 
    ; 
    SetToolbarItemText(0, 0, "New") 
    SetToolbarItemText(0, 1, "Open file") 
    SetToolbarItemText(0, 2, "Save") 
    SetToolbarItemText(0, 3, "User Icon") 
  EndIf 
  Repeat 
    EventID = WaitWindowEvent() 
    Select EventID 
      Case #PB_Event_Menu 
        MessageRequester("Toolbar", "Item ID = "+Str(EventMenu()), #MB_ICONINFORMATION) 
      Case #PB_Event_CloseWindow 
        Break 
    EndSelect 
  ForEver 
EndIf 
End

Posted: Mon Dec 24, 2007 12:13 pm
by rsts
Seems ok in vista.

For some reason, the 'new' is truncated - N...

Looks nice tho.

cheers

Posted: Mon Dec 24, 2007 12:20 pm
by gnozal
rsts wrote:Seems ok in vista.

For some reason, the 'new' is truncated - N...

Looks nice tho.

cheers
Thanks, maybe a font size problem ?
Did you try add some constant to ButtonInfo\cx ?
Like

Code: Select all

...
If hdc 
      GetTextExtentPoint32_(hdc, Text, Len(Text), @Size) 
      ReleaseDC_(hToolbar, hdc) 
      ButtonInfo\cx = Size\cx + 4 ; <-------------------
EndIf
...

Posted: Mon Dec 24, 2007 1:28 pm
by Marco2007
thanx for that :D

WinXP

Posted: Mon Dec 24, 2007 2:08 pm
by Denis
It's Ok under Vista

Tks

Posted: Mon Dec 24, 2007 3:24 pm
by Dare
Thanks for sharing.

Have a great new year!

Posted: Mon Dec 24, 2007 5:10 pm
by Micko
Cool ! :D

Posted: Tue Feb 12, 2008 3:58 pm
by Inf0Byt3
Just one issue I found. You have to get the font that the toolbar is actually using and select it into the DC. It's not selected automatically. Otherwise the buttons will not reflect the real size of the text.

Code: Select all

Procedure.l SetToolbarItemText(Toolbar.l, TolbarItem.l, Text.s)
  Protected i.l, hdc.l, hToolbar.l, ButtonInfo.TBBUTTONINFO, Size.SIZE
  Static *FakeButtonStrings
  If *FakeButtonStrings = #Null
    *FakeButtonStrings = AllocateMemory(256) ; should be enough [127 icons]
    If *FakeButtonStrings
      For i = 0 To 254 Step 2
        PokeB(*FakeButtonStrings + i, 32)
      Next
    EndIf
  EndIf
  hToolbar = ToolBarID(Toolbar)
  If hToolbar
    ButtonInfo\cbSize = SizeOf(TBBUTTONINFO)
    ButtonInfo\dwMask = #TBIF_TEXT | #TBIF_COMMAND |#TBIF_SIZE
    ButtonInfo\pszText = @Text
    ButtonInfo\idCommand = TolbarItem
    hdc = GetDC_(hToolbar)
    If hdc
      hFont = SendMessage_(hToolbar, #WM_GETFONT, 0, 0);
      hFont2 = SelectObject_(hDC, hFont);
      CompilerIf #PB_Compiler_Unicode
       GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_UTF8), @Size)
      CompilerElse
       GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_Ascii), @Size)
      CompilerEndIf
      ButtonInfo\cx = Size\cx + 10
      SelectObject_(hDC, hFont2);
      ReleaseDC_(hToolbar, hdc)
    EndIf
    If *FakeButtonStrings
      SendMessage_(hToolbar, #TB_ADDSTRING, 0, *FakeButtonStrings)
    EndIf
    SendMessage_(hToolbar, #TB_SETBUTTONINFO, TolbarItem, @ButtonInfo)
    SendMessage_(hToolbar, #TB_AUTOSIZE, 0, 0)
  EndIf
EndProcedure
Works here on XP SP2...

Posted: Tue Feb 12, 2008 5:16 pm
by gnozal
Inf0Byt3 wrote:Just one issue I found. You have to get the font that the toolbar is actually using and select it into the DC.
Thanks, updated code in 1st post.

Posted: Tue Feb 12, 2008 5:42 pm
by Inf0Byt3
Thank YOU for the code. I've been waiting for this for a long time :).

Posted: Wed Dec 17, 2008 4:55 pm
by Seldon
I resume this post as I wonder if it would be possible to align the text on the right of the image and not only under ? :)

Posted: Wed Dec 17, 2008 11:36 pm
by Seldon
OK, I've found the style #TBSTYLE_LIST and did this:

Code: Select all

Procedure SetToolbarItemText(Toolbar.l, TolbarItem.l, Text.s) 
  Protected i.l, hdc.l, hToolbar.l, ButtonInfo.TBBUTTONINFO, Size.SIZE 
  Static *FakeButtonStrings
  
  hToolbar=ToolBarID(Toolbar)
  
  If *FakeButtonStrings=#Null
  
    SendMessage_(hToolbar,#TB_SETSTYLE,0,(SendMessage_(hToolbar,#TB_GETSTYLE,0,0))|#TBSTYLE_LIST)
    
    *FakeButtonStrings = AllocateMemory(256) ; should be enough [127 icons] 
    If *FakeButtonStrings 
      For i = 0 To 254 Step 2 
        PokeB(*FakeButtonStrings + i, 32) 
      Next 
    EndIf 
    If *FakeButtonStrings 
      SendMessage_(hToolbar, #TB_ADDSTRING, 0, *FakeButtonStrings) 
    EndIf     
  EndIf 
  
  If hToolbar 
    ButtonInfo\cbSize = SizeOf(TBBUTTONINFO) 
    ButtonInfo\dwMask = #TBIF_TEXT | #TBIF_COMMAND |#TBIF_SIZE 
    ButtonInfo\fsStyle = #TBSTYLE_AUTOSIZE    
    ButtonInfo\pszText = @Text 
    ButtonInfo\idCommand = TolbarItem 
    hdc = GetDC_(hToolbar) 
    If hdc 
      hFont = SendMessage_(hToolbar, #WM_GETFONT, 0, 0); 
      hFont2 = SelectObject_(hDC, hFont); 
      CompilerIf #PB_Compiler_Unicode 
       GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_UTF8), @Size) 
      CompilerElse 
       GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_Ascii), @Size) 
      CompilerEndIf 
      ButtonInfo\cx = Size\cx + 10 
      SelectObject_(hDC, hFont2); 
      ReleaseDC_(hToolbar, hdc) 
    EndIf 
   
    SendMessage_(hToolbar, #TB_SETBUTTONINFO, TolbarItem, @ButtonInfo) 
    SendMessage_(hToolbar, #TB_AUTOSIZE, 0, 0) 

  EndIf 
EndProcedure
But the text is truncated... for example 'New' is 'N...' , etc...

Posted: Thu Dec 18, 2008 1:49 am
by Sparkie
Try this edited version of your code Seldon...

Code: Select all

Procedure SetToolbarItemText(Toolbar.l, TolbarItem.l, Text.s) 
  Protected i.l, hdc.l, hToolbar.l, ButtonInfo.TBBUTTONINFO, Size.SIZE 
  Static *FakeButtonStrings 
  
  hToolbar=ToolBarID(Toolbar) 
  
  If *FakeButtonStrings=#Null 
    
    SendMessage_(hToolbar,#TB_SETSTYLE,0,(SendMessage_(hToolbar,#TB_GETSTYLE,0,0))|#TBSTYLE_LIST |#TBSTYLE_AUTOSIZE) 
    
    *FakeButtonStrings = AllocateMemory(256) ; should be enough [127 icons] 
    If *FakeButtonStrings 
      For i = 0 To 254 Step 2 
        PokeB(*FakeButtonStrings + i, 32) 
      Next 
    EndIf 
    If *FakeButtonStrings 
      SendMessage_(hToolbar, #TB_ADDSTRING, 0, *FakeButtonStrings) 
    EndIf      
  EndIf 
  
  If hToolbar 
    ButtonInfo\cbSize = SizeOf(TBBUTTONINFO) 
    ButtonInfo\dwMask = #TBIF_TEXT | #TBIF_COMMAND |#TBIF_STYLE 
    ButtonInfo\fsStyle = #TBSTYLE_AUTOSIZE    
    ButtonInfo\pszText = @Text 
    ButtonInfo\idCommand = TolbarItem 
    hdc = GetDC_(hToolbar) 
    If hdc 
      hFont = SendMessage_(hToolbar, #WM_GETFONT, 0, 0); 
      hFont2 = SelectObject_(hdc, hFont); 
      CompilerIf #PB_Compiler_Unicode 
      GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_UTF8), @Size) 
      CompilerElse 
      GetTextExtentPoint32_(hdc, Text, StringByteLength(Text, #PB_Ascii), @Size) 
      CompilerEndIf 
      ButtonInfo\cx = Size\cx + 10 
      SelectObject_(hdc, hFont2); 
      ReleaseDC_(hToolbar, hdc) 
    EndIf 
    
    SendMessage_(hToolbar, #TB_SETBUTTONINFO, TolbarItem, @ButtonInfo) 
    SendMessage_(hToolbar, #TB_AUTOSIZE, 0, 0) 
    
  EndIf 
EndProcedure
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited