PureBasic Forums - English

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

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

Code: Select all

If LibID
  CloseLibrary(LibID)
EndIf