| Welcome, Guest |
You have to register before you can post on our site.
|
| 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! 
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
|
|
|
| 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. 
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
|
|
|
| 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,
|
|
|
| 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]](https://garybeene.com/files/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
|
|
|
| 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]](https://www.garybeene.com/files/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.
|
|
|
| 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]](https://www.garybeene.com/files/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
|
|
|
| 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?
|
|
|
| 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]](https://garybeene.com/files/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.
|
|
|
|