In the interest of Full Transparency...

Started by airr, August 13, 2024, 04:03:58 PM

Previous topic - Next topic

MrBcx

#5
Quote from: airr on August 13, 2024, 07:25:45 PM
Re: the white background issue:

I checked another program that does the same thing as mine, and it exhibits the same problem, so looks like a Windows rendering issue in general when using a transparent form with a light background...fore color of the widget doesn't matter....oh well...

Maybe tweak the transparency down from full.  Values range from 0 - 255.

Attached is a grab of my desktop clock set at a transparency of 200


airr

Re: the white background issue:

I checked another program that does the same thing as mine, and it exhibits the same problem, so looks like a Windows rendering issue in general when using a transparent form with a light background...fore color of the widget doesn't matter....oh well...


MrBcx

Most AI's say you cannot defeat the Show Desktop feature but several offer possible hacks, none of which work.

I even tried my own idea of setting a timer to check for IsIconic but that didn't work either. 

On the white background problem, which is a problem on my pc too, ONE IDEA would be to change the
color of your widget based on the average color of the background behind it.  I wrote the following routine for
BED to adjust the color of the carat, based on light or dark theme.  Maybe you can glean some use from it.
You would need to scan a patch of background and arrive at an average or median RGB value to feed to the
function. That too would require a timer to periodically poll the background, knowing wallpapers can change.

SUB SetCursorColor (bgColor AS DWORD)

    ' Determines cursor color based on background color DWORD (RGB)

    DIM AS BYTE R, G, B
    DIM AS DOUBLE luminance

    ' Extract RGB components from DWORD
    B = (bgColor AND &HFF0000) / &H10000
    G = (bgColor AND &HFF00) / &H100
    R = (bgColor AND &HFF)

    ' Calculate luminance
    luminance = 0.299 * R + 0.587 * G + 0.114 * B

    ' Determine cursor color
    IF luminance > 128 THEN
        SCICMD(SCI_SETCARETFORE, 0, RGB(255, 255, 255))        ' Bed's Black Cursor on lite background
    ELSE
        SCICMD(SCI_SETCARETFORE, RGB(255, 255, 255), 0)        ' Bed's White Cursor on dark background
    END IF
END SUB


airr

The other thing I need help with is figuring out why this renders okay with a Dark desktop background, but looks like utter trash with a Light background....part of it, I think, is ClearType, but it still looks like trash when I disable that....

airr

I was working on this last night.  It's not done, but wanted to know if anyone knows a way to have this ignore the "Show Desktop" minimize all apps feature:


GUI "Demo"
$NOWIN

MACRO HKLM = HKEY_LOCAL_MACHINE
MACRO REGKEY = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"

$Library <dnsapi.lib>
$Library <iphlpapi.lib>
$Library <ws2_32.lib>

#include <winsock2.h>
' #include <windows.h>

#include <commctrl.h>
#include <iphlpapi.h>
#include <sysinfoapi.h>
#include <windns.h>

SUB FORMLOAD
    GLOBAL AS CONTROL FORM1, lblComputerName, lblUserName, lblLocalIP, lblMacAddress, lblUpTime, lblOSName, lblOSVersion
    GLOBAL mac_address$, internal_ip$, user_name$, computer_name$, up_time$, external_ip_address$, up_time$, os_name$, os_version$
    GLOBAL buf_size = 2048 AS DWORD
    GLOBAL hThread as HANDLE
   

    ' ? STR$(BCX_ScaleX)
    DIM AS int screenWidth = GetSystemMetrics(SM_CXSCREEN)
    dim as int windowWidth = 400
    dim as int xPos = (screenWidth - windowWidth)/BCX_ScaleX

    FORM1 = BCX_FORM( "Transparent Form",xPos,0,windowWidth,140, WS_POPUP,  WS_EX_LAYERED OR WS_EX_TOOLWINDOW)
    BCX_SET_FORM_COLOR(FORM1,QBCOLOR(0))
    SetLayeredWindowAttributes(FORM1, 0, QBCOLOR(0), LWA_COLORKEY)

    setup()


    ' CENTER FORM1
    SHOW   FORM1
