Vertically aligned to center string gadget

[Mistrel]

Having the text in my string gadgets always vertically aligned to top always bugged me. So I did something about it.

Here are some screenshots:



Example code here:

http://www.purebasic.fr/english/viewtop ... 12&t=44003

Better late than never, srod.

http://www.purebasic.fr/english/viewtop ... 13&t=17241

Code: Select all

Declare CreateAlignedStringGadget(GadgetID, x, y, Width, Height, String.s)
Declare FreeAlignedStringGadget(GadgetID)

Code: Select all

Global NewMap Glob_AlignedStringGadget_DummyMap.i()

Procedure CreateAlignedStringGadget(GadgetID, x, y, Width, Height, String.s)
  Protected NonClientMetrics.NONCLIENTMETRICS
  Protected WndRect.Rect
  Protected StringGadgetDummy
  Protected hFont
  Protected lfHeight
  Protected FontHeight
  Protected BorderWidth
  Protected AlignTopOffset
  Protected Remainder
  Protected LibID
  Protected Result
  Protected Style
  Protected Flags
  Static Ptr
  
  ;/ Create the dummy gadget
  StringGadgetDummy=StringGadget(#PB_Any,x,y,Width,Height,"")
  
  If Not StringGadgetDummy
    ProcedureReturn #False
  EndIf
  
  ;/ Get the default system message window font
  NonClientMetrics\cbSize=SizeOf(NONCLIENTMETRICS)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,SizeOf(NONCLIENTMETRICS),@NonClientMetrics,0)
  hFont=CreateFontIndirect_(@NonClientMetrics\lfMessageFont)
  
  ;/ Get the font height in pixels
  lfHeight=NonClientMetrics\lfCaptionFont\lfHeight
  FontHeight=Round(-lfHeight*72.0/GetDeviceCaps_(GetDC_(GadgetID(StringGadgetDummy)),#LOGPIXELSY),#PB_Round_Nearest)
  
  ;/ Get the border width beyond the client area
  GetClientRect_(GadgetID(StringGadgetDummy),@WndRect)
  BorderWidth=Height-WndRect\bottom-WndRect\top
  
  ;/ -4 pixels for the default 2 pixel whitespace border on top and bottom
  AlignTopOffset=Round((Height-BorderWidth-4-FontHeight)/2.0,#PB_Round_Up)
  
  ;/ -4 pixels for the default 2 pixel whitespace border on top and bottom
  AlignTopOffset=Round((Height-BorderWidth-4-FontHeight)/2.0,#PB_Round_Up)
  
  If AlignTopOffset-(Height-BorderWidth-4-FontHeight)/2.0
    Remainder=#True
  EndIf
  
  ;/ If the offset is negative then take the absolute value to shrink the
  ;/ dimensions instead of growing them
  AlignTopOffset=Abs(AlignTopOffset)
  
  ;/ Favor alignment to top if the alignment center is uneven
  If Remainder
    AlignTopOffset-1
  EndIf
  
  ;/ Always shrink or do nothing at all
  If AlignTopOffset<0
    AlignTopOffset=0
  EndIf
  
  ;/ Compensate for border discrepancies between classic and non-classic
  ;/ themes
  AlignTopOffset-2
  
  If Not Ptr
    LibID=OpenLibrary(#PB_Any,"uxtheme.dll")
    Ptr=GetFunction(LibID,"IsThemeActive")
  EndIf
  
  If Ptr
    If CallFunctionFast(Ptr)
      AlignTopOffset+1
    EndIf
  EndIf
  
  ;/ Adjust offsets
  x+BorderWidth/2
  y+BorderWidth/2+AlignTopOffset
  Width-BorderWidth
  Height-BorderWidth-AlignTopOffset
  
  Result=StringGadget(GadgetID,x,y,Width,Height,String.s)
  
  If GadgetID=#PB_Any
    GadgetID=Result
  EndIf
  
  If Not Result
    FreeGadget(StringGadgetDummy)
    ProcedureReturn #False
  EndIf
  
  ;/ Set the string gadget font tot he system default
  SendMessage_(GadgetID(GadgetID),#WM_SETFONT,hFont,#True)
  
  ;/ Adjust z-order
  SetWindowPos_(GadgetID(StringGadgetDummy),#HWND_BOTTOM,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
  SetWindowPos_(GadgetID(GadgetID),#HWND_BOTTOM,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
  
  ;/ Disable the dummy gadget through window styles so that it doesn't grey out
  Style=GetWindowLongPtr_(GadgetID(StringGadgetDummy),#GWL_STYLE)
  SetWindowLongPtr_(GadgetID(StringGadgetDummy),#GWL_STYLE,Style|#WS_DISABLED)
  
  ;/ Redraw window frame of string gadget
  Style=GetWindowLongPtr_(GadgetID(GadgetID),#GWL_EXSTYLE)
  SetWindowLongPtr_(GadgetID(GadgetID),#GWL_EXSTYLE,Style&(~#WS_EX_CLIENTEDGE))
  Flags=#SWP_FRAMECHANGED|#SWP_NOACTIVATE|#SWP_NOCOPYBITS|#SWP_NOMOVE|#SWP_NOREPOSITION|#SWP_NOSIZE|#SWP_NOZORDER
  SetWindowPos_(GadgetID(GadgetID),0,0,0,0,0,Flags)
  
  Glob_AlignedStringGadget_DummyMap(Str(GadgetID))=StringGadgetDummy
  
  ProcedureReturn GadgetID
EndProcedure

Procedure FreeAlignedStringGadget(GadgetID)
  Protected StringGadgetDummy
  
  StringGadgetDummy=Glob_AlignedStringGadget_DummyMap(Str(GadgetID))
  
  If StringGadgetDummy And IsGadget(StringGadgetDummy)
    FreeGadget(StringGadgetDummy)
  EndIf
  
  If GadgetID And IsGadget(GadgetID)
    FreeGadget(GadgetID)
  EndIf
  
  DeleteMapElement(Glob_AlignedStringGadget_DummyMap(),Str(GadgetID))
EndProcedure

[Trond]

It's not perfect, but it's a lot less code:

Code: Select all

Procedure AlignedInput(x, y, w, h, text.s)
  frame = ContainerGadget(#PB_Any, x, y, w, h, #PB_Container_Double)
  SetGadgetColor(frame, #PB_Gadget_BackColor, RGB(255, 255, 255))
  i = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(i))
    DrawingFont(GetGadgetFont(#PB_Default))
    fh = TextHeight("Wg")
  StopDrawing()
  FreeImage(i)
  ty = h/2-fh/2-2
  string = StringGadget(#PB_Any, 2, ty, w-4, fh, text, #PB_String_BorderLess)
  SetGadgetData(string, frame)
  CloseGadgetList()
  ProcedureReturn string
EndProcedure

Procedure FreeAlignedInput(Num)
  frame = GetGadgetData(num)
  FreeGadget(frame)
EndProcedure

#W = 512
#H = 384

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
AlignedInput(10, 10, 100, 35, "Hello")

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

[rsts]

Nice tips - both this and the start menu one.
Thanks for sharing, plus it's nice code to study.

cheers

[Mistrel]

That's a great idea, Trond. But it still uses 9x input borders with the Windows XP theme and also on Windows 7. So it's not quite as accurate a replica.

[Mistrel]

I removed this line from the original source:

Code: Select all

If LibID
  CloseLibrary(LibID)
EndIf

Since I'm keeping the pointer static, I probably shouldn't be unloading the library.

[Nituvious]

What exactly is this doing? I don't quite understand the post, and didn't get what was happening in the source. But it sure looks neat! Thanks for the tip, I am sure I can learn something from this!

[Mistrel]

It's actually creating two gadgets. The second one with the text has its borders removed and is "aligned" within the dummy gadget (in the back). The dummy gadget has been disabled so that it does not receive mouse input as well.

So it's really a fake string gadget because it uses two but has the appearance of just one.