Windows API: Loading resources and displaying non-rectangular splash screens 2005-02-11 -- Ron Schofield Newsgroups: comp.lang.clarion
Solved: Thanks to Randy Rogers
PROGRAM
INCLUDE('Equates.CLW')
INCLUDE('Keycodes.CLW')
BITMAP GROUP,TYPE
bmType LONG
bmWidth LONG
bmHeight LONG
bmWidthBytes LONG
bmPlanes LONG
bmBitsPixel LONG
bmBits LONG
END
BITMAPFILEHEADER GROUP,TYPE
bfType USHORT
bfSize ULONG
bfReserved1 USHORT
bfReserved2 USHORT
bfOffBits ULONG
END
BITMAPINFOHEADER GROUP,TYPE
biSize ULONG
biWidth LONG
biHeight LONG
biPlanes USHORT
biBitCount USHORT
biCompression ULONG
biSizeImage ULONG
biXPelsPerMeter LONG
biYPelsPerMeter LONG
biClrUsed ULONG
biClrImportant ULONG
END
RGBQUAD GROUP,TYPE
rgbBlue BYTE
rgbGreen BYTE
rgbRed BYTE
rgbReserved BYTE
END
BITMAPINFO GROUP,TYPE
bmiHeader LIKE(BITMAPINFOHEADER)
bmiColors LIKE(RGBQUAD)
END
RGN_OR EQUATE(2)
COLOUR:Transparent EQUATE(0FF00FFh) ! Set to the colour you want
to be trasparent
! or create a variable and
have pixel 0,0 as
! the transparent value and set
CBM_INIT EQUATE(4)
DIB_RGB_COLORS EQUATE(0)
MAP
Main()
ProgramSplash()
MODULE('GDI32 Library')
CombineRgn(ULONG hRgnDest,ULONG hRgnSrc1,ULONG hRgnSrc2,|
LONG fnCombineMode),|
LONG,RAW,PASCAL,PROC,NAME('CombineRgn')
CreateCompatibleDC(ULONG hDC),|
ULONG,RAW,PASCAL,NAME('CreateCompatibleDC')
CreateDIBitmap(ULONG hDC,*BITMAPINFOHEADER,ULONG fdwInit,|
ULONG lpbInit,*BITMAPINFO,USHORT fuUsage,|
ULONG,RAW,PASCAL,NAME('CreateDIBitmap')
CreateRectRgn(LONG nLeftRect,LONG nTopRect,LONG nRightRect,|
LONG nBottomRect),|
ULONG,RAW,PASCAL,NAME('CreateRectRgn')
DeleteDC(ULONG hDC),LONG,RAW,PASCAL,PROC,NAME('DeleteDC')
DeleteObject(ULONG hgGDIObj),|
LONG,RAW,PASCAL,PROC,NAME('DeleteObject')
GetObject(ULONG hgGDIObj,LONG cbBuffer,LONG lpvObject),|
LONG,RAW,PASCAL,PROC,NAME('GetObjectA')
GetPixel(ULONG hDC,LONG nXPos,LONG nYPos),|
ULONG,RAW,PASCAL,NAME('GetPixel')
SelectObject(ULONG hDC,ULONG hgGDIObj),|
ULONG,RAW,PASCAL,PROC,NAME('SelectObject')
END
MODULE('User32 Library')
GetDC(ULONG hWnd),ULONG,RAW,PASCAL,NAME('GetDC')
ReleaseDC(ULONG hWnd,ULONG hDC),|
ULONG,RAW,PASCAL,PROC,NAME('ReleaseDC')
SetWindowRgn(ULONG hWnd,ULONG hRgn,LONG bRedraw),|
LONG,RAW,PASCAL,PROC,NAME('SetWindowRgn')
END
MODULE('Kernel32 Library')
FindResource(ULONG hModule,*CSTRING lpName,*CSTRING lpType),|
ULONG,RAW,PASCAL,NAME('FindResourceA')
GetLastError(),ULONG,PASCAL,RAW,NAME('GetLastError')
LoadResource(ULONG hModule, ULONG hResInfo),|
ULONG,RAW,PASCAL,NAME('LoadResource')
LockResource(ULONG hResData),ULONG,RAW,PASCAL,NAME('LockResource')
END
END
CODE
Main()
Main PROCEDURE()
SplashThread LONG
AppFrame APPLICATION('Non-rectangular Splash
Screen'),AT(,,280,100),ICON('bluecode.ico'),SYSTEM,RESIZE
END
CODE
OPEN(AppFrame)
ACCEPT
CASE EVENT()
OF EVENT:OpenWindow
SplashThread = START(ProgramSplash)
OF EVENT:CloseWindow
RETURN
ELSE
IF SplashThread
IF EVENT() = EVENT:Accepted
POST(EVENT:CloseWindow,,SplashThread)
CLEAR(SplashThread)
END
END
END
END
ProgramSplash PROCEDURE()
SplashWindow WINDOW,AT(,,207,70),CENTER,WALLPAPER('Splash256.bmp'),|
CENTERED,NOFRAME
STRING('BlueCode'),AT(79,24),USE(?BlueCodeLabel),TRN,|
FONT('Tahoma',20,,FONT:bold)
END
CODE
OPEN(SplashWindow)
SplashWindow{PROP:Pixels} = True
DO CreateSplashWindow
ACCEPT
CASE EVENT()
OF EVENT:OpenWindow
TARGET{PROP:Timer} = 1000
TARGET{PROP:Alrt,255} = MouseLeft
TARGET{PROP:Alrt,254} = MouseLeft2
TARGET{PROP:Alrt,253} = MouseRight
OF EVENT:CloseWindow
RETURN
OF EVENT:AlertKey
CASE KEYCODE()
OF MouseLeft
OROF MouseLeft2
OROF MouseRight
POST(EVENT:CloseWindow)
END
ELSE
IF EVENT() = EVENT:Timer
POST(EVENT:CloseWindow)
END
END
END
CreateSplashWindow ROUTINE
DATA
szResName CSTRING(256) ! Do not use 255 as a size
szResType CSTRING('IMAGE')
Bm LIKE(BITMAP)
hBm ULONG
hWndRgn ULONG
hRgn ULONG
hDC ULONG
hMemDC ULONG
iX LONG
iY LONG
iXStart LONG
hRes ULONG
hResData ULONG
lpResData ULONG
lpBf &BITMAPFILEHEADER
lpBmi &BITMAPINFO
lpBi &BITMAPINFOHEADER
lpBitCount ULONG
CODE
szResName = 'SPLASH256_BMP'
hDC = GetDC(0{PROP:ClientHandle})
hRes = FindResource(SYSTEM{PROP:AppInstance},szResName,szResType)
IF hRes
hResData = LoadResource(SYSTEM{PROP:AppInstance},hRes)
IF hResData
lpResData = LockResource(hResData)
lpBf &= (lpResData)
IF ~lpBf &= NULL
lpBi &= (lpResData + SIZE(BITMAPFILEHEADER))
lpBitCount = ADDRESS(lpBf) + lpBf.bfOffbits
lpBmi &= (lpResData + SIZE(BITMAPFILEHEADER))
hBm = CreateDIBitmap(hDC,lpBi,CBM_INIT,|
lpBitCount,lpBmi,DIB_RGB_COLORS)
IF NOT hBm
ReleaseDC(0{PROP:Handle},hDC)
RETURN
END
END
END
END
hMemDC = CreateCompatibleDC(hDC)
IF GetObject(hBm,SIZE(Bm),ADDRESS(Bm))
0{PROP:Width} = Bm.bmWidth
0{PROP:Height} = Bm.bmHeight
hWndRgn = CreateRectRgn(0,0,0,0)
SelectObject(hMemDC,hBm)
LOOP iY = 0 TO Bm.bmHeight - 1
LOOP iX = 0 TO Bm.bmWidth - 1
IF GetPixel(hMemDC,iX,iY) = COLOUR:Transparent
CYCLE
END
iXStart = iX
LOOP
IF (iX < Bm.bmWidth) AND |
(GetPixel(hMemDC,iX,iY) <> COLOUR:Transparent)
iX += 1
CYCLE
END
BREAK
END
hRgn = CreateRectRgn(iXStart,iY,iX,iY+1);
CombineRgn(hWndRgn,hWndRgn,hRgn,RGN_OR)
IF hRgn
DeleteObject(hRgn)
END
END
END
SetWindowRgn(0{PROP:Handle},hWndRgn,TRUE)
DeleteObject(hBm)
END
DeleteDC(hMemDC)
ReleaseDC(0{PROP:Handle},hDC)
Printed November 23, 2024, 6:26 am This article has been viewed/printed 35208 times. Google search has resulted in 129 hits on this article since January 25, 2004. |