Update v0.30r2
- Added Font Management
. * Added ScaleLoadFont, ScaleFreeFont, GetScaleFontName, GetScaleFontHeight, GetScaleFontStyle
. * Redirection LoadFont and FreeFont to ScaleLoadFont and ScaleFreeFont
. * Redirection SetGadgetFont to SetScaleFontID
- Removed SetScaleFontArray (Not longer used)
- Change ScaleAllGagdgets. Removed optional parameters
- Change SetScale. Removed optional parameter
- Added SetScaleModeFont(Mode)
. * #ScaleModeFontNone ; No scaling
. * #ScaleModeFontScaled ; Scaling with set scale factor
. * #ScaleModeFontDymanic (Default); Scaling complet
- Added SetScaleModeImage(Mode)
. * #ScaleModeImageNone ; No scaling
. * #ScaleModeImageScaled ; Scaling with set scale factor
. * #ScaleModeImageDymanic (Default); Scaling complet
- Change SetScaleMode(Mode)
. * #ScaleModeDynamic as default
- Bugfix v0.30r2
. * SetScaleImage
Example
- Fix Font Callback
Code: Select all
;-Example v0.30
IncludeFile "Modul_ScaleGadgets.pb"
CompilerIf #PB_Compiler_IsMainFile
UseModule ScaleGadgets
Enumeration Window 1
#Main
EndEnumeration
Enumeration Gadget
#Container0
#String0
#String1
#String2
#String3
#String4
#Container1
#ButtonB0
#ButtonB1
#ButtonB2
EndEnumeration
Enumeration MenuItem
#New
#Load
#Save
#Exit
EndEnumeration
Enumeration StatusBar
#StatusBar
EndEnumeration
; -----------------------------------------------------------------
Global ExitApplication
; -----------------------------------------------------------------
; -----------------------------------------------------------------
Global DPI.f = 1.25
Global MyFont1 = LoadFont(#PB_Any, "Courier New", 15, #PB_Font_Bold | #PB_Font_Italic)
Global MyFont2 = LoadFont(#PB_Any, "Comic Sans MS", 12)
SetScale(DPI)
; Force orinal PB-Funktion
Macro PB(Function)
Function
EndMacro
; -----------------------------------------------------------------
Procedure MyFontCB(Gadget, ScaleX.d, ScaleY.d)
Static old_fontsize
Protected fontsize
If ScaleX < ScaleY
fontsize = 18 * ScaleX
Else
fontsize = 18 * ScaleY
EndIf
If fontsize <> old_fontsize
old_fontsize = fontsize
LoadFont(0, "Arial New", fontsize, #PB_Font_Bold | #PB_Font_Underline | #PB_Font_Italic)
EndIf
PB(SetGadgetFont)(Gadget, FontID(0))
EndProcedure
; -----------------------------------------------------------------
Procedure MyFontCB2(Gadget, ScaleX.d, ScaleY.d)
Static old_fontsize
Protected fontsize
fontsize = 18 * ScaleY
If fontsize <> old_fontsize
old_fontsize = fontsize
LoadFont(1, "Arial New", fontsize, #PB_Font_Bold | #PB_Font_Underline | #PB_Font_Italic)
EndIf
PB(SetGadgetFont)(Gadget, FontID(1))
EndProcedure
; -----------------------------------------------------------------
Procedure GetStatus(Gadget)
Protected x, y, dx, dy, text.s
SetScaleMode(#ScaleModeReal)
x = GadgetX(Gadget)
y = GadgetY(Gadget)
dx = GadgetWidth(Gadget)
dy = GadgetHeight(Gadget)
text = "R = " + Str(x) + "/" + Str(y) + " - " + Str(dx) + "*" + Str(dy)
StatusBarText(#StatusBar, 1, text)
SetScaleMode(#ScaleModeScaled)
x = GadgetX(Gadget)
y = GadgetY(Gadget)
dx = GadgetWidth(Gadget)
dy = GadgetHeight(Gadget)
text = "S = " + x + "/" + y + " - " + dx + "*" + dy
StatusBarText(#StatusBar, 2, text)
SetScaleMode(#ScaleModeDynamic)
x = GadgetX(Gadget)
y = GadgetY(Gadget)
dx = GadgetWidth(Gadget)
dy = GadgetHeight(Gadget)
text = "D = " + x + "/" + y + " - " + dx + "*" + dy
StatusBarText(#StatusBar, 3, text)
EndProcedure
; -----------------------------------------------------------------
Procedure DoSizeWindow()
ScaleAllGadgets(#Main, MenuHeight() + StatusBarHeight(#StatusBar))
GetStatus(#Container0)
EndProcedure
; -----------------------------------------------------------------
Procedure OpenMain(x = 10, y = 10, width = 550, height = 415)
OpenWindow(#Main, x, y, width, height + MenuHeight(), "Module ScaleGadgets",
#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
If CreateMenu(0, WindowID(#Main))
; Mac Menu´s
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
MenuItem(#PB_Menu_About, "")
MenuItem(#PB_Menu_Preferences, "")
MenuItem(#PB_Menu_Quit, "")
CompilerEndIf
MenuTitle("&File")
MenuItem(#New, "&New")
MenuItem(#Load, "&Load")
MenuItem(#Save, "&Save")
MenuBar()
MenuItem(#Exit, "&Exit")
EndIf
CreateStatusBar(#StatusBar, WindowID(#Main))
AddStatusBarField(180)
AddStatusBarField(150)
AddStatusBarField(150)
AddStatusBarField(150)
StatusBarText(#StatusBar, 0, "ScaleGadgets: DPI = " + StrF(DPI *100) + "%")
ContainerGadget(#Container0, 10, 10, 530, 310, #PB_Container_Flat)
StringGadget(#String0, 10, 5, 510, 35, "Default Font")
StringGadget(#String1, 10, 45, 510, 35, "Font Courier")
StringGadget(#String2, 10, 85, 510, 35, "Font Callback")
StringGadget(#String3, 10, 125, 510, 35, "Font Callback (Scaled over gadget hight)")
StringGadget(#String4, 10, 165, 510, 35, "Font Comic MS, 12")
CloseGadgetList()
ContainerGadget(#Container1, 10, 330, 530, 50, #PB_Container_Single)
ButtonGadget(#ButtonB0, 10, 10, 160, 30, "Font Comic MS")
ButtonGadget(#ButtonB1, 180, 10, 170, 30, "Font Arial")
ButtonGadget(#ButtonB2, 360, 10, 160, 30, "Font Courier")
CloseGadgetList()
; Create array with fonts
;InitFontArray()
SetGadgetFont(#String1, FontID(MyFont1))
SetScaleFontCallback(#String2, @MyFontCB())
SetScaleFontCallback(#String3, @MyFontCB2())
SetGadgetFont(#String4, FontID(MyFont2))
EndProcedure
;-Main
OpenMain()
BindEvent(#PB_Event_SizeWindow, @DoSizeWindow())
GetStatus(#Container0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
ExitApplication = 1
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonB0
FreeFont(MyFont2)
MyFont2 = LoadFont(#PB_Any, "Comic Sans MS", 14)
SetGadgetText(#String4, "Font Comic Sans MS, 14")
SetGadgetFont(#String4, FontID(MyFont2))
Case #ButtonB1
FreeFont(MyFont2)
MyFont2 = LoadFont(#PB_Any, "Arial", 16, #PB_Font_Italic)
SetGadgetText(#String4, "Font Arial, 16")
SetGadgetFont(#String4, FontID(MyFont2))
Case #ButtonB2
FreeFont(MyFont2)
MyFont2 = LoadFont(#PB_Any, "Courier New", 17)
SetGadgetText(#String4, "Font Courier New, 17")
SetGadgetFont(#String4, FontID(MyFont2))
EndSelect
EndSelect
Until ExitApplication
End
CompilerEndIf
[/size]