END SUB

BEGIN EVENTS
    SELECT CASE CBMSG
        CASE WM_CTLCOLORSTATIC
            SELECT CASE (HWND) CBLPARAM
                CASE lblUserName, lblComputerName, lblLocalIP, lblMacAddress, lblUpTime, lblOSName, lblOSVersion
                    RETURN BCX_SETCOLOR(QBCOLOR(15), QBCOLOR(0))
            END SELECT
    END SELECT
END EVENTS

SUB setup()
    GetUserName(user_name$, &buf_size)
    ' GetComputerName(computer_name$, &buf_size)
    computer_name$ = ENVIRON$("COMPUTERNAME")
    internal_ip$ = getActiveIP()
    external_ip_address$ = getExternalIP()
    getMacAddress(internal_ip$, mac_address$) 
    up_time$ = getUptime() 
    os_name$ = getOSName()
    os_version$ = getOSVersionNumber()

    lblComputerName = BCX_LABEL(computer_name$, FORM1, 0, 0, 10, 400, 20)
    lblOSName = BCX_LABEL("OSName: " & os_name$, FORM1, 0, 0, 30, 400, 20)
    lblOSVersion = BCX_LABEL("OSVersion: " & os_version$, FORM1, 0, 0, 50, 400, 20)
    lblUpTime = BCX_LABEL("UpTime: " & up_time$, FORM1, 0, 0, 70, 400, 20)
    lblUserName = BCX_LABEL("UserName: " & user_name$, FORM1, 0, 0,90,400,20)
    lblLocalIP = BCX_LABEL("IPAddress: " & internal_ip$, FORM1, 0, 0,110,400,20)
    lblMacAddress = BCX_LABEL("MacAddress: " & mac_address$, FORM1, 0, 0, 130, 400, 20)
   

    BCX_SET_FONT(lblComputerName, "Calibri", 18, FW_BOLD, false, true)
    BCX_SET_FONT(lblUserName, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblLocalIP, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblMacAddress, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblUpTime, "Calibri", 14, FW_BOLD)   
    BCX_SET_FONT(lblOSName, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblOSVersion, "Calibri", 14, FW_BOLD)
    hThread = BCX_THREAD(update)
END SUB

SUB update()
    WHILE TRUE
        DELAY 10 ' wait 10 seconds
        up_time$ = getUptime()
        BCX_SET_TEXT(lblUpTime, "UpTime: " & up_time$)
        ' refresh(FORM1)
        ' InvalidateRect(FORM1, 0, 1)
    WEND
END SUB

SUB getMacAddress(ip$, var$)
    DIM AdapterInfo[32] AS IP_ADAPTER_INFO, dwBufLen AS DWORD, pAdapterInfo AS PIP_ADAPTER_INFO
    DIM szBuffer$

    dwBufLen = SIZEOF(AdapterInfo)

    ' print GetAdaptersInfo(AdapterInfo, &dwBufLen)
    IF GetAdaptersInfo(AdapterInfo, &dwBufLen) != 0 THEN
        PRINT "Error initializing"
        EXIT SUB
    END IF

    pAdapterInfo = AdapterInfo

    WHILE pAdapterInfo

        IF TRIM$(pAdapterInfo->IpAddressList.IpAddress.String) = ip$ THEN
            SPRINT szBuffer$, HEX$(pAdapterInfo->Address[0]), ":", _
            HEX$(pAdapterInfo->Address[1]), ":", _
            HEX$(pAdapterInfo->Address[2]), ":", _
            HEX$(pAdapterInfo->Address[3]), ":", _
            HEX$(pAdapterInfo->Address[4]), ":", _
            HEX$(pAdapterInfo->Address[5])
            SPRINT var$, szBuffer
            EXIT WHILE
        END IF
        pAdapterInfo = pAdapterInfo->Next

    WEND

END SUB

