It is currently Mon Jun 18, 2018 11:57 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 21 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: DPI Aware Application
PostPosted: Sat Jan 02, 2010 2:39 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
Here is a example on how to make your app DPI aware and auto scalable based on DPI.
There are some tiny quirks though, and this source only works properly on Windows 6.x+
On XP there will be no change.
This example uses SetProcessDPIAware() the "proper" way is to use a DPI aware manifest,
follow the urls in the source comments for more details.
Below the source are two images, these where taken from Windows 7 (which allows changing DPI by only loging out/in instead of restarting).

Ideally PureBasic would have a DPI Aware option and do this internally etc. Maybe PureBasic 5.0 ? :P
I believe OSX has a similar feature, not sure about all the Linux variants though.

Code:
;Placed in the Public Domain by Roger Hågensen.

#PB_Compiler_Exe=#True ;This does not exist (yet?)

;http://msdn.microsoft.com/en-us/library/dd464660%28VS.85%29.aspx
Global _ScaleDPI_X_.f=1.0,_ScaleDPI_Y_.f=1.0
#DefaultDPIX=96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
#DefaultDPIY=96.0
Procedure InitScaleDPI() ;Windows 5.0 or higher needed for minimum functionality of this procedure.
 Protected dpiaware.l=#False,dc.i,lpx.i,lpy.i,dll.i,*SetProcessDPIAware,*IsProcessDPIAware,ncm.NONCLIENTMETRICS,font$,font.i
 ;This part is Windows 6.x+ only (Vista etc.) and must be done before we use devcaps.
 ;http://msdn.microsoft.com/en-us/library/dd464660%28VS.85%29.aspx#declaring_dpi_awareness
 ;You really should use the DPI aware manifest instead of SetProcessDPIAware() when possible.
 ;On Windows 2000 and XP the manifest has no effect and set dpi aware is not available,
 ;however Devicecaps still returns usefull info that can be used.
 ;Note! If the dpi aware manifest is missing on Vista and Win7 then the OS will lie on devicecaps and will autoscale the entire app window.
 CompilerIf #PB_Compiler_Exe ;Only use this in exes, as dlls inherit DPI from the calling process.
  ;If the exe or the calling exe in case of this being a dll is allready dpi aware (like through a manifest),
  ;then we skip using the the set dpi aware function, a dll should never use the set function, but it should check if the process id dpi aware
  ;and apply the proper modifiers where appropriate obviously.
  dll=OpenLibrary(#PB_Any,"user32.dll")
  If dll
     *IsProcessDPIAware=GetFunction(dll,"IsProcessDPIAware")
   If *IsProcessDPIAware
    dpiaware=CallFunctionFast(*IsProcessDPIAware)
   EndIf
   If Not dpiaware
      *SetProcessDPIAware=GetFunction(dll,"SetProcessDPIAware")
      If *SetProcessDPIAware
       CallFunctionFast(*SetProcessDPIAware)
      EndIf
   EndIf
  EndIf
 CompilerEndIf
 dc=GetDC_(#Null)
 If dc
    lpx=GetDeviceCaps_(dc,#LOGPIXELSX)
    lpy=GetDeviceCaps_(dc,#LOGPIXELSY)
    If lpx>0
     _ScaleDPI_X_=lpx/#DefaultDPIX
    EndIf
    If lpy>0
     _ScaleDPI_Y_=lpy/#DefaultDPIY
    EndIf
    ReleaseDC_(#Null,dc)
 EndIf
 ;Get the system font for message boxes etc.
 ;We default to a size of 9, which is also the Vista and Win7 default size.
 ;The OS will automatically (Vista and Win7 at least) scale the font per the current user's DPI setting.
 ncm\cbSize=SizeOf(NONCLIENTMETRICS)
 If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,SizeOf(NONCLIENTMETRICS),ncm,#Null)
  font$=PeekS(@ncm\lfMessageFont\lfFaceName)
      font=LoadFont(#PB_Any,font$,9,#PB_Font_HighQuality)
      If font
       SetGadgetFont(#PB_Default,FontID(font))
      EndIf
 EndIf
EndProcedure
InitScaleDPI()
Macro ScaleDPIx(x)
 (x)*_ScaleDPI_X_
EndMacro
Macro ScaleDPIy(y)
 (y)*_ScaleDPI_Y_
EndMacro

;The Gadget example from PureBasic manual.

#WindowWidth  = 390
#WindowHeight = 350

If OpenWindow(0, ScaleDPIx(100), ScaleDPIy(200), ScaleDPIx(#WindowWidth), ScaleDPIy(#WindowHeight), "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)

  Top = 10
  GadgetHeight = 24

  Frame3DGadget(#PB_Any, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(370), ScaleDPIy(290), "Player...") : Top+20

  StringGadget(0, ScaleDPIx(20), ScaleDPIy(Top), ScaleDPIx(200), ScaleDPIy(GadgetHeight), "")
  ButtonGadget(1, ScaleDPIx(223), ScaleDPIy(Top),  ScaleDPIx(72), ScaleDPIy(GadgetHeight), "Play")
  ButtonGadget(2, ScaleDPIx(295), ScaleDPIy(Top),  ScaleDPIx(72), ScaleDPIy(GadgetHeight), "Stop")  : Top+35
  DisableGadget(2,1)

  GadgetToolTip(1,"Play the current song")

  PanelGadget(3, ScaleDPIx(20), ScaleDPIy(Top), ScaleDPIx(#WindowWidth-50), ScaleDPIy(#WindowHeight-Top-60))
    AddGadgetItem(3, 0, "MP3 PlayList")
      ListViewGadget(4, ScaleDPIx(6), ScaleDPIy(10), ScaleDPIx(230), ScaleDPIy(148))

      For k=0 To 30
        AddGadgetItem(4, -1, "Music Song n° "+Str(k))
      Next

      ButtonGadget(5,  ScaleDPIx(250), ScaleDPIy(10), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Add")
      ButtonGadget(6,  ScaleDPIx(250), ScaleDPIy(38), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Remove")
      ButtonGadget(7,  ScaleDPIx(250), ScaleDPIy(66), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Select")
      GadgetToolTip(7, "Select the current song")

      TrackBarGadget(17, ScaleDPIx(10), ScaleDPIy(168), ScaleDPIx(310), ScaleDPIy(25), 0, 100)

    AddGadgetItem(3, 1, "Options")
      Top = 10
      CheckBoxGadget(10, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(GadgetHeight), "Enable low-pass filter") : Top+30
      CheckBoxGadget(11, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(GadgetHeight), "Enable visual plug-in")  : Top+30
      ComboBoxGadget(12, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(21)) : Top+30
        AddGadgetItem(12, -1, "FireWorks")
        AddGadgetItem(12, -1, "OpenGL spectrum")
        AddGadgetItem(12, -1, "Bump bass")
      SetGadgetState(12,0)
      DisableGadget(12,1)

      OptionGadget(13, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "640*480") : Top+20
      OptionGadget(14, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "800*600") : Top+20
      OptionGadget(15, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "1024*768")
      SetGadgetState(13, 1)

      ButtonGadget(16, ScaleDPIx(150), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Info")
  CloseGadgetList()

  TextGadget  (9, ScaleDPIx(10), ScaleDPIy(#WindowHeight-30), ScaleDPIx(250), ScaleDPIy(24), "PureBasic - Gadget demonstration")
  ButtonGadget(8, ScaleDPIx(#WindowWidth-100), ScaleDPIy(#WindowHeight-36), ScaleDPIx(80), ScaleDPIy(24), "Quit")

  SetGadgetState(3, 0)

  Repeat
    EventID = WaitWindowEvent()

    If EventID = #PB_Event_Gadget

      Select EventGadget()
        Case 0
          If EventType() = #PB_EventType_ReturnKey
            MessageRequester("Info", "Return key pressed", 0)
            SetActiveGadget(0)
          EndIf

        Case 1 ; Play
          DisableGadget(2,0)  ; Enable the 'Stop' gadget
          DisableGadget(1,1)  ; Disable the 'Play' Gadget

        Case 2 ; Stop
          DisableGadget(1,0)  ; Enable the 'Play' gadget
          DisableGadget(2,1)  ; Disable the 'Stop' Gadget

        Case 4
          If EventType() = 2
            SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
          EndIf

        Case 5 ; Add
          AddGadgetItem(4, -1, "New Item Added...")

        Case 6 ; Remove
          RemoveGadgetItem(4, GetGadgetState(4)) ; Remove the current element of the ListView

        Case 7 ; Select
          SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..

        Case 8 ; Quit...
          EventID = #PB_Event_CloseWindow

        Case 11 ; Enable PlugIn..
          DisableGadget(12, 1-GetGadgetState(11))

        Case 16 ;
          If GetGadgetState(13) : Result$ = GetGadgetText(13) : EndIf
          If GetGadgetState(14) : Result$ = GetGadgetText(14) : EndIf
          If GetGadgetState(15) : Result$ = GetGadgetText(15) : EndIf

          MessageRequester("Info", "Selected screen mode: "+Result$, 0)

        Case 17
          SetGadgetText(0, Str(GetGadgetState(17)))

      EndSelect

    EndIf

  Until EventID = #PB_Event_CloseWindow

EndIf

End


96 DPI (default)
Image

192 DPI (200%, custom)
Image


Last edited by Rescator on Sun Jan 03, 2010 2:34 am, edited 3 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Jan 02, 2010 7:11 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10405
Location: Beyond the pale...
Very interesting Rescator. Thanks for this.

Perhaps a feature request to have a 'Make application DPI aware' IDE compiler option would indeed be in order? :)

_________________
I may look like a mule, but I'm not a complete ass.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Jan 02, 2010 10:14 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
Yeah it would be nice as it's "just" a manifest (some ccare needed as a comment on MSDN mentioned a possible issue with XP SP2 choking on a certain variation).
Still the programmer would need to take care when coding, but with thhe help of say a GetXDPI and a GetYDPI (should be possible to add that to all the supported platforms I think?) would make that easier.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Jan 02, 2010 10:24 pm 
Offline
Addict
Addict

Joined: Sat Dec 31, 2005 5:24 pm
Posts: 2970
Location: Where ya would never look.....
Very nice. But how do you use/include it with a manifest in PB? Just put the manifest in the resources?

_________________
The advantage of a 64 bit operating system over a 32 bit operating system comes down to only being twice the headache.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Jan 02, 2010 10:34 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
See the post in Feature requests, I think I figured out the "safe" way to add it without XP SP2 choking. (similar issue as XP had with the elevation manifest I suspect?)


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sun Jan 03, 2010 12:21 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
Added a IsProcessDPIAware check to the example, no point enabling it if say a manifest has already enabled it ;)


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sun Jan 03, 2010 2:42 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
Improved the code a bit, wrote more comments in the source in particular about fonts and scaling.

Now it automatically changes the default PureBasic font to the default current font.

On Vista and Win7 for example this would be Segoe UI, on XP I'm a bit sure but most likely Tahoma or so the MSDN pages says.
The size is set to 9 as default, which is what Vista and Win7 etc uses as default. I believe 2k and XP use 8 as default.

You aren't forced to use this as the default though, just change the default font like you normally would, the only thing this changes is to a more "modern" TrueType/Open default font.

I'm not entirely sure what font it is that PureBasic uses as default but it certainly is not the actual system default font.
Maybe it's using one of these deprecated bitmap ones? (hope not) http://blogs.msdn.com/oldnewthing/archi ... 36435.aspx


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sun Jan 03, 2010 11:33 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10405
Location: Beyond the pale...
Rescator, just a quick question if I may; just trying to understand how Vista/Win 7 adjusts the fonts? You seem to suggest that Vista will automatically adjust fonts in a dpi aware application, but that is not my understanding.

My understanding is that you have to take the dpi scale-factor into account when creating the fonts etc. Is that not correct?

i ask because your code above doesn't seem to take this into account with the fonts and so I am wondering if I am missing something?

**EDIT : hang on, PB's LoadFont() command now uses proper points (with logical inches) in it's font height and so these are automatically scaled in your code above. I am pretty sure that Vista / Win 7 will not otherwise automatically scale your fonts in a dpi aware application. Switch LoadFont() for CreateFontIndirect_() and I think you will see that your fonts are not rescaled etc. An important point I think. :)

_________________
I may look like a mule, but I'm not a complete ass.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sun Jan 03, 2010 6:07 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
You're right. (Hmm! Has Fred begun to make PureBasic DPI aware silently in steps?) :P
I think it's got to do with the description of the lfHeight of LOGFONT
there's a MulDiv example there, my guess is the LoadFont implementation just follows that advise?
I see one can also specify a negative value but that is Windows specific I'm sure so I haven't bothered testing LoadFont with that, although a loadfont with height 0 does work.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sun Jan 03, 2010 9:43 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
I just found out that the "Large Font" setting in Windows (dating back to Win 95) also benefit from the ScaleDPI macros etc.
As the Large Font setting in Windows will report the dpi in LOGPIXELSX and LOGPIXELSY, I do not have a Win9x setup to test on,
but this shows that taking the font and dpi into consideration in any Windows app is pretty much a must.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Fri Jan 29, 2010 7:35 am 
Offline
Addict
Addict

Joined: Sat Dec 31, 2005 5:24 pm
Posts: 2970
Location: Where ya would never look.....
Have you found out if CoInitialize, HrInit, and CoUninitialize are really needed? Is a manifest even needed?

_________________
The advantage of a 64 bit operating system over a 32 bit operating system comes down to only being twice the headache.


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Fri Jan 29, 2010 2:25 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Aug 15, 2009 6:59 pm
Posts: 1243
Interessting.

Recently i wrote a program that can display the physical size of the iPhone and iPod Touch screen on the PC.
It falls in the same category i think, so here it is.

Code:
#iPhone_Width  = 480
#iPhone_Height = 320
#iPhone_xDpi   = 163
#iPhone_yDpi   = 163

#iPod_Width    = 480
#iPod_Height   = 320
#iPod_xDpi     = 160
#iPod_yDpi     = 160

;retrieves the horizontal DPI of the desktop
Procedure.i Gui_GetDesktopDpiX()

  Protected hDc.i
  Protected hDpi.i
 
  hDc = GetDC_(GetDesktopWindow_())
  If hDc
    hDpi = GetDeviceCaps_(hDc, #LOGPIXELSX)
    ReleaseDC_(GetDesktopWindow_(), hDc)
  EndIf

  If hDpi = 0
    hDpi = 96
    MessageRequester(#Gui_MainTitle, "Can't retrieve horizontal DPI of desktop!" + Chr(10) + "Can't calculate correct window size.", #MB_ICONSTOP)
  EndIf

  ProcedureReturn hDpi

EndProcedure

;retrieves the vertical DPI of the desktop
Procedure.i Gui_GetDesktopDpiY()
 
  Protected hDc.i
  Protected vDpi.i
 
  hDc = GetDC_(GetDesktopWindow_())
  If hDc
    vDpi = GetDeviceCaps_(hDc, #LOGPIXELSY)
    ReleaseDC_(GetDesktopWindow_(), hDc)
  EndIf
 
  If vDpi = 0
    vDpi = 96
    MessageRequester(#Gui_MainTitle, "Can't retrieve vertical DPI of desktop!" + Chr(10) + "Can't calculate correct window size.", #MB_ICONSTOP)
  EndIf
 
  ProcedureReturn vDpi

EndProcedure

;resizes the 3D view window to the iPhone screen size
Procedure Gui_Resize3DWnd2iPhoneSize(Scale.f)

  Protected Width.i
  Protected Height.i
  Protected RelationX.f
  Protected RelationY.f
 
  RelationX = Gui_GetDesktopDpiX() / #iPhone_xDpi
  RelationY = Gui_GetDesktopDpiY() / #iPhone_yDpi
 
  Width  = #iPhone_Width * RelationX * Scale
  Height = #iPhone_Height * RelationY * Scale

  ResizeWindow(Gui_3DWnd\PbNum, #PB_Ignore, #PB_Ignore, Width, Height)

EndProcedure

;resizes the 3D view window to the iPod screen size
Procedure Gui_Resize3DWnd2iPodSize(Scale.f)

  Protected Width.i
  Protected Height.i
  Protected RelationX.f
  Protected RelationY.f
 
  RelationX = Gui_GetDesktopDpiX() / #iPod_xDpi
  RelationY = Gui_GetDesktopDpiY() / #iPod_yDpi
 
  Width  = #iPod_Width * RelationX * Scale
  Height = #iPod_Height * RelationY * Scale

  ResizeWindow(Gui_3DWnd\PbNum, #PB_Ignore, #PB_Ignore, Width, Height)

EndProcedure


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Feb 06, 2010 1:50 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 5:05 pm
Posts: 1769
Location: Norway
SFSxOI wrote:
Have you found out if CoInitialize, HrInit, and CoUninitialize are really needed? Is a manifest even needed?


The DPI aware manifest is needed yes, and would have to be a option in the ID just like the XP theme currently is.

As to co and Hr init etc. Not sure, it seemed to work without the Co ones but I guess Fred or Freak can answer this. (I seem to recall that Coinit is done by PB automatically in some cases or?) Not sure on HrInit. The source in 1st post seems to work ok though.

PS! I think you meant to post in the viewtopic.php?f=12&t=40806 thread but I :)


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Sep 03, 2016 4:10 pm 
Offline
Addict
Addict
User avatar

Joined: Mon Oct 26, 2015 2:55 am
Posts: 892
Location: Ukraine
That DPI problem is really pain in the ass (especially for some my old programs).
Here I've made some expanded version of your code, planning to wrap all PB UI functions into scaling macro.

However it is just for testing now [and not all functions related to UI wrapped - only OpenWindow and Gadgets creation], and maybe it would be better to just scale fonts sizes down, instead of scaling every property of every UI control up ^^
I'll try it later.


Code:
EnableExplicit

;{ DPI-related procs and macross }
   
   ; This one is not needed if already set in manifest file [which is preffered])
   ; It must be called on startup, before any window created
   ;    and SHOULD NOT be called from DLL
   ; RETURN: none
   Procedure SetDPIAware()
      Protected hLib = OpenLibrary(#PB_Any, "User32.dll")
      If IsLibrary(hLib)
         If Not CallFunction(hLib, "IsProcessDPIAware") ; if process has not already DPIAware setting (using following API or manifest file)
            If CallFunction(hLib, "SetProcessDPIAware")
               ; now process is "DPI-aware"
            EndIf
         EndIf
         CloseLibrary(hLib)
      EndIf
   EndProcedure
   
   
   ; Placed in the Public Domain by Roger Hågensen.
   ; This one calculates DPI scaling values
   ;    which you must apply to any pixel values etc when drawing UI.
   ; Fonts are scaled by window automatically, so another way
   ;   can be using lesser font sizes (basing on those values), instead of scaling whole UI
   ; RETURN:   _ScaleDPI_X_, _ScaleDPI_Y_ global variables updated on success
   Global.f _ScaleDPI_X_ = 1.0, _ScaleDPI_Y_ = 1.0
   #DefaultDPIX=96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
   #DefaultDPIY=96.0
   Procedure InitScaleDPI()
      Protected dc, lpx, lpy
      
      dc=GetDC_(#Null)
      If dc
         lpx=GetDeviceCaps_(dc,#LOGPIXELSX)
         lpy=GetDeviceCaps_(dc,#LOGPIXELSY)
         If lpx>0
            _ScaleDPI_X_=lpx/#DefaultDPIX
         EndIf
         If lpy>0
            _ScaleDPI_Y_=lpy/#DefaultDPIY
         EndIf
         ReleaseDC_(#Null,dc)
      EndIf
   EndProcedure
   
   ; scaling macros
   Macro ScaleDPIx(x)
      (x)*_ScaleDPI_X_
   EndMacro
   Macro ScaleDPIy(y)
      (y)*_ScaleDPI_Y_
   EndMacro
   
;}

;{ PB UI-related functions wrappers }
   
   Procedure _OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title$ = "", Flags = #Null, ParentID = #Null)
      Debug ScaleDPIx (x)
      Debug x
      ProcedureReturn OpenWindow (Window, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (InnerWidth), ScaleDPIy (InnerHeight), Title$, Flags, ParentID)
   EndProcedure
   Procedure _ButtonGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
      ProcedureReturn ButtonGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
   EndProcedure
   Procedure _ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
      ProcedureReturn ButtonImageGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ImageID, Flags)
   EndProcedure
   Procedure _CalendarGadget (Gadget, x, y, Width, Height, Date = #Null, Flags = #Null)
      ProcedureReturn CalendarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Date, Flags)
   EndProcedure
   Procedure _CanvasGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn CanvasGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _CheckBoxGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
      ProcedureReturn CheckBoxGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
   EndProcedure
   Procedure _ComboBoxGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn ComboBoxGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _EditorGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn EditorGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _DateGadget (Gadget, x, y, Width, Height, Mask$ = "", Date = #Null, Flags = #Null)
      ProcedureReturn DateGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Mask$, Date, Flags)
   EndProcedure
   Procedure _ExplorerComboGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
      ProcedureReturn ExplorerComboGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
   EndProcedure
   Procedure _ExplorerListGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
      ProcedureReturn ExplorerListGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
   EndProcedure
   Procedure _ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
      ProcedureReturn ExplorerTreeGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
   EndProcedure
   Procedure _FrameGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
      ProcedureReturn FrameGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
   EndProcedure
   Procedure _HyperLinkGadget (Gadget, x, y, Width, Height, Text$, Color, Flags = #Null)
      ProcedureReturn HyperLinkGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Color, Flags)
   EndProcedure
   Procedure _ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
      ProcedureReturn ImageGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ImageID, Flags)
   EndProcedure
   Procedure _IPAddressGadget (Gadget, x, y, Width, Height)
      ProcedureReturn IPAddressGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height))
   EndProcedure
   Procedure _ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle$, FirstColumnWidth, Flags = #Null)
      ProcedureReturn ListIconGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), FirstColumnTitle$, FirstColumnWidth, Flags)
   EndProcedure
   Procedure _ListViewGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn ListViewGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _OpenGLGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn OpenGLGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _OptionGadget (Gadget, x, y, Width, Height, Text$)
      ProcedureReturn OptionGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$)
   EndProcedure
   Procedure _PanelGadget (Gadget, x, y, Width, Height)
      ProcedureReturn PanelGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height))
   EndProcedure
   Procedure _ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      ProcedureReturn ProgressBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
   EndProcedure
   Procedure _ScintillaGadget (Gadget, x, y, Width, Height, Callback)
      ProcedureReturn ScintillaGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Callback)
   EndProcedure
   Procedure _ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep = #Null, Flags = #Null)
      ProcedureReturn ScrollAreaGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ScrollAreaWidth, ScrollAreaHeight, ScrollStep, Flags)
   EndProcedure
   Procedure _ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags = #Null)
      ProcedureReturn ScrollBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Min, Max, PageLength, Flags)
   EndProcedure
   Procedure _SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      ProcedureReturn SpinGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
   EndProcedure
   Procedure _StringGadget (Gadget, x, y, Width, Height, Content$, Flags = #Null)
      ProcedureReturn StringGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Content$, Flags)
   EndProcedure
   Procedure _TextGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
      ProcedureReturn TextGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
   EndProcedure
   Procedure _TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      ProcedureReturn TrackBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
   EndProcedure
   Procedure _TreeGadget (Gadget, x, y, Width, Height, Flags = #Null)
      ProcedureReturn TreeGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
   EndProcedure
   Procedure _WebGadget (Gadget, x, y, Width, Height, URL$)
      ProcedureReturn WebGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), URL$)
   EndProcedure
   
;}

;{ And macross to use wrappers }
   
   Macro OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title = "", Flags = #Null, ParentID = #Null)
      _OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title, Flags, ParentID)
   EndMacro
   Macro ButtonGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
      _ButtonGadget (Gadget, x, y, Width, Height, Text, Flags)
   EndMacro
   Macro ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
      _ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags)
   EndMacro
   Macro CalendarGadget (Gadget, x, y, Width, Height, Date = #Null, Flags = #Null)
      _CalendarGadget (Gadget, x, y, Width, Height, Date, Flags)
   EndMacro
   Macro CanvasGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _CanvasGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro CheckBoxGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
      _CheckBoxGadget (Gadget, x, y, Width, Height, Text, Flags)
   EndMacro
   Macro ComboBoxGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _ComboBoxGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro EditorGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _EditorGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro DateGadget (Gadget, x, y, Width, Height, Mask = #Null, Date = #Null, Flags = #Null)
      _DateGadget (Gadget, x, y, Width, Height, Mask, Date, Flags)
   EndMacro
   Macro ExplorerComboGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
      _ExplorerComboGadget (Gadget, x, y, Width, Height, Directory, Flags)
   EndMacro
   Macro ExplorerListGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
      _ExplorerListGadget (Gadget, x, y, Width, Height, Directory, Flags)
   EndMacro
   Macro ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
      _ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory, Flags)
   EndMacro
   Macro FrameGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
      _FrameGadget (Gadget, x, y, Width, Height, Text, Flags)
   EndMacro
   Macro HyperLinkGadget (Gadget, x, y, Width, Height, Text, Color, Flags = #Null)
      _HyperLinkGadget (Gadget, x, y, Width, Height, Text, Color, Flags)
   EndMacro
   Macro ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
      _ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags)
   EndMacro
   Macro IPAddressGadget (Gadget, x, y, Width, Height)
      _IPAddressGadget (Gadget, x, y, Width, Height)
   EndMacro
   Macro ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle, FirstColumnWidth, Flags = #Null)
      _ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle, FirstColumnWidth, Flags)
   EndMacro
   Macro ListViewGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _ListViewGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro OpenGLGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _OpenGLGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro OptionGadget (Gadget, x, y, Width, Height, Text)
      _OptionGadget (Gadget, x, y, Width, Height, Text)
   EndMacro
   Macro PanelGadget (Gadget, x, y, Width, Height)
      _PanelGadget (Gadget, x, y, Width, Height)
   EndMacro
   Macro ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      _ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
   EndMacro
   Macro ScintillaGadget (Gadget, x, y, Width, Height, Callback)
      _ScintillaGadget (Gadget, x, y, Width, Height, Callback)
   EndMacro
   Macro ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep = #Null, Flags = #Null)
      _ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep, Flags)
   EndMacro
   Macro ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags = #Null)
      _ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags)
   EndMacro
   Macro SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      _SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
   EndMacro
   Macro StringGadget (Gadget, x, y, Width, Height, Content, Flags = #Null)
      _StringGadget (Gadget, x, y, Width, Height, Content, Flags)
   EndMacro
   Macro TextGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
      _TextGadget (Gadget, x, y, Width, Height, Text, Flags)
   EndMacro
   Macro TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
      _TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
   EndMacro
   Macro TreeGadget (Gadget, x, y, Width, Height, Flags = #Null)
      _TreeGadget (Gadget, x, y, Width, Height, Flags)
   EndMacro
   Macro WebGadget (Gadget, x, y, Width, Height, URL)
      _WebGadget (Gadget, x, y, Width, Height, URL)
   EndMacro
   
;}

; Use DPI scaling
SetDPIAware()
InitScaleDPI()
; After this can start creating windows, drawing UI, etc


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Some Example
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisableExplicit
#WindowWidth  = 390
#WindowHeight = 350

If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
   
   Top = 10
   GadgetHeight = 24
   
   FrameGadget(#PB_Any, 10, Top, 370, 290, "Player...") : Top+20
   
   StringGadget(0,  20, Top, 200, GadgetHeight, "")
   ButtonGadget(1, 223, Top,  72, GadgetHeight, "Play")
   ButtonGadget(2, 295, Top,  72, GadgetHeight, "Stop")  : Top+35
   DisableGadget(2,1)
   
   GadgetToolTip(1,"Play the current song")
   
   PanelGadget(3, 20, Top, #WindowWidth-50, #WindowHeight-Top-60)
   AddGadgetItem(3, 0, "MP3 PlayList")
   ListViewGadget(4, 6, 10, 230, 148)
   
   For k=0 To 30
      AddGadgetItem(4, -1, "Music Song n° "+Str(k))
   Next
   
   ButtonGadget(5,  250, 10, 80, GadgetHeight, "Add")
   ButtonGadget(6,  250, 38, 80, GadgetHeight, "Remove")
   ButtonGadget(7,  250, 66, 80, GadgetHeight, "Select")
   GadgetToolTip(7, "Select the current song")
   
   TrackBarGadget(17, 10, 168, 310, 25, 0, 100)
   
   AddGadgetItem(3, 1, "Options")
   Top = 10
   CheckBoxGadget(10, 10, Top, 250, GadgetHeight, "Enable low-pass filter") : Top+30
   CheckBoxGadget(11, 10, Top, 250, GadgetHeight, "Enable visual plug-in")  : Top+30
   ComboBoxGadget(12, 10, Top, 250, 21) : Top+30
   AddGadgetItem(12, -1, "FireWorks")
   AddGadgetItem(12, -1, "OpenGL spectrum")
   AddGadgetItem(12, -1, "Bump bass")
   SetGadgetState(12,0)
   DisableGadget(12,1)
   
   OptionGadget(13, 10, Top, 80, GadgetHeight, "640*480") : Top+20
   OptionGadget(14, 10, Top, 80, GadgetHeight, "800*600") : Top+20
   OptionGadget(15, 10, Top, 80, GadgetHeight, "1024*768")
   SetGadgetState(13, 1)
   
   ButtonGadget(16, 150, Top, 80, GadgetHeight, "Info")
   CloseGadgetList()
   
   TextGadget  (9, 10, #WindowHeight-30, 250, 24, "PureBasic - Gadget demonstration")
   ButtonGadget(8, #WindowWidth-100, #WindowHeight-36, 80, 24, "Quit")
   
   SetGadgetState(3, 0)
   
   Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_Event_Gadget
         
         Select EventGadget()
            Case 0
               If EventType() = #PB_EventType_ReturnKey
                  MessageRequester("Info", "Return key pressed", 0)
                  SetActiveGadget(0)
               EndIf
               
            Case 1 ; Play
               DisableGadget(2,0)  ; Enable the 'Stop' gadget
               DisableGadget(1,1)   ; Disable the 'Play' Gadget
               
            Case 2 ; Stop
               DisableGadget(1,0)  ; Enable the 'Play' gadget
               DisableGadget(2,1)   ; Disable the 'Stop' Gadget
               
            Case 4
               If EventType() = 2
                  SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
               EndIf
               
            Case 5 ; Add
               AddGadgetItem(4, -1, "New Item Added...")
               
            Case 6 ; Remove
               RemoveGadgetItem(4, GetGadgetState(4)) ; Remove the current element of the ListView
               
            Case 7 ; Select
               SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
               
            Case 8 ; Quit...
               Event = #PB_Event_CloseWindow
               
            Case 11 ; Enable PlugIn..
               DisableGadget(12, 1-GetGadgetState(11))
               
            Case 16 ;
               If GetGadgetState(13) : Result$ = GetGadgetText(13) : EndIf
               If GetGadgetState(14) : Result$ = GetGadgetText(14) : EndIf
               If GetGadgetState(15) : Result$ = GetGadgetText(15) : EndIf
               
               MessageRequester("Info", "Selected screen mode: "+Result$, 0)
               
            Case 17
               SetGadgetText(0, Str(GetGadgetState(17)))
               
         EndSelect
         
      EndIf
      
   Until Event = #PB_Event_CloseWindow
   
EndIf

End

_________________
Time beyond time

Like a copyleft notify: all the source code created by me and posted on Purebasic official forums is free to use and modification in all possible (and several impossible) ways for anyone, without asking my permission


Top
 Profile  
Reply with quote  
 Post subject: Re: DPI Aware Application
PostPosted: Sat Sep 03, 2016 5:47 pm 
Offline
Addict
Addict
User avatar

Joined: Mon Oct 26, 2015 2:55 am
Posts: 892
Location: Ukraine
This alternative shorten variant seems also working fine.
For now I'm not sure which of them is better ^^ Just the following is much simpler and clear.

Code:
EEnableExplicit

;{ DPI-related procs and macross }
   
   ; This one is not needed if already set in manifest file [which is preffered])
   ; It must be called on startup, before any window created
   ;    and SHOULD NOT be called from DLL
   ; RETURN: none
   Procedure SetDPIAware()
      Protected hLib = OpenLibrary(#PB_Any, "User32.dll")
      If IsLibrary(hLib)
         If Not CallFunction(hLib, "IsProcessDPIAware") ; if process has not already DPIAware setting (using following API or manifest file)
            If CallFunction(hLib, "SetProcessDPIAware")
               ; now process is "DPI-aware"
            EndIf
         EndIf
         CloseLibrary(hLib)
      EndIf
   EndProcedure
   
   
   ; Placed in the Public Domain by Roger Hågensen.
   ; This one calculates DPI scaling values
   ;    which you must apply to any pixel values etc when drawing UI.
   ; Fonts are scaled by window automatically, so another way
   ;   can be using lesser font sizes (basing on those values), instead of scaling whole UI
   ; RETURN:   _ScaleDPI_X_, _ScaleDPI_Y_ global variables updated on success
   Global.f _ScaleDPI_X_ = 1.0, _ScaleDPI_Y_ = 1.0
   #DefaultDPIX=96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
   #DefaultDPIY=96.0
   Procedure InitScaleDPI()
      Protected dc, lpx, lpy
      
      dc=GetDC_(#Null)
      If dc
         lpx=GetDeviceCaps_(dc,#LOGPIXELSX)
         lpy=GetDeviceCaps_(dc,#LOGPIXELSY)
         If lpx>0
            _ScaleDPI_X_=lpx/#DefaultDPIX
         EndIf
         If lpy>0
            _ScaleDPI_Y_=lpy/#DefaultDPIY
         EndIf
         ReleaseDC_(#Null,dc)
      EndIf
   EndProcedure
   
   ; scaling macros
   Macro ScaleDPIxDown(x)
      (x)/_ScaleDPI_X_
   EndMacro
   Macro ScaleDPIyDown(y)
      (y)/_ScaleDPI_Y_
   EndMacro
   
;}

;{ PB Font-related functions wrappers }
   
   Procedure _LoadFont (Font, Name$, Height, Style = #Null)
      ProcedureReturn LoadFont(Font, Name$, ScaleDPIyDown(Height), Style)
   EndProcedure

;}

;{ And macross to use wrappers }

   Macro LoadFont(Font, Name, Height, Style = #Null)
      _LoadFont (Font, Name, Height, Style)
   EndMacro
   
;}


; Use DPI scaling
SetDPIAware()
InitScaleDPI()
; After this can start creating windows, drawing UI, etc


; That's much shorter alternative solution and it seems working fine.
; You just decreasing all your fonts by % on which Windows enlarges them.
; Thus kicking windows ass and your UI remains exact as it should be (only caption font becomes badly enlarged)
; DPIAware of course has to be set too
LoadFont(1, "Tahoma", 9)
SetGadgetFont(#PB_Default, FontID(1))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Some Example
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisableExplicit
#WindowWidth  = 390
#WindowHeight = 350

If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
   
   Top = 10
   GadgetHeight = 24
   
   FrameGadget(#PB_Any, 10, Top, 370, 290, "Player...") : Top+20
   
   StringGadget(0,  20, Top, 200, GadgetHeight, "")
   ButtonGadget(1, 223, Top,  72, GadgetHeight, "Play")
   ButtonGadget(2, 295, Top,  72, GadgetHeight, "Stop")  : Top+35
   DisableGadget(2,1)
   
   GadgetToolTip(1,"Play the current song")
   
   PanelGadget(3, 20, Top, #WindowWidth-50, #WindowHeight-Top-60)
   AddGadgetItem(3, 0, "MP3 PlayList")
   ListViewGadget(4, 6, 10, 230, 148)
   
   For k=0 To 30
      AddGadgetItem(4, -1, "Music Song n° "+Str(k))
   Next
   
   ButtonGadget(5,  250, 10, 80, GadgetHeight, "Add")
   ButtonGadget(6,  250, 38, 80, GadgetHeight, "Remove")
   ButtonGadget(7,  250, 66, 80, GadgetHeight, "Select")
   GadgetToolTip(7, "Select the current song")
   
   TrackBarGadget(17, 10, 168, 310, 25, 0, 100)
   
   AddGadgetItem(3, 1, "Options")
   Top = 10
   CheckBoxGadget(10, 10, Top, 250, GadgetHeight, "Enable low-pass filter") : Top+30
   CheckBoxGadget(11, 10, Top, 250, GadgetHeight, "Enable visual plug-in")  : Top+30
   ComboBoxGadget(12, 10, Top, 250, 21) : Top+30
   AddGadgetItem(12, -1, "FireWorks")
   AddGadgetItem(12, -1, "OpenGL spectrum")
   AddGadgetItem(12, -1, "Bump bass")
   SetGadgetState(12,0)
   DisableGadget(12,1)
   
   OptionGadget(13, 10, Top, 80, GadgetHeight, "640*480") : Top+20
   OptionGadget(14, 10, Top, 80, GadgetHeight, "800*600") : Top+20
   OptionGadget(15, 10, Top, 80, GadgetHeight, "1024*768")
   SetGadgetState(13, 1)
   
   ButtonGadget(16, 150, Top, 80, GadgetHeight, "Info")
   CloseGadgetList()
   
   TextGadget  (9, 10, #WindowHeight-30, 250, 24, "PureBasic - Gadget demonstration")
   ButtonGadget(8, #WindowWidth-100, #WindowHeight-36, 80, 24, "Quit")
   
   SetGadgetState(3, 0)
   
   Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_Event_Gadget
         
         Select EventGadget()
            Case 0
               If EventType() = #PB_EventType_ReturnKey
                  MessageRequester("Info", "Return key pressed", 0)
                  SetActiveGadget(0)
               EndIf
               
            Case 1 ; Play
               DisableGadget(2,0)  ; Enable the 'Stop' gadget
               DisableGadget(1,1)   ; Disable the 'Play' Gadget
               
            Case 2 ; Stop
               DisableGadget(1,0)  ; Enable the 'Play' gadget
               DisableGadget(2,1)   ; Disable the 'Stop' Gadget
               
            Case 4
               If EventType() = 2
                  SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
               EndIf
               
            Case 5 ; Add
               AddGadgetItem(4, -1, "New Item Added...")
               
            Case 6 ; Remove
               RemoveGadgetItem(4, GetGadgetState(4)) ; Remove the current element of the ListView
               
            Case 7 ; Select
               SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
               
            Case 8 ; Quit...
               Event = #PB_Event_CloseWindow
               
            Case 11 ; Enable PlugIn..
               DisableGadget(12, 1-GetGadgetState(11))
               
            Case 16 ;
               If GetGadgetState(13) : Result$ = GetGadgetText(13) : EndIf
               If GetGadgetState(14) : Result$ = GetGadgetText(14) : EndIf
               If GetGadgetState(15) : Result$ = GetGadgetText(15) : EndIf
               
               MessageRequester("Info", "Selected screen mode: "+Result$, 0)
               
            Case 17
               SetGadgetText(0, Str(GetGadgetState(17)))
               
         EndSelect
         
      EndIf
      
   Until Event = #PB_Event_CloseWindow
   
EndIf

End

_________________
Time beyond time

Like a copyleft notify: all the source code created by me and posted on Purebasic official forums is free to use and modification in all possible (and several impossible) ways for anyone, without asking my permission


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 21 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 8 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye