01-07-2026, 09:13 PM
Not rectangle program window
The following 4 programs show that in Windows you are not limited to rectangular or square program windows. How about a circular program window? The first example is the clock program. Yeah. There were those. But - where is the program window?
![[Image: image.png]](https://i.ibb.co/YBF5L9vg/image.png)
The second program shows how to do the same thing, with a transparent background. Slow version, notice the edge of the clock. The edge is still visible.
![[Image: image.png]](https://i.ibb.co/ZRHqrD2W/image.png)
The third version already includes a pre-calculated mask, so the program is less demanding on the processor. The clock border has also disappeared.
![[Image: image.png]](https://i.ibb.co/My5STcT7/image.png)
And finally, the latest version, here you can smoothly change the transparency of the clock edges with the mouse wheel.
![[Image: image.png]](https://i.ibb.co/sJzJdSVJ/image.png)
The following 4 programs show that in Windows you are not limited to rectangular or square program windows. How about a circular program window? The first example is the clock program. Yeah. There were those. But - where is the program window?
Code: (Select All)
Option _Explicit
' Circular window + analog clock demo for QB64PE (Windows)
'
' Key concept:
' Windows normally treats a window as a rectangle. You can "shape" the
' window by assigning it a region (HRGN). Anything outside that region is:
' - not visible (clipped away)
' - not hit-testable (mouse clicks fall through to whatever is underneath)
'
' This program does two important window-level operations:
' 1) Removes the standard window frame (title bar, borders, system buttons)
' because a non-rectangular region would otherwise cut those parts off.
' 2) Creates a circular region (CreateEllipticRgn) and applies it via
' SetWindowRgn, turning the window into a circle.
' POINTAPI is used by GetCursorPos()
' It stores the cursor position in SCREEN coordinates (desktop coordinate space).
Type POINTAPI
x As Long
y As Long
End Type
' RECT is used by GetWindowRect()
' It stores the window rectangle in SCREEN coordinates: Left/Top/Right/Bottom.
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'========================
' WinAPI declarations (user32.dll)
'========================
Declare Dynamic Library "user32"
' GetWindowLongPtrA / SetWindowLongPtrA:
' Read/modify window attributes stored inside the HWND.
'
' Important notes:
' - On 64-bit Windows, styles and pointers are "pointer-sized".
' - In QB64PE, _Offset is used to safely hold pointer-sized values.
'
' nIndex selects what you read/write:
' GWL_STYLE = base (standard) style flags (WS_*)
' GWL_EXSTYLE= extended style flags (WS_EX_*)
Function GetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long)
Function SetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long, ByVal dwNewLong As _Offset)
' SetWindowPos:
' Repositions/resizes a window and/or tells Windows to re-evaluate
' certain aspects (like frame changes) depending on flags.
'
' We use it for two reasons:
' - Apply the changed style immediately (SWP_FRAMECHANGED)
' - Optionally position the window (X,Y) and show it (SWP_SHOWWINDOW)
Function SetWindowPos& (ByVal hWnd As _Offset, ByVal hWndInsertAfter As _Offset, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long)
' SetWindowRgn:
' Assigns a clipping region to the window.
' The system uses this region to determine:
' - what part of the window is visible
' - what part receives mouse input
'
' After a successful call, Windows owns the region handle (HRGN).
' You must NOT delete it yourself (in C you would normally NOT call DeleteObject).
Function SetWindowRgn& (ByVal hWnd As _Offset, ByVal hRgn As _Offset, ByVal bRedraw As Long)
' GetCursorPos:
' Returns current cursor position in SCREEN coordinates.
' Used for dragging the window around with the mouse.
Function GetCursorPos& (lpPoint As POINTAPI)
' GetWindowRect:
' Returns the window's rectangle in SCREEN coordinates.
' Used to remember the original window position before dragging.
Function GetWindowRect& (ByVal hWnd As _Offset, lpRect As RECT)
End Declare
' GDI declarations (gdi32.dll)
Declare Dynamic Library "gdi32"
' CreateEllipticRgn:
' Creates an elliptical region that fits inside the given bounding box.
' If the bounding box is a square (width == height), the region is a circle.
'
' Parameters are in CLIENT coordinates of the window region:
' (0,0) is top-left of the window
' (diam, diam) is bottom-right
'
' Returns HRGN handle (pointer-sized) -> stored in _Offset
Function CreateEllipticRgn%& (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long)
End Declare
' Constants: window style manipulation
' GWL_STYLE selects the standard window style flags (WS_*).
Const GWL_STYLE = -16
' Standard style bits (WS_*):
' These control title bar, borders, and system buttons.
Const WS_CAPTION = &HC00000 ' Title bar area (caption)
Const WS_THICKFRAME = &H40000 ' Resizable border frame
Const WS_MINIMIZEBOX = &H20000 ' Minimize button
Const WS_MAXIMIZEBOX = &H10000 ' Maximize button
Const WS_SYSMENU = &H80000 ' System menu (icon/menu on the title bar)
' WS_POPUP:
' A top-level window without the standard overlapped frame.
' This is the typical base for shaped windows (no title bar to be cut off).
Const WS_POPUP = &H80000000
' Constants: SetWindowPos flags
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
' SWP_FRAMECHANGED:
' Tells Windows: "the frame/style changed; recompute non-client area".
' This is the key flag after changing window styles using SetWindowLongPtrA.
Const SWP_FRAMECHANGED = &H20
' SWP_SHOWWINDOW:
' Ensures the window is shown after style/position changes.
Const SWP_SHOWWINDOW = &H40
Dim diam As Long ' Diameter of the circular window (and client area)
Dim cx As Long, cy As Long ' Center coordinates (client space)
Dim r As Long ' Radius used for drawing the clock face
Dim hWnd As _Offset ' HWND (window handle) - pointer-sized
Dim style As _Offset ' Style bitfield - pointer-sized
Dim hRgn As _Offset ' HRGN (region handle) - pointer-sized
Dim N As Long ' Return values from WinAPI calls (success/failure codes)
' Dragging state variables
Dim dragActive As Long
Dim ptStart As POINTAPI, ptNow As POINTAPI
Dim rcStart As RECT
Dim wndStartLeft As Long, wndStartTop As Long
Dim startX As Long, startY As Long
Dim dx As Long, dy As Long
' Create QB64PE window / backbuffer
diam = 420
' Create a 32-bit image and use it as the screen.
' In QB64PE this becomes the window client area (your drawable surface).
Screen _NewImage(diam, diam, 32)
_Title "Circular Clock (ESC = konec)"
' Obtain HWND of the QB64PE window so we can call WinAPI on it.
hWnd = _WindowHandle
' 1) Convert the normal window into a borderless popup window
'
' Why this matters:
' If you apply a circular region to a normal "framed" window, Windows will
' also clip the title bar and borders. The result is visually broken:
' half a title bar, cut buttons, etc.
'
' So the correct approach for shaped windows is:
' - remove caption and borders
' - use WS_POPUP
' - provide your own close/drag behavior (ESC to close, click-drag to move)
' Read current standard style bits.
style = GetWindowLongPtrA(hWnd, GWL_STYLE)
' Clear the bits that define the standard frame.
' AND NOT(mask) clears those bits.
style = style And Not (WS_CAPTION Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU)
' Add WS_POPUP to make it a clean borderless top-level window.
style = style Or WS_POPUP
' Write the modified style back to the window.
N = SetWindowLongPtrA(hWnd, GWL_STYLE, style)
' Force Windows to re-apply/recalculate the window frame after style change.
' Also set an initial position and size (200,150) and show the window.
'
' Note:
' Without SWP_FRAMECHANGED, style changes may not visually apply immediately.
N = SetWindowPos(hWnd, 0, 200, 150, diam, diam, SWP_FRAMECHANGED Or SWP_SHOWWINDOW)
' 2) Create and apply a circular window region (HRGN)
'
' CreateEllipticRgn(0,0,diam,diam) makes an ellipse inside the client rectangle.
' Since width == height, that ellipse is a circle.
'
' SetWindowRgn then tells Windows: "this window exists only inside this region".
' Everything outside becomes:
' - not painted
' - not clickable (mouse input passes through)
'
' Ownership note (important):
' After SetWindowRgn succeeds, Windows owns the region object.
' You should NOT free/delete it yourself.
hRgn = CreateEllipticRgn(0, 0, diam, diam)
N = SetWindowRgn(hWnd, hRgn, -1) ' bRedraw=-1 requests immediate redraw
' Precompute drawing geometry
cx = diam \ 2
cy = diam \ 2
r = (diam \ 2) - 6
dragActive = 0
Do
' --- Exit key: ESC ---
If _KeyHit = 27 Then Exit Do
' --- Pump mouse events ---
' QB64PE requires consuming _MouseInput in a loop to keep state updated.
While _MouseInput
' Just pumping the input queue; no work needed here.
Wend
' Custom window dragging (since we removed title bar)
'
' When left mouse button is down:
' - On first frame: remember cursor position + window top-left
' - On subsequent frames: move window by cursor delta using SetWindowPos
'
' Coordinates:
' GetCursorPos and GetWindowRect both operate in SCREEN coordinates.
If _MouseButton(1) Then
If dragActive = 0 Then
dragActive = -1
N = GetCursorPos(ptStart)
N = GetWindowRect(hWnd, rcStart)
wndStartLeft = rcStart.Left
wndStartTop = rcStart.Top
startX = ptStart.x
startY = ptStart.y
Else
N = GetCursorPos(ptNow)
dx = ptNow.x - startX
dy = ptNow.y - startY
' Move only (no resize), keep z-order unchanged.
N = SetWindowPos(hWnd, 0, wndStartLeft + dx, wndStartTop + dy, 0, 0, SWP_NOSIZE Or SWP_NOZORDER)
End If
Else
dragActive = 0
End If
' --- Draw clock into the circular client area ---
Call DrawClock(cx, cy, r)
_Display
_Limit 60
Loop
End
' Analog clock drawing routine
Sub DrawClock (cx As Long, cy As Long, r As Long)
Dim t As String
Dim hh As Long, mm As Long, ss As Long
Dim hour12 As Long
Dim pi As Double
Dim aSec As Double, aMin As Double, aHour As Double
Dim radSec As Double, radMin As Double, radHour As Double
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
Dim i As Long
Dim tickIn As Double, tickOut As Double
Dim angDeg As Double, angRad As Double
Dim s As String
Dim tx As Long, ty As Long
pi = 3.141592653589793#
Cls , _RGB32(10, 10, 14)
' Clock face border + fill
Circle (cx, cy), r, _RGB32(220, 220, 230)
Paint (cx, cy), _RGB32(30, 30, 40), _RGB32(220, 220, 230)
' Tick marks: 60 markers; every 5th is longer (hour tick)
For i = 0 To 59
angDeg = i * 6
angRad = angDeg * pi / 180#
tickOut = r * 0.98
If (i Mod 5) = 0 Then
tickIn = r * 0.86
Else
tickIn = r * 0.92
End If
x1 = cx + Sin(angRad) * tickIn
y1 = cy - Cos(angRad) * tickIn
x2 = cx + Sin(angRad) * tickOut
y2 = cy - Cos(angRad) * tickOut
Line (x1, y1)-(x2, y2), _RGB32(200, 200, 210)
Next i
' Minimal readable numbers
Call PutNumber(cx, cy, r, 0, "12")
Call PutNumber(cx, cy, r, 90, "3")
Call PutNumber(cx, cy, r, 180, "6")
Call PutNumber(cx, cy, r, 270, "9")
' Read current time in HH:MM:SS
t = Time$
hh = Val(Left$(t, 2))
mm = Val(Mid$(t, 4, 2))
ss = Val(Right$(t, 2))
hour12 = hh Mod 12
' Convert to angles (degrees):
' second hand: 6 degrees per second
' minute hand: 6 degrees per minute + fractional by seconds
' hour hand : 30 degrees per hour + fractional by minutes/seconds
aSec = ss * 6#
aMin = (mm + ss / 60#) * 6#
aHour = (hour12 + mm / 60# + ss / 3600#) * 30#
' Convert degrees -> radians for SIN/COS
radSec = aSec * pi / 180#
radMin = aMin * pi / 180#
radHour = aHour * pi / 180#
' Hour hand (shorter, thicker via double line)
x2 = cx + Sin(radHour) * (r * 0.55)
y2 = cy - Cos(radHour) * (r * 0.55)
Line (cx, cy)-(x2, y2), _RGB32(240, 240, 245)
Line (cx + 1, cy)-(x2 + 1, y2), _RGB32(240, 240, 245)
' Minute hand
x2 = cx + Sin(radMin) * (r * 0.78)
y2 = cy - Cos(radMin) * (r * 0.78)
Line (cx, cy)-(x2, y2), _RGB32(230, 230, 235)
' Second hand
x2 = cx + Sin(radSec) * (r * 0.88)
y2 = cy - Cos(radSec) * (r * 0.88)
Line (cx, cy)-(x2, y2), _RGB32(255, 80, 80)
' Center cap
Circle (cx, cy), 4, _RGB32(255, 255, 255)
Paint (cx, cy), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
' Digital time at the bottom (inside the circle)
s = t
tx = cx - (Len(s) * 4)
ty = cy + r \ 2
_PrintString (tx, ty), s
End Sub
Sub PutNumber (cx As Long, cy As Long, r As Long, angDeg As Long, txt As String)
Dim pi As Double
Dim angRad As Double
Dim rr As Double
Dim x As Long, y As Long
pi = 3.141592653589793#
rr = r * 0.70
angRad = angDeg * pi / 180#
x = cx + Sin(angRad) * rr
y = cy - Cos(angRad) * rr
' Rough centering for the default QB64 font
x = x - (Len(txt) * 4)
y = y - 8
_PrintMode _KeepBackground
_PrintString (x, y), txt
End Sub
The second program shows how to do the same thing, with a transparent background. Slow version, notice the edge of the clock. The edge is still visible.
Code: (Select All)
Option _Explicit
' CIRCULAR CLOCK WINDOW WITH SOFT (ANTI-ALIASED) TRANSPARENT EDGES
'
' What we want:
' - A circular "floating" clock window on the desktop.
' - Smooth/feathered transparency at the outer edge (soft edge),
' so the background under the window is visible gradually.
'
' Why SetWindowRgn alone is NOT enough:
' - SetWindowRgn (HRGN) can only "hard-clip" the window to a shape.
' The result is a sharp, jagged edge (no alpha blending).
' - HRGN is binary: a pixel is either inside (fully visible) or outside
' (fully invisible). No gradual transparency.
'
' The correct method for smooth transparency in Windows:
' 1) Turn the window into a *layered window* by adding WS_EX_LAYERED.
' A layered window can be composited by the Desktop Window Manager (DWM)
' using per-pixel alpha (transparency) information.
'
' 2) Create a 32-bit bitmap (DIB section) that contains your final pixels:
' - 8-bit Alpha
' - 8-bit Red
' - 8-bit Green
' - 8-bit Blue
'
' 3) Build the image each frame:
' - Draw the clock normally into an offscreen QB64 image.
' - For each pixel, compute a circular alpha mask:
' * alpha = 255 inside the circle
' * alpha fades from 255 -> 0 within a "feather band" (edgeFeather)
' * alpha = 0 outside the outer radius
' - Apply alpha to the color using *premultiplied alpha*:
' R' = R * alpha / 255
' G' = G * alpha / 255
' B' = B * alpha / 255
'
' Premultiplied alpha is important because UpdateLayeredWindow expects
' pixels in premultiplied form when AC_SRC_ALPHA is used.
'
' 4) Push the 32-bit pixel buffer into the DIB section memory, then call
' UpdateLayeredWindow(..., ULW_ALPHA).
' Windows will composite the window with per-pixel alpha, giving smooth
' transparent edges.
'
' Optional: SetWindowRgn is still useful
' - We keep a circular HRGN mainly for input hit-testing:
' clicks outside the circle will pass through to windows behind.
' - Visual soft edge is still done by per-pixel alpha, not by the region.
'
' Performance note:
' - This demo does per-pixel CPU work each frame (diam*diam pixels).
' - For 420x420 it is usually fine. If needed, it can be optimized by
' precomputing the alpha mask once and reusing it.
' WinAPI / GDI structs
' Used by GetCursorPos() (screen coordinates).
Type POINTAPI
x As Long
y As Long
End Type
' Used by UpdateLayeredWindow(): the size of the bitmap.
Type SIZEAPI
cx As Long
cy As Long
End Type
' Used by GetWindowRect() (screen coordinates).
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Used by UpdateLayeredWindow() to describe how alpha blending is applied.
Type BLENDFUNCTION
BlendOp As _Unsigned _Byte ' Usually AC_SRC_OVER
BlendFlags As _Unsigned _Byte ' Must be 0
SourceConstantAlpha As _Unsigned _Byte ' Global alpha multiplier (255 = no change)
AlphaFormat As _Unsigned _Byte ' AC_SRC_ALPHA = per-pixel alpha is present
End Type
' Color entry used inside BITMAPINFO (we only need one dummy entry).
Type RGBQUAD
rgbBlue As _Unsigned _Byte
rgbGreen As _Unsigned _Byte
rgbRed As _Unsigned _Byte
rgbReserved As _Unsigned _Byte
End Type
' Describes the DIB section format (32-bit, width/height, etc.).
Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Declare Dynamic Library "user32"
' Get/SetWindowLongPtrA:
' Read/write window attributes (styles) stored in the HWND.
' We use:
' - GWL_STYLE for standard style bits (WS_*)
' - GWL_EXSTYLE for extended style bits (WS_EX_*)
Function GetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long)
Function SetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long, ByVal dwNewLong As _Offset)
' SetWindowPos:
' Moves/resizes a window and/or forces Windows to re-evaluate the frame.
' SWP_FRAMECHANGED is critical after changing style flags.
Function SetWindowPos& (ByVal hWnd As _Offset, ByVal hWndInsertAfter As _Offset, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long)
' SetWindowRgn:
' Assigns an HRGN to the window. This clips the window AND affects hit-test.
' After success, Windows owns the region object (do not delete it yourself).
Function SetWindowRgn& (ByVal hWnd As _Offset, ByVal hRgn As _Offset, ByVal bRedraw As Long)
' Used for custom dragging (cursor position in screen coords).
Function GetCursorPos& (lpPoint As POINTAPI)
' Used for custom dragging (window rectangle in screen coords).
Function GetWindowRect& (ByVal hWnd As _Offset, lpRect As RECT)
' GetDC/ReleaseDC:
' Get a device context. We use the screen DC (hWnd=0) as reference for GDI.
Function GetDC%& (ByVal hWnd As _Offset)
Function ReleaseDC& (ByVal hWnd As _Offset, ByVal hDC As _Offset)
' UpdateLayeredWindow:
' The key function for per-pixel alpha layered windows.
' It takes a source DC containing a 32-bit bitmap and composites it to the
' target window using alpha (ULW_ALPHA).
Function UpdateLayeredWindow& (ByVal hWnd As _Offset, ByVal hdcDst As _Offset, pptDst As POINTAPI, psize As SIZEAPI, ByVal hdcSrc As _Offset, pptSrc As POINTAPI, ByVal crKey As Long, pblend As BLENDFUNCTION, ByVal dwFlags As Long)
End Declare
Declare Dynamic Library "gdi32"
' CreateEllipticRgn:
' Creates an ellipse region inside the rectangle (left,top,right,bottom).
' If width == height, it is a circle.
Function CreateEllipticRgn%& (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long)
' CreateCompatibleDC:
' Creates a memory DC compatible with a given DC. We will select a DIB into it.
Function CreateCompatibleDC%& (ByVal hdc As _Offset)
Function DeleteDC& (ByVal hdc As _Offset)
' SelectObject:
' Selects a GDI object (bitmap) into a DC and returns previous selection.
Function SelectObject%& (ByVal hdc As _Offset, ByVal hObject As _Offset)
' DeleteObject:
' Deletes a GDI object (bitmap, region, etc). Note: region is owned by Windows
' after SetWindowRgn success, so we do not delete the region ourselves.
Function DeleteObject& (ByVal hObject As _Offset)
' CreateDIBSection:
' Creates a bitmap (DIB) and returns a pointer to its pixel memory (ppvBits).
' We use 32bpp BI_RGB (BGRA in memory).
Function CreateDIBSection%& (ByVal hdc As _Offset, bmi As BITMAPINFO, ByVal iUsage As Long, ppvBits As _Offset, ByVal hSection As _Offset, ByVal dwOffset As Long)
End Declare
' Fast memory copy
Declare Dynamic Library "kernel32"
' RtlMoveMemory:
' Copies raw bytes from src -> dest. We use it to copy our pixel array
' into the DIB section memory (pBits) efficiently.
Sub RtlMoveMemory (ByVal dest As _Offset, ByVal src As _Offset, ByVal cb As Long)
End Declare
' Indices for GetWindowLongPtr/SetWindowLongPtr
Const GWL_STYLE = -16
Const GWL_EXSTYLE = -20
' Standard window styles (frame/titlebar/system buttons)
Const WS_CAPTION = &HC00000
Const WS_THICKFRAME = &H40000
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const WS_SYSMENU = &H80000
' Popup window style (borderless top-level window)
Const WS_POPUP = &H80000000
' Extended style for layered windows
Const WS_EX_LAYERED = &H80000
' SetWindowPos flags
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
' DIB constants
Const BI_RGB = 0
Const DIB_RGB_COLORS = 0
' UpdateLayeredWindow blending constants
Const ULW_ALPHA = &H2
Const AC_SRC_OVER = 0
Const AC_SRC_ALPHA = 1
' Window / clock geometry
Dim diam As Long
Dim cx As Long, cy As Long
Dim rClock As Long
' Window handle and style words
Dim hWnd As _Offset
Dim style As _Offset
Dim exStyle As _Offset
Dim N As Long
' Dragging state
Dim dragActive As Long
Dim ptStart As POINTAPI, ptNow As POINTAPI
Dim rcStart As RECT
Dim wndStartLeft As Long, wndStartTop As Long
Dim startX As Long, startY As Long
Dim dx As Long, dy As Long
' Layered window / DIB objects
Dim hdcScreen As _Offset ' DC for the entire screen (desktop)
Dim hdcMem As _Offset ' Memory DC that will hold our DIB section
Dim hBmp As _Offset ' The DIB section bitmap handle
Dim hBmpOld As _Offset ' Previous bitmap selected into hdcMem
Dim pBits As _Offset ' Pointer to raw DIB pixel memory
Dim bmi As BITMAPINFO
Dim sz As SIZEAPI
Dim ptSrc As POINTAPI
Dim ptDst As POINTAPI
Dim blend As BLENDFUNCTION
' Offscreen QB64 image (we draw the clock here using QB64 primitives)
Dim img As Long
Dim memImg As _MEM
' Pixel buffer:
' We build a 32-bit AARRGGBB value per pixel in an array,
' then copy it into the DIB memory (pBits) using RtlMoveMemory.
Dim pixels As _Unsigned Long
Dim pixelCount As Long
Dim bytesCount As Long
' Soft-edge mask parameters
Dim Shared edgeFeather As Long ' Width (in pixels) of the alpha fade band
Dim Shared rEdge As Long ' Outer radius (alpha==0 outside)
Dim Shared rEdge2 As Long ' rEdge squared
Dim Shared rInner As Long ' Inner radius (alpha==255 inside)
Dim Shared rInner2 As Long ' rInner squared
' Loop variables / per-pixel work
Dim x As Long, y As Long
Dim idx As Long
Dim dxp As Long, dyp As Long
Dim d2 As Long
Dim dist As Single
Dim a As Long ' alpha 0..255 for current pixel
' Color channels / packing
Dim c~& ' QB64 pixel read from _MemGet
Dim rr As Long, gg As Long, bb As Long
Dim rp As Long, gp As Long, bp As Long
Dim outpt~&
' Basic setup
diam = 420
Screen _NewImage(diam, diam, 32)
_Title "circular clock - soft edge (ESC = end)"
' HWND of the QB64PE window
hWnd = _WindowHandle
' Create an offscreen image for the clock drawing.
' We will draw into this image, then read pixels from it.
img = _NewImage(diam, diam, 32)
memImg = _MemImage(img)
' 1) Make the QB64PE window borderless (WS_POPUP)
'
' Why:
' - A shaped/layered window usually looks wrong with a normal title bar.
' - We remove caption/borders/buttons and replace with WS_POPUP.
' - Since there is no title bar, we implement dragging manually (mouse).
style = GetWindowLongPtrA(hWnd, GWL_STYLE)
' Remove standard frame bits
style = style And Not (WS_CAPTION Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU)
' Add popup style
style = style Or WS_POPUP
N = SetWindowLongPtrA(hWnd, GWL_STYLE, style)
' 2) Enable WS_EX_LAYERED (required for per-pixel alpha)
'
' Without WS_EX_LAYERED:
' - UpdateLayeredWindow will not provide per-pixel transparency for the window.
' With WS_EX_LAYERED:
' - The window content can be composited from a 32-bit bitmap with alpha.
exStyle = GetWindowLongPtrA(hWnd, GWL_EXSTYLE)
exStyle = exStyle Or WS_EX_LAYERED
N = SetWindowLongPtrA(hWnd, GWL_EXSTYLE, exStyle)
' Apply style changes and show the window at initial position.
ptDst.x = 200
ptDst.y = 150
N = SetWindowPos(hWnd, 0, ptDst.x, ptDst.y, diam, diam, SWP_FRAMECHANGED Or SWP_SHOWWINDOW)
' 3) Optional: assign a circular window region (HRGN)
'
' Visual soft edge is done by alpha (UpdateLayeredWindow).
' The region is kept mainly for input behavior:
' - outside the circle, the window does not receive mouse clicks
' - clicks "fall through" to windows behind
Dim hRgn As _Offset
hRgn = CreateEllipticRgn(0, 0, diam, diam)
N = SetWindowRgn(hWnd, hRgn, -1)
' 4) Create a 32bpp DIB section that will be used as the source bitmap
' for UpdateLayeredWindow.
'
' Why DIB section:
' - It gives us a pointer (pBits) to raw pixel memory.
' - We can fill pixels directly, then Windows can use it for compositing.
'
' Important: top-down DIB
' - biHeight negative => the first scanline is the top row (y=0).
' - This matches the natural coordinate system we use in our loops.
hdcScreen = GetDC(0) ' Screen DC (desktop)
hdcMem = CreateCompatibleDC(hdcScreen)
bmi.bmiHeader.biSize = 40
bmi.bmiHeader.biWidth = diam
bmi.bmiHeader.biHeight = -diam ' Top-down DIB
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32 ' 32bpp
bmi.bmiHeader.biCompression = BI_RGB
bmi.bmiHeader.biSizeImage = diam * diam * 4
pBits = 0
hBmp = CreateDIBSection(hdcScreen, bmi, DIB_RGB_COLORS, pBits, 0, 0)
hBmpOld = SelectObject(hdcMem, hBmp)
' Parameters for UpdateLayeredWindow
sz.cx = diam
sz.cy = diam
ptSrc.x = 0
ptSrc.y = 0
blend.BlendOp = AC_SRC_OVER
blend.BlendFlags = 0
blend.SourceConstantAlpha = 255
blend.AlphaFormat = AC_SRC_ALPHA ' "Source bitmap has per-pixel alpha"
' Geometry for the clock and the soft edge mask
cx = diam \ 2
cy = diam \ 2
rClock = (diam \ 2) - 6
' Soft edge settings:
' edgeFeather is the width of the fade ring at the outer edge.
' Small values (4..12) look like anti-aliasing.
' Large values (like 120) create a huge halo where the whole clock area
' gradually fades out (often too much, but it is your dial).
edgeFeather = 120
rEdge = (diam \ 2) - 1
rEdge2 = rEdge * rEdge
rInner = rEdge - edgeFeather
rInner2 = rInner * rInner
' Prepare output pixel buffer
pixelCount = diam * diam
bytesCount = pixelCount * 4
ReDim pixels(0 To pixelCount - 1) As _Unsigned Long
dragActive = 0
Do
If _KeyHit = 27 Then Exit Do
' Pump mouse input queue so _MouseButton/_MouseWheel etc. stay current.
While _MouseInput
Wend
' Custom dragging:
' Because the window is WS_POPUP (no title bar), we move it ourselves.
' We do NOT call SetWindowPos every frame here:
' - ptDst is passed into UpdateLayeredWindow
' - UpdateLayeredWindow can reposition the layered window for us
If _MouseButton(1) Then
If dragActive = 0 Then
dragActive = -1
N = GetCursorPos(ptStart)
N = GetWindowRect(hWnd, rcStart)
wndStartLeft = rcStart.Left
wndStartTop = rcStart.Top
startX = ptStart.x
startY = ptStart.y
Else
N = GetCursorPos(ptNow)
dx = ptNow.x - startX
dy = ptNow.y - startY
ptDst.x = wndStartLeft + dx
ptDst.y = wndStartTop + dy
End If
Else
dragActive = 0
End If
' (1) Draw the clock into an offscreen QB64 image
'
' We use normal QB64 drawing primitives. This image is NOT
' directly shown. It is only a source of RGB color data.
_Dest img
Call DrawClock(cx, cy, rClock)
_Dest 0
' (2) Build premultiplied 32-bit pixels for UpdateLayeredWindow
'
' For each pixel:
' - Compute alpha based on distance from center:
' * 255 inside the inner radius
' * fade to 0 across the feather ring
' * 0 outside the outer radius
'
' - Read the RGB color from the QB64 offscreen image.
'
' - Premultiply:
' rp = rr * alpha / 255
' gp = gg * alpha / 255
' bp = bb * alpha / 255
'
' - Pack as AARRGGBB in a 32-bit integer.
' In memory (little-endian), this becomes BGRA byte order, which is
' exactly what the 32bpp BI_RGB DIB expects.
idx = 0
For y = 0 To diam - 1
dyp = y - cy
For x = 0 To diam - 1
dxp = x - cx
d2 = dxp * dxp + dyp * dyp
' Alpha mask with a fast squared-distance test:
' - avoid Sqr() unless we are in the feather band
If d2 >= rEdge2 Then
a = 0
ElseIf d2 <= rInner2 Then
a = 255
Else
dist = Sqr(d2)
a = (rEdge - dist) / edgeFeather * 255
If a < 0 Then a = 0
If a > 255 Then a = 255
End If
If a = 0 Then
' Fully transparent pixel -> ARGB = 0
pixels(idx) = 0
Else
' Read QB64 pixel (32-bit) from the offscreen image memory.
' Each pixel is 4 bytes. idx is linear index.
c~& = _MemGet(memImg, memImg.OFFSET + idx * 4, _Unsigned Long)
rr = _Red32(c~&)
gg = _Green32(c~&)
bb = _Blue32(c~&)
' Premultiply RGB by alpha
rp = (rr * a + 127) \ 255
gp = (gg * a + 127) \ 255
bp = (bb * a + 127) \ 255
' Pack to AARRGGBB (numeric). In memory this is BGRA bytes.
outpt~& = (a * &H1000000~&) Or (rp * &H10000~&) Or (gp * &H100~&) Or bp
pixels(idx) = outpt~&
End If
idx = idx + 1
Next x
Next y
' Copy our array into the DIB section memory. This is the buffer
' UpdateLayeredWindow will read from.
Call RtlMoveMemory(pBits, _Offset(pixels(0)), bytesCount)
' (3) Present the layered window (per-pixel alpha)
'
' UpdateLayeredWindow composites the source bitmap (hdcMem/hBmp)
' into our window at position ptDst using alpha (ULW_ALPHA).
N = UpdateLayeredWindow(hWnd, hdcScreen, ptDst, sz, hdcMem, ptSrc, 0, blend, ULW_ALPHA)
_Limit 30
Loop
' Cleanup (GDI + QB64 memory)
N = SelectObject(hdcMem, hBmpOld)
N = DeleteObject(hBmp)
N = DeleteDC(hdcMem)
N = ReleaseDC(0, hdcScreen)
_MemFree memImg
_FreeImage img
End
Sub DrawClock (cx As Long, cy As Long, r As Long) 'the same
Dim t As String
Dim hh As Long, mm As Long, ss As Long
Dim hour12 As Long
Dim pi As Double
Dim aSec As Double, aMin As Double, aHour As Double
Dim radSec As Double, radMin As Double, radHour As Double
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
Dim i As Long
Dim tickIn As Double, tickOut As Double
Dim angDeg As Double, angRad As Double
Dim s As String
Dim tx As Long, ty As Long
pi = 3.141592653589793#
Cls , _RGB32(10, 10, 14)
Circle (cx, cy), r, _RGB32(220, 220, 230)
Paint (cx, cy), _RGB32(30, 30, 40), _RGB32(220, 220, 230)
For i = 0 To 59
angDeg = i * 6
angRad = angDeg * pi / 180#
tickOut = r * 0.98
If (i Mod 5) = 0 Then
tickIn = r * 0.86
Else
tickIn = r * 0.92
End If
x1 = cx + Sin(angRad) * tickIn
y1 = cy - Cos(angRad) * tickIn
x2 = cx + Sin(angRad) * tickOut
y2 = cy - Cos(angRad) * tickOut
Line (x1, y1)-(x2, y2), _RGB32(200, 200, 210)
Next i
Call PutNumber(cx, cy, r, 0, "12")
Call PutNumber(cx, cy, r, 90, "3")
Call PutNumber(cx, cy, r, 180, "6")
Call PutNumber(cx, cy, r, 270, "9")
t = Time$
hh = Val(Left$(t, 2))
mm = Val(Mid$(t, 4, 2))
ss = Val(Right$(t, 2))
hour12 = hh Mod 12
aSec = ss * 6#
aMin = (mm + ss / 60#) * 6#
aHour = (hour12 + mm / 60# + ss / 3600#) * 30#
radSec = aSec * pi / 180#
radMin = aMin * pi / 180#
radHour = aHour * pi / 180#
x2 = cx + Sin(radHour) * (r * 0.55)
y2 = cy - Cos(radHour) * (r * 0.55)
Line (cx, cy)-(x2, y2), _RGB32(240, 240, 245)
Line (cx + 1, cy)-(x2 + 1, y2), _RGB32(240, 240, 245)
x2 = cx + Sin(radMin) * (r * 0.78)
y2 = cy - Cos(radMin) * (r * 0.78)
Line (cx, cy)-(x2, y2), _RGB32(230, 230, 235)
x2 = cx + Sin(radSec) * (r * 0.88)
y2 = cy - Cos(radSec) * (r * 0.88)
Line (cx, cy)-(x2, y2), _RGB32(255, 80, 80)
Circle (cx, cy), 4, _RGB32(255, 255, 255)
Paint (cx, cy), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
s = t
tx = cx - (Len(s) * 4)
ty = cy + r / 2
_PrintString (tx, ty), s
End Sub
Sub PutNumber (cx As Long, cy As Long, r As Long, angDeg As Long, txt As String)
Dim pi As Double
Dim angRad As Double
Dim rr As Double
Dim x As Long, y As Long
pi = 3.141592653589793#
rr = r * 0.70
angRad = angDeg * pi / 180#
x = cx + Sin(angRad) * rr
y = cy - Cos(angRad) * rr
x = x - (Len(txt) * 4)
y = y - 8
_PrintMode _KeepBackground
_PrintString (x, y), txt
End Sub
The third version already includes a pre-calculated mask, so the program is less demanding on the processor. The clock border has also disappeared.
Code: (Select All)
Option _Explicit
' CIRCULAR CLOCK WINDOW WITH HALO/FADE TRANSPARENT EDGES (Windows 10/11)
' ---------------------------------------------------------------------
'
' GOAL
' We want a circular clock window where the outer edge is not a hard cut,
' but a smooth "halo" fade: fully opaque inside, gradually transparent
' towards the outside, so the desktop behind is visible through the edge.
'
' WHY SetWindowRgn ALONE IS NOT ENOUGH
' SetWindowRgn (HRGN) can only hard-clip the window to a shape:
' - inside = fully visible
' - outside = fully invisible
' There is no per-pixel alpha, so no smooth fading.
'
' THE CORRECT METHOD: LAYERED WINDOW + UpdateLayeredWindow (per-pixel alpha)
' 1) Make the window WS_EX_LAYERED.
' This allows Windows DWM to composite the window from a 32-bit bitmap
' using alpha per pixel (0..255).
'
' 2) Create a 32bpp DIB section (CreateDIBSection) and obtain pointer pBits.
' That is raw pixel memory that Windows will read from.
'
' 3) Each frame:
' a) Draw clock normally into an offscreen QB64 image (img).
' b) Read its pixels (we copy them into srcPixels()).
' c) For each pixel compute final alpha from a precomputed alpha mask:
' alphaMask(idx) = 0..255
' This mask encodes the circular halo/fade.
' d) Premultiply RGB by alpha (required by UpdateLayeredWindow):
' R' = R * A / 255
' G' = G * A / 255
' B' = B * A / 255
' e) Store final pixel as AARRGGBB (in memory this becomes BGRA).
' f) Copy the final pixel buffer into pBits.
' g) Call UpdateLayeredWindow(..., ULW_ALPHA).
'
' PRECOMPUTING THE HALO MASK (IMPORTANT OPTIMIZATION)
' The circular alpha mask depends only on:
' - window size (diam)
' - center (cx, cy)
' - outer radius rEdge
' - feather width edgeFeather
' These are constant, so alphaMask(idx) can be computed ONCE at startup.
' Then each frame we reuse alphaMask(idx) without doing sqrt() repeatedly.
'
' OPTIONAL: SetWindowRgn still helps
' Even though visuals come from per-pixel alpha, we keep a circular region
' so that mouse clicks outside the circle fall through to windows behind.
Type POINTAPI
x As Long
y As Long
End Type
Type SIZEAPI
cx As Long
cy As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type BLENDFUNCTION
BlendOp As _Unsigned _Byte
BlendFlags As _Unsigned _Byte
SourceConstantAlpha As _Unsigned _Byte
AlphaFormat As _Unsigned _Byte
End Type
Type RGBQUAD
rgbBlue As _Unsigned _Byte
rgbGreen As _Unsigned _Byte
rgbRed As _Unsigned _Byte
rgbReserved As _Unsigned _Byte
End Type
Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Declare Dynamic Library "user32"
Function GetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long)
Function SetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long, ByVal dwNewLong As _Offset)
Function SetWindowPos& (ByVal hWnd As _Offset, ByVal hWndInsertAfter As _Offset, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long)
Function SetWindowRgn& (ByVal hWnd As _Offset, ByVal hRgn As _Offset, ByVal bRedraw As Long)
Function GetCursorPos& (lpPoint As POINTAPI)
Function GetWindowRect& (ByVal hWnd As _Offset, lpRect As RECT)
Function GetDC%& (ByVal hWnd As _Offset)
Function ReleaseDC& (ByVal hWnd As _Offset, ByVal hDC As _Offset)
Function UpdateLayeredWindow& (ByVal hWnd As _Offset, ByVal hdcDst As _Offset, pptDst As POINTAPI, psize As SIZEAPI, ByVal hdcSrc As _Offset, pptSrc As POINTAPI, ByVal crKey As Long, pblend As BLENDFUNCTION, ByVal dwFlags As Long)
End Declare
Declare Dynamic Library "gdi32"
Function CreateEllipticRgn%& (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long)
Function CreateCompatibleDC%& (ByVal hdc As _Offset)
Function DeleteDC& (ByVal hdc As _Offset)
Function SelectObject%& (ByVal hdc As _Offset, ByVal hObject As _Offset)
Function DeleteObject& (ByVal hObject As _Offset)
Function CreateDIBSection%& (ByVal hdc As _Offset, bmi As BITMAPINFO, ByVal iUsage As Long, ppvBits As _Offset, ByVal hSection As _Offset, ByVal dwOffset As Long)
End Declare
Declare Dynamic Library "kernel32"
Sub RtlMoveMemory (ByVal dest As _Offset, ByVal src As _Offset, ByVal cb As Long)
End Declare
Const GWL_STYLE = -16
Const GWL_EXSTYLE = -20
Const WS_CAPTION = &HC00000
Const WS_THICKFRAME = &H40000
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const WS_SYSMENU = &H80000
Const WS_POPUP = &H80000000
Const WS_EX_LAYERED = &H80000
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
Const BI_RGB = 0
Const DIB_RGB_COLORS = 0
Const ULW_ALPHA = &H2
Const AC_SRC_OVER = 0
Const AC_SRC_ALPHA = 1
Dim diam As Long
Dim cx As Long, cy As Long
Dim rClock As Long
Dim hWnd As _Offset
Dim style As _Offset
Dim exStyle As _Offset
Dim hRgn As _Offset
Dim N As Long
' Dragging
Dim dragActive As Long
Dim ptStart As POINTAPI, ptNow As POINTAPI
Dim rcStart As RECT
Dim wndStartLeft As Long, wndStartTop As Long
Dim startX As Long, startY As Long
Dim dx As Long, dy As Long
' Layered window / DIB
Dim hdcScreen As _Offset
Dim hdcMem As _Offset
Dim hBmp As _Offset
Dim hBmpOld As _Offset
Dim pBits As _Offset
Dim bmi As BITMAPINFO
Dim sz As SIZEAPI
Dim ptSrc As POINTAPI
Dim ptDst As POINTAPI
Dim blend As BLENDFUNCTION
' Offscreen QB64 image
Dim img As Long
Dim memImg As _MEM
' Source pixels (raw clock drawing copied from QB64 image)
Dim srcPixels As _Unsigned Long
' Output pixels (premultiplied + alpha mask applied)
Dim pixels As _Unsigned Long
Dim pixelCount As Long
Dim bytesCount As Long
' Precomputed alpha mask (halo/fade)
Dim alphaMask As _Unsigned _Byte
' Mask geometry parameters
Dim edgeFeather As Long
Dim rEdge As Long
Dim rEdge2 As Long
Dim rInner As Long
Dim rInner2 As Long
' Loop variables (kept here to respect "no DIM inside loops")
Dim idx As Long
Dim x As Long, y As Long
Dim a As Long
Dim c~&
Dim rr As Long, gg As Long, bb As Long
Dim rp As Long, gp As Long, bp As Long
Dim outpt~&
' Setup
diam = 420
Screen _NewImage(diam, diam, 32)
_Title "Circular Clock - no border - HALO/Fade (ESC = end)"
hWnd = _WindowHandle
' Offscreen image where we draw the clock using QB64 primitives.
img = _NewImage(diam, diam, 32)
memImg = _MemImage(img)
' Pixel counts (used for copying blocks of memory)
pixelCount = diam * diam
bytesCount = pixelCount * 4
ReDim srcPixels(0 To pixelCount - 1) As _Unsigned Long
ReDim pixels(0 To pixelCount - 1) As _Unsigned Long
ReDim alphaMask(0 To pixelCount - 1) As _Unsigned _Byte
' 1) Make the window borderless (WS_POPUP)
style = GetWindowLongPtrA(hWnd, GWL_STYLE)
style = style And Not (WS_CAPTION Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU)
style = style Or WS_POPUP
N = SetWindowLongPtrA(hWnd, GWL_STYLE, style)
' 2) Enable layered window (WS_EX_LAYERED) so per-pixel alpha is possible
exStyle = GetWindowLongPtrA(hWnd, GWL_EXSTYLE)
exStyle = exStyle Or WS_EX_LAYERED
N = SetWindowLongPtrA(hWnd, GWL_EXSTYLE, exStyle)
' Apply style changes and show at initial position
ptDst.x = 200
ptDst.y = 150
N = SetWindowPos(hWnd, 0, ptDst.x, ptDst.y, diam, diam, SWP_FRAMECHANGED Or SWP_SHOWWINDOW)
' 3) Optional: region for hit-test (click-through outside the circle)
hRgn = CreateEllipticRgn(0, 0, diam, diam)
N = SetWindowRgn(hWnd, hRgn, -1)
' 4) Create DIB section (32bpp) that UpdateLayeredWindow will use
hdcScreen = GetDC(0)
hdcMem = CreateCompatibleDC(hdcScreen)
bmi.bmiHeader.biSize = 40
bmi.bmiHeader.biWidth = diam
bmi.bmiHeader.biHeight = -diam ' top-down DIB
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = BI_RGB
bmi.bmiHeader.biSizeImage = bytesCount
pBits = 0
hBmp = CreateDIBSection(hdcScreen, bmi, DIB_RGB_COLORS, pBits, 0, 0)
hBmpOld = SelectObject(hdcMem, hBmp)
sz.cx = diam
sz.cy = diam
ptSrc.x = 0
ptSrc.y = 0
blend.BlendOp = AC_SRC_OVER
blend.BlendFlags = 0
blend.SourceConstantAlpha = 255
blend.AlphaFormat = AC_SRC_ALPHA
' Clock geometry + HALO mask geometry
cx = diam \ 2
cy = diam \ 2
rClock = (diam \ 2) - 6
' HALO/Fade settings:
' edgeFeather defines how wide the fade band is.
' Large values produce a big halo; small values produce only slight AA.
edgeFeather = 120
' Outer edge radius (fully transparent outside)
rEdge = (diam \ 2) - 1
rEdge2 = rEdge * rEdge
' Inner radius (fully opaque inside). Clamp to 0 in case feather is huge.
rInner = rEdge - edgeFeather
If rInner < 0 Then rInner = 0
rInner2 = rInner * rInner
' Build alpha mask ONCE (no per-frame sqrt needed)
Call BuildAlphaMask(alphaMask(), diam, cx, cy, rInner2, rEdge2, rInner, rEdge, edgeFeather)
dragActive = 0
Do
If _KeyHit = 27 Then Exit Do
While _MouseInput
Wend
' Custom window dragging (left mouse button), since WS_POPUP has no titlebar
If _MouseButton(1) Then
If dragActive = 0 Then
dragActive = -1
N = GetCursorPos(ptStart)
N = GetWindowRect(hWnd, rcStart)
wndStartLeft = rcStart.Left
wndStartTop = rcStart.Top
startX = ptStart.x
startY = ptStart.y
Else
N = GetCursorPos(ptNow)
dx = ptNow.x - startX
dy = ptNow.y - startY
ptDst.x = wndStartLeft + dx
ptDst.y = wndStartTop + dy
End If
Else
dragActive = 0
End If
' 1) Draw the clock into the offscreen QB64 image (img)
_Dest img
Call DrawClock(cx, cy, rClock)
_Dest 0
' Copy raw pixels from QB64 offscreen image into srcPixels() in one go.
' This avoids calling _MemGet per pixel (usually faster).
Call RtlMoveMemory(_Offset(srcPixels(0)), memImg.OFFSET, bytesCount)
' 2) Apply halo alpha + premultiply RGB into output pixel buffer
'
' alphaMask(idx) already contains 0..255:
' - 255 inside the inner radius
' - smooth fade through the feather band
' - 0 outside the outer radius
'--------------- ------------------------------------------------------
idx = 0
For y = 0 To diam - 1
For x = 0 To diam - 1
a = alphaMask(idx)
If a = 0 Then
pixels(idx) = 0
Else
c~& = srcPixels(idx)
rr = _Red32(c~&)
gg = _Green32(c~&)
bb = _Blue32(c~&)
' Premultiply RGB by alpha (required for AC_SRC_ALPHA)
rp = (rr * a + 127) \ 255
gp = (gg * a + 127) \ 255
bp = (bb * a + 127) \ 255
' Pack AARRGGBB (little-endian memory = BGRA bytes)
outpt~& = (a * &H1000000~&) Or (rp * &H10000~&) Or (gp * &H100~&) Or bp
pixels(idx) = outpt~&
End If
idx = idx + 1
Next x
Next y
' Copy final pixels into DIB section memory and present
Call RtlMoveMemory(pBits, _Offset(pixels(0)), bytesCount)
N = UpdateLayeredWindow(hWnd, hdcScreen, ptDst, sz, hdcMem, ptSrc, 0, blend, ULW_ALPHA)
_Limit 30
Loop
N = SelectObject(hdcMem, hBmpOld)
N = DeleteObject(hBmp)
N = DeleteDC(hdcMem)
N = ReleaseDC(0, hdcScreen)
_MemFree memImg
_FreeImage img
End
' BuildAlphaMask
' Precomputes alphaMask(idx) for a circular halo/fade.
'
' Inputs:
' diam : window width/height (square)
' cx, cy : circle center in pixels
' rInner2 : inner radius squared (alpha=255 inside)
' rEdge2 : outer radius squared (alpha=0 outside)
' rInner : inner radius (not squared)
' rEdge : outer radius
' edgeFeather : width of fade band (pixels)
'
' Alpha profile:
' - Inside rInner => A = 255
' - Outside rEdge => A = 0
' - Between => smooth fade using smoothstep to reduce visible banding:
' t = (rEdge - dist) / edgeFeather (t in 0..1)
' t = t*t*(3 - 2*t) (smoothstep)
' A = t * 255
Sub BuildAlphaMask (alphaMask() As _Unsigned _Byte, diam As Long, cx As Long, cy As Long, rInner2 As Long, rEdge2 As Long, rInner As Long, rEdge As Long, edgeFeather As Long)
Dim x As Long, y As Long
Dim idx As Long
Dim dxp As Long, dyp As Long
Dim d2 As Long
Dim dist As Single
Dim t As Single
Dim a As Long
idx = 0
For y = 0 To diam - 1
dyp = y - cy
For x = 0 To diam - 1
dxp = x - cx
d2 = dxp * dxp + dyp * dyp
If d2 >= rEdge2 Then
alphaMask(idx) = 0
ElseIf d2 <= rInner2 Then
alphaMask(idx) = 255
Else
' Only the fade band needs sqrt()
dist = Sqr(d2)
' Normalize to 0..1 across the feather band
t = (rEdge - dist) / edgeFeather
If t < 0! Then t = 0!
If t > 1! Then t = 1!
' Smoothstep easing (visually nicer halo, less "ring banding")
t = t * t * (3! - 2! * t)
a = CInt(t * 255!)
If a < 0 Then a = 0
If a > 255 Then a = 255
alphaMask(idx) = a
End If
idx = idx + 1
Next x
Next y
End Sub
'the same again...
Sub DrawClock (cx As Long, cy As Long, r As Long)
Dim t As String
Dim hh As Long, mm As Long, ss As Long
Dim hour12 As Long
Dim pi As Double
Dim aSec As Double, aMin As Double, aHour As Double
Dim radSec As Double, radMin As Double, radHour As Double
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
Dim i As Long
Dim tickIn As Double, tickOut As Double
Dim angDeg As Double, angRad As Double
Dim s As String
Dim tx As Long, ty As Long
pi = 3.141592653589793#
Cls , _RGB32(10, 10, 14)
Circle (cx, cy), r, _RGB32(220, 220, 230)
Paint (cx, cy), _RGB32(30, 30, 40), _RGB32(220, 220, 230)
For i = 0 To 59
angDeg = i * 6
angRad = angDeg * pi / 180#
tickOut = r * 0.98
If (i Mod 5) = 0 Then
tickIn = r * 0.86
Else
tickIn = r * 0.92
End If
x1 = cx + Sin(angRad) * tickIn
y1 = cy - Cos(angRad) * tickIn
x2 = cx + Sin(angRad) * tickOut
y2 = cy - Cos(angRad) * tickOut
Line (x1, y1)-(x2, y2), _RGB32(200, 200, 210)
Next i
Call PutNumber(cx, cy, r, 0, "12")
Call PutNumber(cx, cy, r, 90, "3")
Call PutNumber(cx, cy, r, 180, "6")
Call PutNumber(cx, cy, r, 270, "9")
t = Time$
hh = Val(Left$(t, 2))
mm = Val(Mid$(t, 4, 2))
ss = Val(Right$(t, 2))
hour12 = hh Mod 12
aSec = ss * 6#
aMin = (mm + ss / 60#) * 6#
aHour = (hour12 + mm / 60# + ss / 3600#) * 30#
radSec = aSec * pi / 180#
radMin = aMin * pi / 180#
radHour = aHour * pi / 180#
x2 = cx + Sin(radHour) * (r * 0.55)
y2 = cy - Cos(radHour) * (r * 0.55)
Line (cx, cy)-(x2, y2), _RGB32(240, 240, 245)
Line (cx + 1, cy)-(x2 + 1, y2), _RGB32(240, 240, 245)
x2 = cx + Sin(radMin) * (r * 0.78)
y2 = cy - Cos(radMin) * (r * 0.78)
Line (cx, cy)-(x2, y2), _RGB32(230, 230, 235)
x2 = cx + Sin(radSec) * (r * 0.88)
y2 = cy - Cos(radSec) * (r * 0.88)
Line (cx, cy)-(x2, y2), _RGB32(255, 80, 80)
Circle (cx, cy), 4, _RGB32(255, 255, 255)
Paint (cx, cy), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
s = t
tx = cx - (Len(s) * 4)
ty = cy + r / 2
_PrintString (tx, ty), s
End Sub
Sub PutNumber (cx As Long, cy As Long, r As Long, angDeg As Long, txt As String)
Dim pi As Double
Dim angRad As Double
Dim rr As Double
Dim x As Long, y As Long
pi = 3.141592653589793#
rr = r * 0.70
angRad = angDeg * pi / 180#
x = cx + Sin(angRad) * rr
y = cy - Cos(angRad) * rr
x = x - (Len(txt) * 4)
y = y - 8
_PrintMode _KeepBackground
_PrintString (x, y), txt
End Sub
And finally, the latest version, here you can smoothly change the transparency of the clock edges with the mouse wheel.
Code: (Select All)
Option _Explicit
' CIRCULAR CLOCK WINDOW WITH HALO/FADE TRANSPARENT EDGES (Windows 10/11)
' ---------------------------------------------------------------------
'
' GOAL
' We want a circular clock window where the outer edge is not a hard cut,
' but a smooth "halo" fade: fully opaque inside, gradually transparent
' towards the outside, so the desktop behind is visible through the edge.
'
' WHY SetWindowRgn ALONE IS NOT ENOUGH
' SetWindowRgn (HRGN) can only hard-clip the window to a shape:
' - inside = fully visible
' - outside = fully invisible
' There is no per-pixel alpha, so no smooth fading.
'
' THE CORRECT METHOD: LAYERED WINDOW + UpdateLayeredWindow (per-pixel alpha)
' 1) Make the window WS_EX_LAYERED.
' This allows Windows DWM to composite the window from a 32-bit bitmap
' using alpha per pixel (0..255).
'
' 2) Create a 32bpp DIB section (CreateDIBSection) and obtain pointer pBits.
' That is raw pixel memory that Windows will read from.
'
' 3) Each frame:
' a) Draw clock normally into an offscreen QB64 image (img).
' b) Read its pixels (we copy them into srcPixels()).
' c) For each pixel compute final alpha from a precomputed alpha mask:
' alphaMask(idx) = 0..255
' This mask encodes the circular halo/fade.
' d) Premultiply RGB by alpha (required by UpdateLayeredWindow):
' R' = R * A / 255
' G' = G * A / 255
' B' = B * A / 255
' e) Store final pixel as AARRGGBB (in memory this becomes BGRA).
' f) Copy the final pixel buffer into pBits.
' g) Call UpdateLayeredWindow(..., ULW_ALPHA).
'
' PRECOMPUTING THE HALO MASK (IMPORTANT OPTIMIZATION)
' The circular alpha mask depends only on:
' - window size (diam)
' - center (cx, cy)
' - outer radius rEdge
' - feather width edgeFeather
' These are constant, so alphaMask(idx) can be computed ONCE at startup.
' Then each frame we reuse alphaMask(idx) without doing sqrt() repeatedly.
'
' OPTIONAL: SetWindowRgn still helps
' Even though visuals come from per-pixel alpha, we keep a circular region
' so that mouse clicks outside the circle fall through to windows behind.
Type POINTAPI
x As Long
y As Long
End Type
Type SIZEAPI
cx As Long
cy As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type BLENDFUNCTION
BlendOp As _Unsigned _Byte
BlendFlags As _Unsigned _Byte
SourceConstantAlpha As _Unsigned _Byte
AlphaFormat As _Unsigned _Byte
End Type
Type RGBQUAD
rgbBlue As _Unsigned _Byte
rgbGreen As _Unsigned _Byte
rgbRed As _Unsigned _Byte
rgbReserved As _Unsigned _Byte
End Type
Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Declare Dynamic Library "user32"
Function GetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long)
Function SetWindowLongPtrA%& (ByVal hWnd As _Offset, ByVal nIndex As Long, ByVal dwNewLong As _Offset)
Function SetWindowPos& (ByVal hWnd As _Offset, ByVal hWndInsertAfter As _Offset, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long)
Function SetWindowRgn& (ByVal hWnd As _Offset, ByVal hRgn As _Offset, ByVal bRedraw As Long)
Function GetCursorPos& (lpPoint As POINTAPI)
Function GetWindowRect& (ByVal hWnd As _Offset, lpRect As RECT)
Function GetDC%& (ByVal hWnd As _Offset)
Function ReleaseDC& (ByVal hWnd As _Offset, ByVal hDC As _Offset)
Function UpdateLayeredWindow& (ByVal hWnd As _Offset, ByVal hdcDst As _Offset, pptDst As POINTAPI, psize As SIZEAPI, ByVal hdcSrc As _Offset, pptSrc As POINTAPI, ByVal crKey As Long, pblend As BLENDFUNCTION, ByVal dwFlags As Long)
End Declare
Declare Dynamic Library "gdi32"
Function CreateEllipticRgn%& (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long)
Function CreateCompatibleDC%& (ByVal hdc As _Offset)
Function DeleteDC& (ByVal hdc As _Offset)
Function SelectObject%& (ByVal hdc As _Offset, ByVal hObject As _Offset)
Function DeleteObject& (ByVal hObject As _Offset)
Function CreateDIBSection%& (ByVal hdc As _Offset, bmi As BITMAPINFO, ByVal iUsage As Long, ppvBits As _Offset, ByVal hSection As _Offset, ByVal dwOffset As Long)
End Declare
Declare Dynamic Library "kernel32"
Sub RtlMoveMemory (ByVal dest As _Offset, ByVal src As _Offset, ByVal cb As Long)
End Declare
Const GWL_STYLE = -16
Const GWL_EXSTYLE = -20
Const WS_CAPTION = &HC00000
Const WS_THICKFRAME = &H40000
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const WS_SYSMENU = &H80000
Const WS_POPUP = &H80000000
Const WS_EX_LAYERED = &H80000
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
Const BI_RGB = 0
Const DIB_RGB_COLORS = 0
Const ULW_ALPHA = &H2
Const AC_SRC_OVER = 0
Const AC_SRC_ALPHA = 1
Dim diam As Long
Dim cx As Long, cy As Long
Dim rClock As Long
Dim hWnd As _Offset
Dim style As _Offset
Dim exStyle As _Offset
Dim hRgn As _Offset
Dim N As Long
' Dragging
Dim dragActive As Long
Dim ptStart As POINTAPI, ptNow As POINTAPI
Dim rcStart As RECT
Dim wndStartLeft As Long, wndStartTop As Long
Dim startX As Long, startY As Long
Dim dx As Long, dy As Long
' Layered window / DIB
Dim hdcScreen As _Offset
Dim hdcMem As _Offset
Dim hBmp As _Offset
Dim hBmpOld As _Offset
Dim pBits As _Offset
Dim bmi As BITMAPINFO
Dim sz As SIZEAPI
Dim ptSrc As POINTAPI
Dim ptDst As POINTAPI
Dim blend As BLENDFUNCTION
' Offscreen QB64 image
Dim img As Long
Dim memImg As _MEM
' Source pixels (raw clock drawing copied from QB64 image)
Dim srcPixels As _Unsigned Long
' Output pixels (premultiplied + alpha mask applied)
Dim pixels As _Unsigned Long
Dim pixelCount As Long
Dim bytesCount As Long
' Precomputed alpha mask (halo/fade)
Dim alphaMask As _Unsigned _Byte
Dim gammaEdge As Single
gammaEdge = 0.6! ' <1 = fatter/brighter halo, >1 = tighter halo
' Mask geometry parameters
Dim edgeFeather As Long
Dim rEdge As Long
Dim rEdge2 As Long
Dim rInner As Long
Dim rInner2 As Long
' Loop variables
Dim idx As Long
Dim x As Long, y As Long
Dim a As Long
Dim c~&
Dim rr As Long, gg As Long, bb As Long
Dim rp As Long, gp As Long, bp As Long
Dim outpt~&
Dim Shared oldGammaEdge As Single
Dim Shared gammaStep As Single
Dim Shared gammaMin As Single
Dim Shared gammaMax As Single
Dim Shared wheelDelta As Long
'========================
' Setup
'========================
diam = 420
Screen _NewImage(diam, diam, 32)
_Title "Circular Clock - no border - HALO/Fade (ESC = end)"
hWnd = _WindowHandle
' Offscreen image where we draw the clock using QB64 primitives.
img = _NewImage(diam, diam, 32)
memImg = _MemImage(img)
' Pixel counts (used for copying blocks of memory)
pixelCount = diam * diam
bytesCount = pixelCount * 4
ReDim srcPixels(0 To pixelCount - 1) As _Unsigned Long
ReDim pixels(0 To pixelCount - 1) As _Unsigned Long
ReDim alphaMask(0 To pixelCount - 1) As _Unsigned _Byte
' 1) Make the window borderless (WS_POPUP)
style = GetWindowLongPtrA(hWnd, GWL_STYLE)
style = style And Not (WS_CAPTION Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU)
style = style Or WS_POPUP
N = SetWindowLongPtrA(hWnd, GWL_STYLE, style)
' 2) Enable layered window (WS_EX_LAYERED) so per-pixel alpha is possible
exStyle = GetWindowLongPtrA(hWnd, GWL_EXSTYLE)
exStyle = exStyle Or WS_EX_LAYERED
N = SetWindowLongPtrA(hWnd, GWL_EXSTYLE, exStyle)
' Apply style changes and show at initial position
ptDst.x = 200
ptDst.y = 150
N = SetWindowPos(hWnd, 0, ptDst.x, ptDst.y, diam, diam, SWP_FRAMECHANGED Or SWP_SHOWWINDOW)
' 3) Optional: region for hit-test (click-through outside the circle)
hRgn = CreateEllipticRgn(0, 0, diam, diam)
N = SetWindowRgn(hWnd, hRgn, -1)
' 4) Create DIB section (32bpp) that UpdateLayeredWindow will use
hdcScreen = GetDC(0)
hdcMem = CreateCompatibleDC(hdcScreen)
bmi.bmiHeader.biSize = 40
bmi.bmiHeader.biWidth = diam
bmi.bmiHeader.biHeight = -diam ' top-down DIB
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = BI_RGB
bmi.bmiHeader.biSizeImage = bytesCount
pBits = 0
hBmp = CreateDIBSection(hdcScreen, bmi, DIB_RGB_COLORS, pBits, 0, 0)
hBmpOld = SelectObject(hdcMem, hBmp)
sz.cx = diam
sz.cy = diam
ptSrc.x = 0
ptSrc.y = 0
blend.BlendOp = AC_SRC_OVER
blend.BlendFlags = 0
blend.SourceConstantAlpha = 255
blend.AlphaFormat = AC_SRC_ALPHA
' Clock geometry + HALO mask geometry
cx = diam \ 2
cy = diam \ 2
rClock = (diam \ 2) - 6
' HALO/Fade settings:
' edgeFeather defines how wide the fade band is.
' Large values produce a big halo; small values produce only slight AA.
edgeFeather = 120
gammaEdge = 0.6!
oldGammaEdge = gammaEdge
gammaStep = 0.05! ' wheel step; try 0.02 for finer control
gammaMin = 0.2!
gammaMax = 5.0!
' Outer edge radius (fully transparent outside)
rEdge = (diam \ 2) - 1
rEdge2 = rEdge * rEdge
' Inner radius (fully opaque inside). Clamp to 0 in case feather is huge.
rInner = rEdge - edgeFeather
If rInner < 0 Then rInner = 0
rInner2 = rInner * rInner
' Build alpha mask ONCE (no per-frame sqrt needed)
'new:
Call BuildAlphaMask(alphaMask(), diam, cx, cy, rInner2, rEdge2, rInner, rEdge, edgeFeather, gammaEdge)
dragActive = 0
Do
If _KeyHit = 27 Then Exit Do
wheelDelta = 0
While _MouseInput
wheelDelta = wheelDelta + _MouseWheel
Wend
' --- Mouse wheel: change gammaEdge and rebuild halo mask only when needed ---
If wheelDelta <> 0 Then
gammaEdge = gammaEdge + wheelDelta * gammaStep
If gammaEdge < gammaMin Then gammaEdge = gammaMin
If gammaEdge > gammaMax Then gammaEdge = gammaMax
' Recompute mask only if gamma actually changed (avoid useless work)
If gammaEdge <> oldGammaEdge Then
oldGammaEdge = gammaEdge
Call BuildAlphaMask(alphaMask(), diam, cx, cy, rInner2, rEdge2, rInner, rEdge, edgeFeather, gammaEdge)
End If
End If
' Custom window dragging (left mouse button), since WS_POPUP has no titlebar
If _MouseButton(1) Then
If dragActive = 0 Then
dragActive = -1
N = GetCursorPos(ptStart)
N = GetWindowRect(hWnd, rcStart)
wndStartLeft = rcStart.Left
wndStartTop = rcStart.Top
startX = ptStart.x
startY = ptStart.y
Else
N = GetCursorPos(ptNow)
dx = ptNow.x - startX
dy = ptNow.y - startY
ptDst.x = wndStartLeft + dx
ptDst.y = wndStartTop + dy
End If
Else
dragActive = 0
End If
' 1) Draw the clock into the offscreen QB64 image (img)
_Dest img
Call DrawClock(cx, cy, rClock)
_Dest 0
' Copy raw pixels from QB64 offscreen image into srcPixels() in one go.
' This avoids calling _MemGet per pixel (usually faster).
Call RtlMoveMemory(_Offset(srcPixels(0)), memImg.OFFSET, bytesCount)
' 2) Apply halo alpha + premultiply RGB into output pixel buffer
'
' alphaMask(idx) already contains 0..255:
' - 255 inside the inner radius
' - smooth fade through the feather band
' - 0 outside the outer radius
'--------------- ------------------------------------------------------
idx = 0
For y = 0 To diam - 1
For x = 0 To diam - 1
a = alphaMask(idx)
If a = 0 Then
pixels(idx) = 0
Else
c~& = srcPixels(idx)
rr = _Red32(c~&)
gg = _Green32(c~&)
bb = _Blue32(c~&)
' Premultiply RGB by alpha (required for AC_SRC_ALPHA)
rp = (rr * a + 127) \ 255
gp = (gg * a + 127) \ 255
bp = (bb * a + 127) \ 255
' Pack AARRGGBB (little-endian memory = BGRA bytes)
outpt~& = (a * &H1000000~&) Or (rp * &H10000~&) Or (gp * &H100~&) Or bp
pixels(idx) = outpt~&
End If
idx = idx + 1
Next x
Next y
' Copy final pixels into DIB section memory and present
Call RtlMoveMemory(pBits, _Offset(pixels(0)), bytesCount)
N = UpdateLayeredWindow(hWnd, hdcScreen, ptDst, sz, hdcMem, ptSrc, 0, blend, ULW_ALPHA)
_Limit 30
Loop
N = SelectObject(hdcMem, hBmpOld)
N = DeleteObject(hBmp)
N = DeleteDC(hdcMem)
N = ReleaseDC(0, hdcScreen)
_MemFree memImg
_FreeImage img
End
' BuildAlphaMask
' Precomputes alphaMask(idx) for a circular halo/fade.
'
' Inputs:
' diam : window width/height (square)
' cx, cy : circle center in pixels
' rInner2 : inner radius squared (alpha=255 inside)
' rEdge2 : outer radius squared (alpha=0 outside)
' rInner : inner radius (not squared)
' rEdge : outer radius
' edgeFeather : width of fade band (pixels)
'
' Alpha profile:
' - Inside rInner => A = 255
' - Outside rEdge => A = 0
' - Between => smooth fade using smoothstep to reduce visible banding:
' t = (rEdge - dist) / edgeFeather (t in 0..1)
' t = t*t*(3 - 2*t) (smoothstep)
' A = t * 255
Sub BuildAlphaMask (alphaMask() As _Unsigned _Byte, diam As Long, cx As Long, cy As Long, rInner2 As Long, rEdge2 As Long, rInner As Long, rEdge As Long, edgeFeather As Long, gammaEdge As Single)
Dim x As Long, y As Long
Dim idx As Long
Dim dxp As Long, dyp As Long
Dim d2 As Long
Dim dist As Single
Dim t As Single
Dim a As Long
' Safety: gamma must be > 0
If gammaEdge <= 0! Then gammaEdge = 1!
idx = 0
For y = 0 To diam - 1
dyp = y - cy
For x = 0 To diam - 1
dxp = x - cx
d2 = dxp * dxp + dyp * dyp
If d2 >= rEdge2 Then
alphaMask(idx) = 0
ElseIf d2 <= rInner2 Then
alphaMask(idx) = 255
Else
' Fade band only: we need sqrt() to get actual distance
dist = Sqr(d2)
' Normalize across feather band:
' dist = rInner -> t = 1
' dist = rEdge -> t = 0
t = (rEdge - dist) / edgeFeather
If t < 0! Then t = 0!
If t > 1! Then t = 1!
' Exponential profile:
' gamma < 1 : "fatter" halo (brighter further outward)
' gamma > 1 : tighter halo (drops faster)
t = t ^ gammaEdge
a = CInt(t * 255!)
If a < 0 Then a = 0
If a > 255 Then a = 255
alphaMask(idx) = a
End If
idx = idx + 1
Next x
Next y
End Sub
'the same again...
Sub DrawClock (cx As Long, cy As Long, r As Long)
Dim t As String
Dim hh As Long, mm As Long, ss As Long
Dim hour12 As Long
Dim pi As Double
Dim aSec As Double, aMin As Double, aHour As Double
Dim radSec As Double, radMin As Double, radHour As Double
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
Dim i As Long
Dim tickIn As Double, tickOut As Double
Dim angDeg As Double, angRad As Double
Dim s As String
Dim tx As Long, ty As Long
pi = 3.141592653589793#
Cls , _RGB32(10, 10, 14)
Circle (cx, cy), r, _RGB32(220, 220, 230)
Paint (cx, cy), _RGB32(30, 30, 40), _RGB32(220, 220, 230)
For i = 0 To 59
angDeg = i * 6
angRad = angDeg * pi / 180#
tickOut = r * 0.98
If (i Mod 5) = 0 Then
tickIn = r * 0.86
Else
tickIn = r * 0.92
End If
x1 = cx + Sin(angRad) * tickIn
y1 = cy - Cos(angRad) * tickIn
x2 = cx + Sin(angRad) * tickOut
y2 = cy - Cos(angRad) * tickOut
Line (x1, y1)-(x2, y2), _RGB32(200, 200, 210)
Next i
Call PutNumber(cx, cy, r, 0, "12")
Call PutNumber(cx, cy, r, 90, "3")
Call PutNumber(cx, cy, r, 180, "6")
Call PutNumber(cx, cy, r, 270, "9")
t = Time$
hh = Val(Left$(t, 2))
mm = Val(Mid$(t, 4, 2))
ss = Val(Right$(t, 2))
hour12 = hh Mod 12
aSec = ss * 6#
aMin = (mm + ss / 60#) * 6#
aHour = (hour12 + mm / 60# + ss / 3600#) * 30#
radSec = aSec * pi / 180#
radMin = aMin * pi / 180#
radHour = aHour * pi / 180#
x2 = cx + Sin(radHour) * (r * 0.55)
y2 = cy - Cos(radHour) * (r * 0.55)
Line (cx, cy)-(x2, y2), _RGB32(240, 240, 245)
Line (cx + 1, cy)-(x2 + 1, y2), _RGB32(240, 240, 245)
x2 = cx + Sin(radMin) * (r * 0.78)
y2 = cy - Cos(radMin) * (r * 0.78)
Line (cx, cy)-(x2, y2), _RGB32(230, 230, 235)
x2 = cx + Sin(radSec) * (r * 0.88)
y2 = cy - Cos(radSec) * (r * 0.88)
Line (cx, cy)-(x2, y2), _RGB32(255, 80, 80)
Circle (cx, cy), 4, _RGB32(255, 255, 255)
Paint (cx, cy), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
s = t
tx = cx - (Len(s) * 4)
ty = cy + r / 2
_PrintString (tx, ty), s
_PrintString (tx - 20, cy - r / 2), "Use mousewheel!"
End Sub
Sub PutNumber (cx As Long, cy As Long, r As Long, angDeg As Long, txt As String)
Dim pi As Double
Dim angRad As Double
Dim rr As Double
Dim x As Long, y As Long
pi = 3.141592653589793#
rr = r * 0.70
angRad = angDeg * pi / 180#
x = cx + Sin(angRad) * rr
y = cy - Cos(angRad) * rr
x = x - (Len(txt) * 4)
y = y - 8
_PrintMode _KeepBackground
_PrintString (x, y), txt
End Sub