FUNCTION getActiveIP$() AS STRING
    DIM socket_desc AS SOCKET, server AS SOCKADDR_IN, wsaData AS WSADATA
    DIM slen

    slen = SIZEOF(server)

    IF WSAStartup(MAKEWORD(1, 1), &wsaData) <> 0 THEN
        PRINT "WSAStartup failed"
        WSACleanup()
        RETURN ""
    END IF

    socket_desc = socket(AF_INET, SOCK_DGRAM, 0)
    IF socket_desc < 0 THEN
        PRINT "Socket Error"
        WSACleanup()
        FUNCTION = "Socket Error"
    END IF

    server.sin_addr.s_addr = inet_addr("1.0.0.0")
    server.sin_family = AF_INET
    server.sin_port = htons(65530)

    IF connect(socket_desc, (LPSOCKADDR)&server, SIZEOF(server)) < 0 THEN
        PRINT "Connect Error"
        WSACleanup()
        FUNCTION = "Connect Error"
    END IF

    getsockname(socket_desc,  (LPSOCKADDR)&server, &slen)

    WSACleanup()
    FUNCTION = inet_ntoa(server.sin_addr)
END FUNCTION

FUNCTION getUptime$()
    DIM STATIC tmp$
    DIM tc AS DWORD
    DIM days%, hours%, minutes%, seconds%

    tc = GetTickCount64()

    seconds% = IMOD((tc / 1000), 60)
    minutes% = IMOD((tc / 1000 / 60), 60)
    hours% =   IMOD((tc / 1000 / 60 / 60), 24 )
    days% =    IMOD((tc / 1000 / 60 / 60 / 24), 7)

    SPRINT tmp, days%, " Days,", hours%, " Hours,", minutes%, " Min,", seconds%, " Sec"

    FUNCTION = TRIM$(tmp)

END FUNCTION

FUNCTION getExternalIP$() AS STRING
    DIM status AS DNS_STATUS, pDnsRecord AS PDNS_RECORD
    RAW pSrvList AS PIP4_ARRAY
    DIM ipaddr AS IN_ADDR

    pSrvList = (PIP4_ARRAY)LocalAlloc(LPTR, SIZEOF(IP4_ARRAY))

    pSrvList->AddrCount = 1
    pSrvList->AddrArray[0] = inet_addr("208.67.222.222")

    status = DnsQuery("myip.opendns.com", DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pSrvList, &pDnsRecord, NULL)

    LocalFree(pSrvList)

    IF status THEN
        PRINT "Failed to query the host record. Error is: ", status
        FUNCTION = "N/A"
    END IF

    ipaddr.S_un.S_addr = (pDnsRecord->Data.A.IpAddress)

    FUNCTION = inet_ntoa(ipaddr)
END FUNCTION

Function getOSName() as string
    dim as string szProductName, szDisplayVersion, szOSName

    szProductName = REGSTRING$(HKLM, REGKEY, "ProductName")
    szDisplayVersion = REGSTRING$(HKLM, REGKEY, "DisplayVersion")

    if val(regstring$(HKLM, REGKEY, "CurrentBuildNumber")) >= 22000 Then
        szProductName = replace$(szProductName, "10","11")
    end if

    sprint szOSName, szProductName,spc$,szDisplayVersion
   
    Return szOSName

End Function

Function getOSVersionNumber() as string
    dim as integer iMajorVersion, iMinorVersion, iInstallDate, iUBR
    dim as string szBuildNumber, szOSBuild

    iMajorVersion = regint(HKLM, REGKEY, "CurrentMajorVersionNumber")
    iMinorVersion = regint(HKLM, REGKEY, "CurrentMinorVersionNumber")
    szBuildNumber = regstring$(HKLM, REGKEY, "CurrentBuildNumber")
    iInstallDate = regint(HKLM, REGKEY, "InstallDate")
    iUBR = regint(HKLM, REGKEY, "UBR")

    sprint szOSBuild, iMajorVersion, ".", str$(iMinorVersion,1), ".",szBuildNumber, ".", str$(iUBR,1)

    return TRIM$(szOSBuild)
End Function



AIR.