Welcome, Guest
You have to register before you can post on our site.

Username
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 124
» Latest member: Raymond Couzens
» Forum threads: 95
» Forum posts: 791

Full Statistics

Latest Threads
Arduino users news
Forum: This and that - friendly chat
Last Post: Pierre Bellisle
31.10.2025, 21:18
» Replies: 9
» Views: 610
How to run PB progs in Li...
Forum: PowerBASIC for Windows
Last Post: Gerald Sutherland
30.10.2025, 20:18
» Replies: 12
» Views: 763
Pac-Man maze
Forum: Programming
Last Post: Jules Marchildon
30.10.2025, 16:03
» Replies: 12
» Views: 2,235
Having problems with pbus...
Forum: This and that - friendly chat
Last Post: Kurt Kuzba
26.10.2025, 12:17
» Replies: 3
» Views: 407
Very Simple Round Gauge 0...
Forum: Source Code Library
Last Post: Jules Marchildon
18.10.2025, 01:17
» Replies: 6
» Views: 830
The Future
Forum: Suggestions and discussion about PUMP
Last Post: Dale Yarker
12.10.2025, 06:34
» Replies: 84
» Views: 12,579
READ$/Data Slow
Forum: PowerBASIC for Windows
Last Post: Brent F Boshart
11.10.2025, 20:13
» Replies: 4
» Views: 384
7zip alternatives ?
Forum: This and that - friendly chat
Last Post: Eric Pearson
08.10.2025, 15:07
» Replies: 4
» Views: 410
Doubly Linked String/WStr...
Forum: Source Code Library
Last Post: Stanley Durham
05.10.2025, 09:19
» Replies: 2
» Views: 286
DOCX and XLSX Viewer
Forum: PowerBASIC for Windows
Last Post: Dale Yarker
05.10.2025, 04:05
» Replies: 9
» Views: 1,149

 
  Very Simple Round Gauge Discussion Thread
Posted by: Jules Marchildon - 24.09.2025, 22:33 - Forum: Programming - Replies (5)

Posted  in source code forum.

Nice one Kevin,  yours looks better.   I didn't know I had a friendly stalker!  Big Grin

Patrice, I gave it a try,  while I've run out of socks from trying all your other demo's out, I did feel the whoosh and then  goosebumps!  Impressive!  Seems much much faster!   Did you use the native LZNT1 in the last release?

Since I know diddly about obj files I downloaded a free one of the curiosity Rover...
https://free3d.com/3d-model/curiosity-rover-46907.html
...but it's missing the MTL file, so I made one up, unfortunately the conversion still failed.   

Code:
# dummy MTL for Curiosity Rover
newmtl default
Ka 0.200000 0.200000 0.200000
Kd 0.666667 0.666667 0.666667
Ks 0.000000 0.000000 0.000000
Ns 1.000000
illum 2
Pl
P

Print this item

  Very Simple Round Gauge 0-100%
Posted by: Jules Marchildon - 24.09.2025, 17:01 - Forum: Source Code Library - Replies (6)

I needed a very simple round gauge for one of our in-house measuring dashboards.  I didn't use any double buffer or GDI+ as it is only intended to be a static needle most of the time.  

This one demo's percentage, but you can modify it to whatever; volts, amps, watts, temp, cats, dogs.   Big Grin
   

Code:
'
' Very simple round gauge, 0-100%
' Jules Marchildon, Sept. 24, 2025
'

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"

GLOBAL gValue AS LONG
GLOBAL ghDlg AS DWORD

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
FUNCTION PBMAIN()
    DIALOG NEW 0, "Round Gauge: 0-100%",,, 200, 200, %WS_SYSMENU TO ghDlg
    DIALOG SHOW MODAL ghDlg CALL DlgProc
END FUNCTION

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc()

    LOCAL ps AS PAINTSTRUCT
    LOCAL hDC, hMemDC, hBitmap, hOldBitmap AS DWORD
    LOCAL hGauge AS DWORD
    LOCAL rc AS RECT
    LOCAL cx AS LONG, cy AS LONG, radius AS LONG

    SELECT CASE CB.MSG

        CASE %WM_INITDIALOG
            '-simulate gauge updates with a timer
            SetTimer CB.HNDL, 1, 300, BYVAL %NULL

        CASE %WM_TIMER
            gValue = (gValue + 1) MOD 101
            InvalidateRect CB.HNDL, BYVAL %NULL, %TRUE

        CASE %WM_PAINT
            hDC = BeginPaint(CB.HNDL, ps)
                GetClientRect(CB.HNDL, rc)
                hMemDC = CreateCompatibleDC(hDC)
                hBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                hOldBitmap = SelectObject(hMemDC, hBitmap)
                FillRect hMemDC, rc, GetSysColorBrush(%COLOR_BTNFACE)
                '-calc center and radius
                cx = (rc.nRight - rc.nLeft) \ 2
                cy = (rc.nBottom - rc.nTop) \ 2
                radius = MIN(cx, cy) - 10
                DrawGauge(hMemDC, cx, cy, radius, gValue)
                BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, hMemDC, 0, 0, %SRCCOPY
                SelectObject hMemDC, hOldBitmap
                DeleteObject hBitmap
                DeleteDC hMemDC
            EndPaint(CB.HNDL, ps)

        CASE %WM_DESTROY
            KillTimer CB.HNDL, 1
            PostQuitMessage 0

    END SELECT
