Tweet
Code:
#Compile Exe
#Register None
#Dim All
#Include "win32api.inc"
$BmpFile = "Test.Bmp" ' <--------- CHANGE
'=================================================================================
%MaxRegions = 100 ' Play here: optimum value is near, but less than 4000 (because of Windows 95)
Function BmpToRgn (hBmp As Dword) As Long
Local hDC As Dword, bm As BITMAP, rc As RECT
Local hMem1DC As Dword, hMem2DC As Dword, hMemBmp As Dword
Local bmi As BITMAPINFO, rdh As RGNDATAHEADER Ptr
Local i As Long, j As Long, k As Long, m As Long, t As Long, tt As Long
Local hRgn1 As Long, hRgn2 As Long
Local sRgnData As String, lpRect As RECT Ptr
hDC = GetDC(%HWND_DESKTOP)
hMem1DC = CreateCompatibleDC (hDC)
hMem2DC = CreateCompatibleDC (hDC)
GetObject hBmp, Len(BITMAP), bm
bmi.bmiHeader.biSize = SizeOf(bmi.bmiHeader)
bmi.bmiHeader.biWidth = bm.bmWidth
bmi.bmiHeader.biHeight = bm.bmHeight
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = %BI_RGB
hMemBmp = CreateDIBSection(hMem1DC, bmi, %DIB_RGB_COLORS, 0, 0, 0)
GetObject hMemBmp, Len(BITMAP), bm
SelectObject hMem1DC, hBmp
SelectObject hMem2DC, hMemBmp
BitBlt hMem2DC, 0, 0, bm.bmWidth, bm.bmHeight, hMem1DC, 0, 0, %SRCCOPY
ReDim Ar(0) As Local Long At bm.bmBits
t = (Ar((bm.bmHeight - 1) * bm.bmWidth) And &HFFFFFF) '<--- (0, 0) transparent
sRgnData = String$(Len(RGNDATAHEADER) + Len(RECT) * %MaxRegions, 0)
rdh = StrPtr(sRgnData)
@rdh.nCount = %MaxRegions + 1
@rdh.dwSize = Len(RGNDATAHEADER)
@rdh.iType = %RDH_RECTANGLES
@rdh.rcBound.nLeft = 0
@rdh.rcBound.nTop = 0
@rdh.rcBound.nRight = bm.bmWidth
@rdh.rcBound.nBottom = bm.bmHeight
For j = 0 To bm.bmHeight - 1
tt = bm.bmWidth * (bm.bmHeight - 1 - j): m = -1
For i = 0 To bm.bmWidth
If i = bm.bmWidth Then k = t Else k = (Ar(tt) And &HFFFFFF): Incr tt
If k <> t Then
If m = -1 Then m = i
ElseIf m >= 0 Then
If @rdh.nCount >= %MaxRegions Then
If @rdh.nCount = %MaxRegions Then
hRgn2 = ExtCreateRegion(ByVal 0, Len(RGNDATAHEADER) + (Len(RECT) * @rdh.nCount), ByVal rdh)
If hRgn1 = 0 Then hRgn1 = hRgn2 Else _
CombineRgn hRgn1, hRgn1, hRgn2, %RGN_OR: DeleteObject hRgn2
End If
lpRect = Len(RGNDATAHEADER) + rdh
@rdh.nCount = 0
End If
Incr @rdh.nCount
@lpRect.nLeft = m
@lpRect.nRight = i
@lpRect.nTop = j
@lpRect.nBottom = j + 1
lpRect = lpRect + Len(RECT): m = -1
End If
Next
Next
hRgn2 = ExtCreateRegion(ByVal 0, Len(RGNDATAHEADER) + (Len(RECT) * @rdh.nCount), ByVal rdh)
If hRgn1 = 0 Then hRgn1 = hRgn2 Else _
CombineRgn hRgn1, hRgn1, hRgn2, %RGN_OR: DeleteObject hRgn2
ReleaseDC %HWND_DESKTOP, hDC
DeleteDC hMem1DC
DeleteDC hMem2DC
DeleteObject hMemBmp
Function = hRgn1
End Function
'=================================================================================
Global DlgOrigProc As Long
CallBack Function SubClass
Select Case CbMsg
Case %WM_NCHITTEST: Function = %HTCAPTION: Exit Function
End Select
Function = CallWindowProc(DlgOrigProc, CbHndl, CbMsg, CbWparam, CbLparam)
End Function
CallBack Function DlgProc
Static i As Long, j As Long
Static hMemDC As Long, hMemBmp As Long
Static hBmp As Dword, bm As BITMAP
Select Case CbMsg
Case %WM_INITDIALOG
hBmp = LoadImage(ByVal 0, $BmpFile, %IMAGE_BITMAP, 0, 0, _
%LR_CREATEDIBSECTION Or %LR_DEFAULTSIZE Or %LR_LOADFROMFILE)
GetObject hBmp, SizeOf(bm), ByVal VarPtr(bm)
SetWindowPos CbHndl, 0, (GetSystemMetrics(%SM_CXSCREEN) - bm.bmWidth) \ 2, _
(GetSystemMetrics(%SM_CYSCREEN) - bm.bmWidth) \ 2, _
bm.bmWidth, bm.bmHeight, %SWP_NOACTIVATE Or %SWP_NOZORDER
SetWindowRgn CbHndl, BmpToRgn(hBmp), 1
Case %WM_DESTROY
DeleteObject hBmp
Case %WM_CTLCOLORDLG
hMemDC = CreateCompatibleDC(CbWparam)
SelectObject hMemDC, hBmp
BitBlt CbWparam, 0, 0, bm.bmWidth, bm.bmHeight, hMemDc, 0, 0, %SRCCOPY
DeleteDC hMemDC
Function = GetStockObject(%NULL_BRUSH): Exit Function
End Select
End Function
Function PbMain
Dim hDlg As Long
Dialog New 0, "", , , 0, 0, %WS_POPUP To hDlg
DlgOrigProc = SetWindowLong(hDlg, %GWL_WNDPROC, CodePtr(subclass))
Dialog Show Modal hDlg Call DlgProc
End Function
Comment