PureBoard

Code: Alles auswählen

;;; [Themed ProgressBarGadget with Counter] by chi (2015)

Prototype _OpenThemeData(hWnd, pszClassList.p-unicode)
Prototype _CloseThemeData(hTheme)
Prototype _DrawThemeBackground(hTheme, hdc, iPartId, iStateId, pRect, pClipRect)

If OpenLibrary(0, "uxtheme.dll")
  Global OpenThemeData_._OpenThemeData = GetFunction(0, "OpenThemeData")
  Global DrawThemeBackground_._DrawThemeBackground =  GetFunction(0, "DrawThemeBackground")
  Global CloseThemeData_._CloseThemeData = GetFunction(0, "CloseThemeData")
EndIf

#PBM_GETRANGE = #WM_USER + 7

Global ProgBarProc

Procedure ProgBarCB(hWnd, Msg, wParam, lParam)
  Select Msg
      
    Case #PBM_SETPOS
      hdc = GetDC_(hWnd)
      
      GetClientRect_(hWnd, progbar.RECT)
      GetClientRect_(hWnd, progstate.RECT)
      range = SendMessage_(hwnd, #PBM_GETRANGE, #False, 0)
      
      mdc = CreateCompatibleDC_(hdc)
      bmp = CreateCompatibleBitmap_(hdc, progbar\right, progbar\bottom)
      SelectObject_(mdc, bmp)
      
      theme = OpenThemeData_(hWnd, "PROGRESS")
        DrawThemeBackground_(theme, mdc, 1, 1, progbar, 0)
        progstate\right / range * wParam
        DrawThemeBackground_(theme, mdc, 5, 1, progstate, 0)
      CloseThemeData_(theme)
      
      SelectObject_(mdc, GetStockObject_(#DEFAULT_GUI_FONT))
      SetBkMode_(mdc, #TRANSPARENT)
      DrawText_(mdc, Str(wParam) + "%", -1, progbar, #DT_CENTER|#DT_VCENTER|#DT_SINGLELINE)
      
      BitBlt_(hdc, 0, 0, progbar\right, progbar\bottom, mdc, 0, 0, #SRCCOPY)
      
      DeleteObject_(bmp)
      DeleteDC_(mdc)
      ReleaseDC_(hWnd, hdc)
      ProcedureReturn 0
      
  EndSelect
  ProcedureReturn CallWindowProc_(ProgBarProc, hWnd, Msg, wParam, lParam)
EndProcedure


OpenWindow(0, 0, 0, 600, 150, "Themed ProgressBarGadget with Counter", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)

ProgressBarGadget(1, 50, 60, 500, 20, 0, 100)
ProgBarProc = SetWindowLongPtr_(GadgetID(1), #GWL_WNDPROC, @ProgBarCB())

AddWindowTimer(0, 1, 100)

Repeat
  event = WaitWindowEvent()
  Select event
      
    Case #PB_Event_Timer
      Select EventTimer()
          
        Case 1
          x+1
          If x > 100 : x = 0 : EndIf
          SetGadgetState(1, x)
          
      EndSelect
  EndSelect
Until event=#PB_Event_CloseWindow