END FUNCTION

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
SUB DrawGauge(hDC AS DWORD, cx AS LONG, cy AS LONG, radius AS LONG, value AS LONG)

    LOCAL angle, rad, offsetRad, aDeg, percent, needleWidth AS SINGLE
    LOCAL hPen, hOldPen, hFont, hOldFont, hBrush, hOldBrush AS DWORD
    LOCAL i, x1, y1, x2, y2, xTip, yTip, r, g, b AS LONG
    LOCAL xBase1, yBase1, xBase2, yBase2 AS LONG
    LOCAL sVal AS STRING, lsize AS SIZE, cherryPi AS EXT

    cherryPi = 4*ATN(1)

    '=== Arc background with green-yellow-red segments ===
    FOR aDeg = 225 TO -45 STEP -1
        rad = aDeg * cherryPi / 180
        x1 = cx + radius * 0.85 * COS(rad)
        y1 = cy - radius * 0.85 * SIN(rad)
        x2 = cx + radius * 0.95 * COS(rad)
        y2 = cy - radius * 0.95 * SIN(rad)
        '-calc perc% across arc 0 to 1
        percent = (225 - aDeg) / 270
        '-interpolate color
        IF percent <= 0.25 THEN
            '-green to Yellow
            r = percent / 0.25 * 255
            g = 255
            b = 0
        ELSEIF percent <= 0.75 THEN
            '-yellow to Red
            r = 255
            g = 255 - ((percent - 0.25) / 0.5 * 255)
            b = 0
        ELSE
            '-solid Red
            r = 255
            g = 0
            b = 0
        END IF
        hPen = CreatePen(%PS_SOLID, 1, RGB(r, g, b))
        hOldPen = SelectObject(hDC, hPen)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        SelectObject hDC, hOldPen
        DeleteObject hPen
    NEXT


    #IF 1 '=== Optional chintzy bezel ring ===
        hPen = CreatePen(%PS_SOLID, 4, RGB(190, 190, 190))
        hOldPen = SelectObject(hDC, hPen)
        LOCAL ltweak AS LONG
        ltweak = 1 '-tweak gap to your own taste
        ARC hDC, cx - radius - ltweak, cy - radius - ltweak, cx + radius + ltweak, cy + radius + ltweak, 0, 0, 0, 0
        SelectObject hDC, hOldPen
        DeleteObject hPen
    #ENDIF

    '=== tick marks and labels every 5 units ===
    FOR i = 0 TO 100 STEP 5
        angle = (225 - (i * 2.7!)) * cherryPi / 180
        '-major tick length for labels every 10 units, short for 5 units
        IF (i MOD 10) = 0 THEN
            x1 = cx + radius * 0.80 * COS(angle)
            y1 = cy - radius * 0.80 * SIN(angle)
        ELSE
            x1 = cx + radius * 0.84 * COS(angle)
            y1 = cy - radius * 0.84 * SIN(angle)
        END IF
        x2 = cx + radius * 0.92 * COS(angle)
        y2 = cy - radius * 0.92 * SIN(angle)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        '-label every 10 units only
        IF (i MOD 10) = 0 THEN
            LOCAL sText AS STRING
            sText = FORMAT$(i)
            SetBkMode hDC, %TRANSPARENT
            SetTextColor hDC, RGB(40, 140, 240)
            LOCAL tx AS LONG, ty AS LONG
            tx = cx + radius * 0.65 * COS(angle) - 10
            ty = cy - radius * 0.65 * SIN(angle) - 8
            TextOut hDC, tx, ty, BYVAL STRPTR(sText), LEN(sText)
        END IF
    NEXT

    '=== draw polygon needle ===
    angle = (225 - (gValue * 2.7!))  '<-map gValue (0-100) to 225 to -45
    rad = angle * cherryPi / 180
    '-tip of the needle
    xTip = cx + radius * 0.75 * COS(rad)
    yTip = cy - radius * 0.75 * SIN(rad)
    '-base width and angle offset for polygon
    needleWidth = 6.0  '<-adjust width here
    offsetRad = 90 * cherryPi / 180  '-perpendicular
    '-two base corners *perpendicular to needle angle
    xBase1 = cx + needleWidth * COS(rad + offsetRad)
    yBase1 = cy - needleWidth * SIN(rad + offsetRad)
    xBase2 = cx + needleWidth * COS(rad - offsetRad)
    yBase2 = cy - needleWidth * SIN(rad - offsetRad)
    '-define needle polygon points
    DIM pts(0 TO 2) AS POINTAPI
    pts(0).x = xTip : pts(0).y = yTip
    pts(1).x = xBase1 : pts(1).y = yBase1
    pts(2).x = xBase2 : pts(2).y = yBase2
    '-draw needle
    hBrush = CreateSolidBrush(RGB(255, 0, 0))    '-fill color
    hOldBrush = SelectObject(hDC, hBrush)
    hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0)) '-outline
    hOldPen = SelectObject(hDC, hPen)
    POLYGON hDC, pts(0), 3
    SelectObject hDC, hOldBrush
    DeleteObject hBrush
    SelectObject hDC, hOldPen
    DeleteObject hPen
    '-center cap
    ELLIPSE hDC, cx - 8, cy - 8, cx + 8, cy + 8
    '=== digital value display in the center ===
    sVal = FORMAT$(value) + "%"
    hFont = CreateFont(28, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldFont = SelectObject(hDC, hFont)
    SetBkMode hDC, %TRANSPARENT
    SetTextColor hDC, RGB(0, 102, 204)
    '-measure text size to center it
    GetTextExtentPoint32 hDC, BYVAL STRPTR(sVal), LEN(sVal), lsize
    TextOut hDC, cx - lsize.cx \ 2, cy - lsize.cy \ 2 +60, BYVAL STRPTR(sVal), LEN(sVal)
    SelectObject hDC, hOldFont
    DeleteObject hFont

END SUB
                                         

Print this item

  WAITKEY$ not in FreeBASIC
Posted by: Dale Yarker - 23.09.2025, 13:03 - Forum: Programming - Replies (3)

not posted in FreeBASIC forum because a PB user will know what I'm talking about.

I'm having bad success compiling and running (from tiko).

(before someone bitches - isn't helping coders only used to PB a good subject for PUMP?

One problem is the FreeBASIC "appears" not to run because console never shows. They do run from Command Prompt because console does not close at end of code. I can not find an equivalent to WAITKEY$ in FreeBASIC. The problem presents with samples from FreeBASIC and tiko too. FreeBASIC INKEY in a loop should work. Is that the answer?

GUI sample problems later.

(repeat from elsewhere- I'm not really transitioning from PB to FreeBASIC. It is a 64 bit alternative even though what I do does not need that much horsepower)

Cheers,

Print this item

  gbScroller - Scroll Image
Posted by: Gary Beene - 23.09.2025, 05:04 - Forum: Source Code Library - Replies (1)

gbScroller is the companion app to gbClientCapture.  Both are intended to support viewing of sheet music in a horizontal format.

gbClientCapture captures multiple images from a music sheet and merges them into a single horizontal image.

gbScroller displays the merged image, scrolling it to the left.

Both are discussed in the same thread. http://pump.richheimer.de/showthread.php...562#pid562

Features:
1. Zoom the merged image
2. Scroll the merged image, with speed control 
3. Display a vertical line between individual images

[Image: gbscroller.jpg]

Files for both gbClientCapture and gbScroller are in the zip https://garybeene.com/files/gbclientcapture.zip

Code:
'Compilable Example: Jose Includes

#Compile Exe  "gbscroller.exe"
#Dim All

#Debug Error On
#Debug Display On

%Unicode = 1

#Include "WIN32API.INC"
#Include "cgdiplus.inc" '<-replace with Jose or you own GDI+ include file.

Enum Equates Singular
   IDC_Toolbar   = 500
   IDC_Graphic
   IDT_Exit
   IDT_Faster
   IDT_Slower
   IDT_View
   IDT_ShowLine
   IDT_Scroll
   IDC_StatusBar
   IDT_ResetZoom
   IDT_ResetScroll
   IDC_Up
   IDC_Down
   IDT_StopScroll
   IDT_Plus
   IDT_Minus
   ID_Timer
End Enum

#Resource Manifest, 1,      "icons\xptheme_dpiaware.xml"

#Resource Icon logo, "icons\scroll2.ico"
#Resource Icon zexit, "icons\power.ico"
#Resource Icon zview, "icons\view.ico"
#Resource Icon zleft, "icons\scrollleft.ico"
#Resource Icon zright, "icons\scrollright.ico"
#Resource Icon zstop, "icons\stop.ico"
#Resource Icon zplus, "icons\plus.ico"
#Resource Icon zminus, "icons\minus.ico"
#Resource Icon zreset, "icons\reset.ico"

$Ver = "1.1"

Global hDlg, hToolbar, hList, hFont As Dword
Global Scroll, ShowLine, TimerInterval, ImageWidth, ImageHeight,XDelta As Long
Global SBW, SBH, TBW, TBH As Long, Zoom As Single

Function PBMain() As Long
   Dialog New Pixels, 0, "gbScroller v" + $Ver,,,100,100, %WS_OverlappedWindow To hDlg
   Dialog Set Icon hDlg, "logo"
   Font New "Tahoma",10, 0 To hFont
   CreateImageList
   CreateToolbar
   CreateStatusBar
   Dialog Show Modal hDlg, Call DlgMain
End Function

CallBack Function DlgMain()
   Local iReturn As Long
   Select Case As Long Cb.Msg
      Case %WM_InitDialog
         BuildAcceleratorTable
         settings_ini "get"
         GetImageSize
         CreateGraphic
         Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "gbScroller v" + $Ver + "       Zoom = " + Str$(Zoom) + "       Timer Interval = " + Str$(TimerInterval)

      Case %WM_Size : ResizeDialog

      Case %WM_Timer : ScrollImage : SetStatusBar

      Case %WM_Help

      Case %WM_Command
         Select Case Cb.Ctl
            Case %IdCancel        : sBeep : Dialog End hDlg
            Case %IDT_Exit        : sBeep : Dialog End hDlg
            Case %IDT_Scroll      : sBeep : ManageScroll : CreateToolbar
            Case %IDT_StopScroll  : sBeep : ManageScroll : CreateToolbar
            Case %IDT_Faster      : sBeep : ChangeSpeed(-1) : CreateToolbar
            Case %IDT_Slower      : sBeep : ChangeSpeed(+1) : CreateToolbar
            Case %IDT_Plus        : sBeep : Magnify(+1)
            Case %IDT_Minus       : sBeep : Magnify(-1)
            Case %IDT_ResetZoom   : sBeep : Magnify(0)
            Case %IDT_ResetScroll : sBeep : ResetScroll
            Case %IDT_ShowLine    : sBeep : ShowLine Xor=1 : DrawLines(IIf(ShowLine,%Red,-2)) : Graphic ReDraw
            Case %IDT_View        : sBeep : iReturn = ShellExecute(hDlg, "Open", "merge.bmp", $Nul, $Nul, %SW_ShowNormal)

         End Select

      Case %WM_Destroy
         settings_ini "save"
   End Select
End Function

Sub CreateStatusBar
   Control Add Statusbar, hDlg, %IDC_StatusBar, "Welcome to gbScroller v" + $Ver, 0,0,0,0, %CCS_Bottom Or %SBars_SizeGrip
   Control Get Size hDlg, %IDC_StatusBar To SBW, SBH
   Control Set Font hDlg, %IDC_StatusBar, hFont
End Sub

Sub CreateGraphic
   Local w,h As Long
   Dialog Get Client hDlg To w,h
   Control Add Graphic, hDlg, %IDC_Graphic, "", 10, TBH, w-20,h, %WS_Border
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   Graphic Set Virtual ImageWidth, ImageHeight
   Graphic Color %Black, %White
   Graphic Clear
End Sub

Sub CreateImageList
   ImageList New Icon 48,48,32,20 To hList
   ImageList Add Icon hList, "zexit"   '1
   ImageList Add Icon hList, "zleft"   '2
   ImageList Add Icon hList, "zright"  '3
   ImageList Add Icon hList, "zstop"  '4
   ImageList Add Icon hList, "zplus"  '5
   ImageList Add Icon hList, "zminus"  '6
   ImageList Add Icon hList, "zreset"  '7
   ImageList Add Icon hList, "zview"  '8
End Sub

Sub CreateToolbar
   Control Kill hDlg, %IDC_Toolbar
   Control Add Toolbar, hDlg, %IDC_Toolbar, "", 0,0,0,0 , %TbStyle_Flat Or %CCS_NoDivider
   Control Handle hDlg, %IDC_Toolbar To hToolbar
   Toolbar Set ImageList hDlg, %IDC_Toolbar, hList, 0

   Toolbar Add Button hDlg, %IDC_Toolbar, 1, %IDT_Exit, %TbStyle_Button, " Exit "

   Toolbar Add Separator hDlg, %IDC_Toolbar, 50

   Toolbar Add Button hDlg, %IDC_Toolbar, 5, %IDT_Plus, %TbStyle_Button, " ZoomIn "
   Toolbar Add Button hDlg, %IDC_Toolbar, 6, %IDT_Minus, %TbStyle_Button, " ZoomOut "
   Toolbar Add Button hDlg, %IDC_Toolbar, 7, %IDT_ResetZoom, %TbStyle_Button, " Reset "

   Toolbar Add Separator hDlg, %IDC_Toolbar, 50

   If Scroll = 0 Then Toolbar Add Button hDlg, %IDC_Toolbar, 8, %IDT_Scroll, %TbStyle_Button, " Scroll "
   If Scroll = 1 Then Toolbar Add Button hDlg, %IDC_Toolbar, 4, %IDT_StopScroll, %TbStyle_Button, " Stop "
   Toolbar Add Button hDlg, %IDC_Toolbar, 2, %IDT_Slower, %TbStyle_Button, " Slower "
   Toolbar Add Button hDlg, %IDC_Toolbar, 3, %IDT_Faster, %TbStyle_Button, " Faster "
   Toolbar Add Button hDlg, %IDC_Toolbar, 7, %IDT_ResetScroll, %TbStyle_Button, " Reset "

   Control Set Font hDlg, %IDC_StatusBar, hToolbar
   Control Get Size hDlg, %IDC_Toolbar To TBW, TBH

End Sub

Sub Settings_INI(Task$)
   Local x,y,w,h, tempz, INIFileName As WStringZ * %Max_Path, WinPla As WindowPlacement

   'set ini filename
   INIFileName = Exe.Path$ + Exe.Name$ + ".ini"    'get INI file name

   Select Case Task$
      Case "get"
         'get dialog width/height from INI file and use to set Dialog size
         GetPrivateProfileString "All", "Width", "1200", w, %Max_Path, INIFileName
         GetPrivateProfileString "All", "Height", "300", h, %Max_Path, INIFileName
         Dialog Set Size hDlg,Val(w), Val(h)   'width/height

         'get dialog top/left from INI file and use to set Dialog location
         Getprivateprofilestring "All", "Left", "0", x, %Max_Path, INIFileName
         Getprivateprofilestring "All", "Top", "0",  y,  %Max_Path, INIFileName
         If IsFile(INIFileName) Then Dialog Set Loc hDlg, Val(x), Val(y)   'left/top but only once INIFileName exists

         'get value for string variables
'         GetPrivateProfileString "All", "FontName", "Arial Black", FontName, %Max_Path, INIFileName

         'get value for numeric variables
         Getprivateprofilestring "All", "ImageWidth", "",        tempz, %Max_Path, INIFileName   : ImageWidth = Val(tempz)
         Getprivateprofilestring "All", "ImageHeight", "",       tempz, %Max_Path, INIFileName   : ImageHeight = Val(tempz)
         Getprivateprofilestring "All", "TimerIntereval", "50", tempz, %Max_Path, INIFileName   : TimerInterval = Val(tempz)
         Getprivateprofilestring "All", "Zoom", "1",             tempz, %Max_Path, INIFileName   : Zoom = Val(tempz)
         Getprivateprofilestring "All", "XDelta", "2",           tempz, %Max_Path, INIFileName   : XDelta = Val(tempz)
         Getprivateprofilestring "All", "ShowLine", "1",         tempz, %Max_Path, INIFileName   : ShowLine = Val(tempz)

      Case "save"
         If IsFile(INIFileName) Then Kill INIFileName    'clear the INI file Name to remove residual entries before saving
         WinPla.Length = SizeOf(WinPla)
         GetWindowPlacement hDlg, WinPla
         WritePrivateProfileString "All", "Left",   Str$(WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Top",    Str$(WinPla.rcNormalPosition.nTop), INIFileName
         WritePrivateProfileString "All", "Width",  Str$(WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Height", Str$(WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop), INIFileName

         'save string variables
'         WritePrivateProfileString "All", "FontName",   FontName, INIFileName

         'save numeric variables
         WritePrivateProfileString "All", "ImageHeight",    Str$(ImageHeight), INIFileName
         WritePrivateProfileString "All", "ImageWidth",     Str$(ImageWidth), INIFileName
         WritePrivateProfileString "All", "TimerInterval",  Str$(TimerInterval), INIFileName
         WritePrivateProfileString "All", "Zoom",           Str$(Zoom), INIFileName
         WritePrivateProfileString "All", "XDelta",         Str$(XDelta), INIFileName
         WritePrivateProfileString "All", "ShowLine",       Str$(ShowLine), INIFileName
   End Select
End Sub

Sub sBeep : WinBeep(275,150) : End Sub

Sub BuildAcceleratorTable
   Local ac() As ACCELAPI, hAccelerator As Dword, c As Long  ' for keyboard accelator table values
   Dim ac(2)
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_V  : ac(c).cmd = %IDT_View        : Incr c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_L  : ac(c).cmd = %IDT_ShowLine    : Incr c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_S  : ac(c).cmd = %IDT_Scroll      : Incr c
   Accel Attach hDlg, AC() To hAccelerator
End Sub

Sub ResizeDialog
   Local w,h, x1,y1 As Long
   Dialog Get Client hDlg To w,h
   Control Set Size hDlg, %IDC_Graphic, w-20, h-TBH-SBH-10
   Control Get Client hDlg, %IDC_Graphic To w,h

   x1 = 0
   y1 = (h-Zoom*ImageHeight)/2

   Graphic Color %Black, %White
   Graphic Width 2
   Graphic Clear
   Graphic Set StretchMode %HalfTone
   Graphic Render Bitmap "merge.bmp", (x1,y1)-(x1+Zoom*ImageWidth,y1+Zoom*ImageHeight)
   If ShowLine Then DrawLines (%Red)
   Graphic ReDraw
   SetStatusBar
End Sub

Sub DrawLines (LineColor As Long)
   Local w,h,i, SingleImageX As Long
   Graphic Get Canvas To w,h
   SingleImageX = w / ImageCount
   Graphic Color LineColor, %White
   For i = 1 To ImageCount-1
      Graphic Line (i*SingleImageX-5,0)-(i*SingleImageX-5,h)
   Next i
End Sub

Sub SetStatusBar
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "gbScroller v" + $Ver + "       Zoom = " + Str$(Zoom) + "       Timer Interval = " + Str$(TimerInterval) + "      " + Time$
End Sub

Function ImageCount As Long
   Local iCount As Long, temp$
   temp$ = Dir$("images\*.*")
   While Len(temp$)
      Incr iCount
      temp$ = Dir$(Next)
   Wend
   Function = iCount
End Function

Sub GetImageSize 'get image size for bmp$
   Local hBMP As Dword
   Graphic Bitmap Load "merge.bmp", 0, 0 To hBMP
   Graphic Attach hBMP, 0
   Graphic Get Canvas To ImageWidth, ImageHeight
   Graphic Bitmap End
End Sub

Sub ChangeSpeed(iDelta As Long)
   Select Case iDelta
      Case 0   : TimerInterval  = 0  : Scroll = 0 'stopped
      Case 1   : TimerInterval += 10 : Scroll = 1 'slower
      Case -1  : TimerInterval -= 10 : Scroll = 1 'faster
   End Select

   If TimerInterval < 10 Then TimerInterval = 10 : sBeep

   KillTimer hDlg, %ID_Timer
   SetTimer hDlg, %ID_Timer, TimerInterval, %Null
   SetStatusBar
End Sub

Sub Magnify(iDelta As Long)
   Select Case iDelta
      Case 0  : Zoom = 1
      Case 1  : Zoom += 0.25
      Case -1 : Zoom -= 0.25
   End Select
   If Zoom < 1 Then Zoom = 1
   ResizeDialog
End Sub

Sub ManageScroll
   Scroll Xor=1
   If Scroll Then
      SetTimer hDlg, %ID_Timer, TimerInterval, %Null
   Else
      KillTimer hDlg, %ID_Timer
   End If
End Sub

Sub ResetScroll
   Local w,h As Long
   Graphic Get View To w,h
   Graphic Set View 0, h
End Sub

Sub ScrollImage
   Local w,h,ww,hh,www,hhh As Long
   Graphic Get View To w,h
   Graphic Set View w+XDelta, h

   Control Get Client hDlg, %IDC_Graphic To www,hhh
   Graphic Get Canvas To ww,hh
   'Dialog Set Text hDlg, Str$(w+XDelta) + Str$(ImageWidth)

   If w+XDelta >= (ImageWidth-www) Then
      sBeep : sBeep
      ManageScroll : CreateToolbar
   End If
End Sub

Print this item

  gbClientCapture (Discussion)
Posted by: Gary Beene - 20.09.2025, 18:43 - Forum: PowerBASIC for Windows - Replies (21)

I decided to break the gbScroller app into two parts. The first is posted in the forum as gbClientCapture.

It captures the area under the transparent dialog client, merging each new capture into a horizontal image for subsequent scrolling. I've not yet written the scrolling app.

The area between the Toolbar and Statusbar is captured and merged into a horizontal image.

[Image: capture.jpg]


Some new features come to mind:

1. allow using the arrow keys to more accurately position the dialog
2. with transparency, the resize with a mouse ability is limited to the caption and toolbar. Not sure why but I know I don't like it.

Not a feature, but I notice there is a tiny gap between the caption and toolbar. I'm not sure why. I thought the toolbar by default would be positioned immediately next to the caption.

And, another thing, I tweaked the various dimensions to make sure the client area is captured, without overlapping the toolbar, statusbar and dialog borders. But it seems to me that I should have been able to do a more exact dimensioning of the capture positioning/size.

Here's how I envision this working.

1. Call up the electronic copy of the music (PDF in this example).
2. Place gbClientCapture over the first row of music (resize as needed)
3. Click "Copy"
4. Scroll the PDF upwards until the next row of music is under gbClientCapture (that should be easier than moving the dialog itself.
5. Click "Copy"
6. Repeat until all rows of music are captured and placed in the "merge.bmp" file.

In this example, the Adele music sheet PDF is displayed vertically in my browser.  The gbClientCapture is positioned over the first row, ready for "Copy".  Then, instead of moving the dialog to a new position, I scroll the PDF upwards until the next row of music is visible under the dialog client area. Repeat Copying untill all rows of music are captured. With each capture the "merge.bmp" file is updated to contain the most recent capture.

[Image: capture2.jpg]

Print this item

  gbClientCapture
Posted by: Gary Beene - 20.09.2025, 18:38 - Forum: Source Code Library - Replies (1)

This app displays a transparent dialog, with a Toolbar and a Statusbar. Images under the open dialog client area are captured and merged into a horizontal image.  This will be used by my next app to scroll the horizontal image - corresponding to my post about breaking vertical sheet music into scrollable horizontal music.

Discussion is here.

Toolbar buttons:

1. Exit - close gbClientCapture

2. Copy - captures the desktop below the transparent dialog client and saves it as a BMP. each capture is merged with previous captures to form a horizontal image (first captured image on the left, last captured image on the right)

3. New - deletes all images, including the merged image

4. View - opens the current merged image in the default image viewer

The Statusbar keeps track of how many images there are in the image folder.

Here's a picture of the app, with some desktop showing through the client area.

[Image: capture.jpg]

Code and images are here:  https://www.garybeene.com/files/gbclientcapture.zip

Code:
'Compilable Example:  (Jose Includes)
#Compile Exe  "gbclientcapture.exe"
#Dim All

#Debug Error On
#Debug Display On

%Unicode=1
#Include "Win32API.inc"

%IDC_Toolbar   = 500
%IDT_Exit      = 501
%IDT_Copy      = 502
%IDT_New       = 503
%IDT_View      = 504
%IDC_StatusBar = 505

#Resource Manifest, 1,      "icons\xptheme_dpiaware.xml"
#Resource VersionInfo
#Resource StringInfo "0409", "04B0"
#Resource Version$ "CompanyName", "New Vision Concepts"
#Resource Version$ "ProductName", "gbClientCapture"
#Resource Version$ "ProductVersion", "1.0"
#Resource Version$ "FileDescription",  "gbClientCapture - Capture Desktop Behind Client"
#Resource Version$ "LegalCopyright",   "Copyright 2025 New Vision Concepts"

#Resource Icon logo, "icons\alogo.ico"
#Resource Icon zexit, "icons\power.ico"
#Resource Icon zcopy, "icons\copy.ico"
#Resource Icon znew, "icons\new.ico"
#Resource Icon zmerge, "icons\view.ico"

$Ver = "1.0"

Global hDlg, hToolbar, hList, hBrush, hFont As Dword
Global ImageCount, ImageWidth, ImageHeight As Long
Global SBW, SBH, TBW, TBH As Long

Function PBMain() As Long
   Dialog New Pixels, 0, "gbClientCapture  v" + $Ver,300,50,200,100, %WS_OverlappedWindow, %WS_Ex_Layered To hDlg
   Dialog Set Icon hDlg, "logo"
   Dialog Set Color hDlg, %Black, %White
   CreateToolbar

   Control Add Statusbar, hDlg, %IDC_StatusBar, "", 0,0,0,0, %CCS_Bottom Or %SBars_SizeGrip
   Control Get Size hDlg, %IDC_StatusBar To SBW, SBH
   Control Set Color hDlg, %IDC_StatusBar, %Black, %Gray

   Font New "Tahoma",10, 1 To hFont
   Control Set Font hDlg, %IDC_Toolbar, hFont
   Control Set Font hDlg, %IDC_StatusBar, hFont

   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         hBrush = CreateSolidBrush(RGB(243,243,243))
         SetWindowPos hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
         If IsFalse IsFolder("images") Then MkDir "images"
         Settings_INI "get"
         Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)
         SetLayeredWindowAttributes(hDlg, %White, 255, %LWA_ALPHA Or %LWA_Colorkey)
      Case %WM_ContextMenu
         sBeep : Dialog End hDlg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDT_Exit  : sBeep : Dialog End hDlg
            Case %IDT_Copy  : sBeep : SaveDialogToClipboard : MergeImages
            Case %IDT_New   : sBeep : NewProject
            Case %IDT_View : sBeep : ViewMerge
         End Select

      Case %WM_Notify
         Select Case Cb.NmId
            Case %IDC_Toolbar
               Local pTbCustDraw As NmTbCustomDraw Pointer
               pTbCustDraw  = Cb.LParam
               Select Case @pTbCustDraw.nmcd.dwDrawStage
                  Case %CDDS_PREPAINT  ' paint entire toolbar
                     FillRect(@pTbCustDraw.nmcd.hdc, @pTbCustDraw.nmcd.rc, hBrush)
                     Function = %CDRF_NOTIFYITEMDRAW
               End Select
         End Select

      Case %WM_Destroy
         DeleteObject hBrush
         Settings_INI "save"
   End Select
End Function

Sub CreateToolbar
   ImageList New Icon 32,32,32,20 To hList
   ImageList Add Icon hList, "zexit"   '1
   ImageList Add Icon hList, "zcopy"   '2
   ImageList Add Icon hList, "znew"    '3
   ImageList Add Icon hList, "zmerge"  '4

   Control Add Toolbar, hDlg, %IDC_Toolbar, "", 0,0,0,0 ', %TbStyle_Flat
   Control Handle hDlg, %IDC_Toolbar To hToolbar
   Toolbar Set ImageList hDlg, %IDC_Toolbar, hList, 0

   Toolbar Add Button hDlg, %IDC_Toolbar, 1, %IDT_Exit, %TbStyle_Button, " Exit "
   Toolbar Add Button hDlg, %IDC_Toolbar, 2, %IDT_Copy, %TbStyle_Button, " Copy "
   Toolbar Add Button hDlg, %IDC_Toolbar, 3, %IDT_New, %TbStyle_Button, " New "
   Toolbar Add Button hDlg, %IDC_Toolbar, 4, %IDT_View, %TbStyle_Button, " View "

   Control Get Size hDlg, %IDC_Toolbar To TBW, TBH

End Sub

Sub Settings_INI(Task$)
   Local x,y,w,h, tempz, INIFileName As WStringZ * %Max_Path, WinPla As WindowPlacement

   'set ini filename
   INIFileName = Exe.Path$ + Exe.Name$ + ".ini"    'get INI file name

   Select Case Task$
      Case "get"
         'get dialog width/height from INI file and use to set Dialog size
         GetPrivateProfileString "All", "Width", "1200", w, %Max_Path, INIFileName
         GetPrivateProfileString "All", "Height", "300", h, %Max_Path, INIFileName
         Dialog Set Size hDlg,Val(w), Val(h)   'width/height

         'get dialog top/left from INI file and use to set Dialog location
         Getprivateprofilestring "All", "Left", "0", x, %Max_Path, INIFileName
         Getprivateprofilestring "All", "Top", "0",  y,  %Max_Path, INIFileName
         If IsFile(INIFileName) Then Dialog Set Loc hDlg, Val(x), Val(y)   'left/top but only once INIFileName exists

         'get value for string variables
'         GetPrivateProfileString "All", "FontName", "Arial Black", FontName, %Max_Path, INIFileName

         'get value for numeric variables
         Getprivateprofilestring "All", "ImageWidth", "",     tempz, %Max_Path, INIFileName   : ImageHeight = Val(tempz)
         Getprivateprofilestring "All", "ImageHeight", "",    tempz, %Max_Path, INIFileName   : ImageWidth = Val(tempz)
         Getprivateprofilestring "All", "ImageCount", "0",    tempz, %Max_Path, INIFileName   : ImageCount = Val(tempz)

      Case "save"
         If IsFile(INIFileName) Then Kill INIFileName    'clear the INI file Name to remove residual entries before saving
         WinPla.Length = SizeOf(WinPla)
         GetWindowPlacement hDlg, WinPla
         WritePrivateProfileString "All", "Left",   Str$(WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Top",    Str$(WinPla.rcNormalPosition.nTop), INIFileName
         WritePrivateProfileString "All", "Width",  Str$(WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Height", Str$(WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop), INIFileName

         'save string variables
'         WritePrivateProfileString "All", "FontName",   FontName, INIFileName

         'save numeric variables
         WritePrivateProfileString "All", "ImageHeight",    Str$(ImageHeight), INIFileName
         WritePrivateProfileString "All", "ImageWidth",     Str$(ImageWidth), INIFileName
         WritePrivateProfileString "All", "ImageCount",     Str$(ImageCount), INIFileName
   End Select
End Sub

Sub sBeep : WinBeep(275,150) : End Sub

Sub NewProject  'remove all \images\*.bmp
   Local temp$
   Clipboard Reset
   ImageCount = 0
   temp$ = Dir$("images\*.bmp")
   If Len(temp$) Then Kill "images\*.bmp"
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)
End Sub

Sub SaveDialogToClipboard
   Local x,y As Long, hBMP, hBMPDC, hDC As Dword       '         abcdegfg
   'create memory bitmap the size of the dialog client (less Toolbar and less StatusBar)
   Dialog Get Client hDlg To ImageWidth, ImageHeight
   ImageWidth = ImageWidth - 1
   ImageHeight = ImageHeight - SBH - TBH - 2

   Graphic Bitmap New ImageWidth, ImageHeight To hBMP
   Graphic Attach hBMP,0
   Graphic Get DC To hBMPDC

   'bitblt dialog rectangle from the screen to the me                            mory bitmap
   Dialog Get Loc hDlg To x,y
   x = x + 9
   y = y + TBH + CaptionHeight - 7
   hDC = GetDC(%Null)
   BitBlt hBMPDC, 0,0,ImageWidth,ImageHeight, hDC, x,y, %SRCCopy 'copy desktop image to
   ReleaseDC(%Null,hDC)

   'save to file
   Incr ImageCount
   Graphic Save "images\" + Format$(ImageCount) + ".bmp"

   'send to clipboard
   Clipboard Reset
   Clipboard Set Bitmap hBMP

   'get rid of the bitmap
   Graphic Bitmap End

   'count images
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)

End Sub

Function captionHeight As Long
   Local cw,ch,ddw,ddh As Long
   Dialog Get Size hDlg To ddw,ddh
   Dialog Get Client hDlg To cw,ch
   Function = ddh-ch
End Function

Sub MergeImages
   Local i, x1, y1, x2, y2 As Long
   Local hBMP, hBMPDC As Dword, ImageName$

   If IsFile("merge.bmp") Then Kill "merge.bmp"

   Graphic Bitmap New ImageCount*ImageWidth,ImageHeight To hBMP
   Graphic Attach hBMP,0
   Graphic Get DC To hBMPDC

   For i = 1 To ImageCount
      ImageName$ = "images\" + Format$(i) + ".bmp"
      x1 = (i-1) * ImageWidth
      x2 = x1 + ImageWidth
      y1 = 0
      y2 = ImageHeight
      Graphic Render Bitmap ImageName$, (x1,y1)-(x2,y2)
   Next i

   Graphic Save "merge.bmp"
   Graphic Bitmap End
End Sub

Sub ViewMerge
   Local iReturn As Long, hBMP As Dword

   Graphic Bitmap Load "merge.bmp", 0,0 To hBMP
   Graphic Attach hBMP,0

   Clipboard Reset
   Clipboard Set Bitmap hBMP

   Graphic Bitmap End

   iReturn = ShellExecute(hDlg, "Open", "merge.bmp", $Nul, $Nul, %SW_ShowNormal)
End Sub

Print this item

  File Transfer Between PCs
Posted by: Gary Beene - 19.09.2025, 21:32 - Forum: PowerBASIC for Windows - Replies (2)

I want to move all DOCX files from an old PC to my new PC, preferably by first putting them all on a flash drive which I use for the transfer.

I've posted code before that would capture a list of files anywhere on the PC that match a filespec such as "*.docx". I can use that to copy files to the flash.

But because some files have the same name, I can't just fill the root folder of the flash with all the files by their original name.  To do that I would have to rename files - such as with a simple prefix of "00001", "0002", etc.  Or, I could prefix the original folder name onto each file name, substituting the \ characters with an underscore.  That won't recreate the old folder structure on the new PC, but will at least capture all of the files.

Better yet, I could use something like Beyond Compare to find only DOCX files and replicate the original folder structure onto the new PC.  That's the most "exact" approach, but I'd have to be careful not to inappropriately overwrite any files on the new PC.

As best I know, the command line xcopy can do a similar thing but doesn't as easily et you pick and chose which files to copy.

Anyone use a better solution?

Print this item

  DOCX and XLSX Viewer
Posted by: Gary Beene - 18.09.2025, 03:30 - Forum: PowerBASIC for Windows - Replies (9)

I'd like to display DOCX and XLSX files with their full visual content.

But, I need for the solution to NOT require Word/Excel be installed on a user's PC.

Is that possible?

Print this item

  gbScroller - Vertical to Horizontal Music Converter
Posted by: Gary Beene - 17.09.2025, 16:13 - Forum: PowerBASIC for Windows - Replies (7)

From talking with a friend, I got the idea of writing a tool to convert music sheets from a portrait format to a scrollable, horizontal format.  I went looking on the web, thinking there must be one already, but did not find anything.  I have the basics working, but before I spent more time on it, I thought I'd see if anyone here knows of such a thing.

Here's an image showing the idea.  A vertical page of music, with multiple rows of content, would be converted to a horizontal image that can be scrolled at a specified rate.  There might be several pages to convert.

[Image: gbscroller.png]

My approach is to have a transparent, resizable dialog that the user places over a row of music and takes a snapshot of that row, then moves the dialog over the next row of music and takes another snapshot - repeating until all rows over multiple pages have been captured. All images would be the same size. gbScroller would merge the images into a single image, which could then be displayed and scrolled within the same app.

Print this item

Smile Comments re High resolution replacement for Sleep
Posted by: David Roberts - 14.09.2025, 00:00 - Forum: Programming - Replies (12)

I had a bit of a 'carrry on' creating post #2. I couldn't figure out the difference between 'Quick Edit' and 'Full Edit'. On one occasion, I got post #1 merging with post #2. On another occasion, I got post #2 being duplicated within itself.

Would someone explain the difference?

Anyway, the question is whether to use SleepX or SleepXX. I cannot answer that - only you can by trying the two source codes. On my Windows 10 machine with a Performance Counter Frequency of 10MHz and a CPU Base Frequency of 3.5GHz SleepXX is the more accurate.

If you have the time, would you let me know what your Performance Counter Frequency is, your CPU Base Frequency, and a console output of the more accurate.

Ta much.  Smile

Print this item