File "program cloner.inc"
Path: /program cloner/inc/program cloner.inc
File size: 26.84 KB
MIME-type:
Charset: utf-8
'--------------------------------------------------------------------------------
' ** Globals **
'--------------------------------------------------------------------------------
GLOBAL hDib AS DWORD ' handle to the main background image
GLOBAL cloneCaption AS STRING ' caption of the cloned dialog
GLOBAL iw, ih AS LONG ' main background image width, height
GLOBAL dX, dY, dW, dH AS LONG ' dialog size & position
GLOBAL AllowMinimize AS LONG
GLOBAL AllowMaximize AS LONG
GLOBAL AllowResize AS LONG
GLOBAL OnTop AS LONG
GLOBAL HasCaption AS LONG
GLOBAL TaskBar AS LONG
GLOBAL Transparency AS LONG
GLOBAL BgndCol AS DWORD
'--------------------------------------------------------------------------------
GLOBAL gsIcoCount AS LONG
GLOBAL gsIconIdx AS LONG
GLOBAL gsOutFile AS STRING
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Utility functions
'--------------------------------------------------------------------------------
FUNCTION Exist(BYVAL fileOrFolder AS STRING) AS LONG
LOCAL Dummy&
Dummy& = GETATTR(fileOrFolder)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'--------------------------------------------------------------------------------
SUB SetIcon(BYVAL hDlg AS DWORD, BYVAL icoFile AS STRING)
LOCAL hIconBig AS DWORD
LOCAL hIconSmall AS DWORD
ExtractIconEx((icoFile), 0, BYVAL VARPTR(hIconBig), BYVAL VARPTR(hIconSmall), 1) '(File, IconId, hIconBig, hIconSmall, IconCount)
SetClassLong(hDlg, %GCL_HICONSM, hIconSmall)
SetClassLong(hDlg, %GCL_HICON, hIconBig)
SendMessage(hDlg, %WM_SETICON, %ICON_SMALL, hIconSmall)
SendMessage(hDlg, %WM_SETICON, %ICON_BIG, hIconBig)
END SUB
'--------------------------------------------------------------------------------
MACRO TaskBarHeight = 30 ' in pixels (= 20 ; 13 in dialog units)
MACRO CaptionHeight = 21
MACRO SetTransparencies(DialDesc)
IF ISTRUE(@DialDesc.BgndTrspt) THEN
SetLayeredWindowAttributes @DialDesc.Handler, @DialDesc.BgndCol, @DialDesc.Transparency, %LWA_Colorkey OR %LWA_ALPHA
ELSEIF ISTRUE(@DialDesc.FgndTrspt) THEN
SetLayeredWindowAttributes @DialDesc.Handler, @DialDesc.FgndCol, @DialDesc.Transparency, %LWA_Colorkey OR %LWA_ALPHA
ELSE
SetLayeredWindowAttributes @DialDesc.Handler, 0, @DialDesc.Transparency, %LWA_ALPHA
END IF
END MACRO
'--------------------------------------------------------------------------------
DECLARE FUNCTION SHGetFolderPath LIB "Shell32.dll" _
ALIAS "SHGetFolderPathA" (BYVAL hwnd AS DWORD, BYVAL csidl AS LONG, _
BYVAL hToken AS DWORD, BYVAL dwFlags AS DWORD, pszPath AS ASCIIZ) AS LONG
%CSIDL_STARTUP = &H0007 ' <user name>\Start Menu\Programs\Startup
%CSIDL_LOCAL_APPDATA = &H001c ' <user name>\Local Settings\Application Data (non roaming)
'--------------------------------------------------------------------------------
FUNCTION StartupFolder AS STRING
LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
ShGetFolderPath (BYVAL 0, %CSIDL_STARTUP, BYVAL 0, BYVAL 0, szBaseFolder)
FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'--------------------------------------------------------------------------------
FUNCTION LocalAppData AS STRING
LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
ShGetFolderPath (BYVAL 0, %CSIDL_LOCAL_APPDATA, BYVAL 0, BYVAL 0, szBaseFolder)
FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
DECLARE FUNCTION QueryFullProcessImageNameTemplate _ ' For LoadLibrary
(BYVAL hProcess AS DWORD, BYVAL dwFlag AS DWORD, lpExeName AS ASCIIZ, lpdwSize AS DWORD) AS LONG
'--------------------------------------------------------------------------------
DECLARE FUNCTION GetProcessImageFileNameTemplate _ ' For LoadLibrary
(BYVAL hProcess AS DWORD, lpImageFileName AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD
'--------------------------------------------------------------------------------
DECLARE FUNCTION GetModuleFileNameEx LIB "PSAPI.DLL" ALIAS "GetModuleFileNameExA" _
(BYVAL hProcess AS DWORD, BYVAL hModule AS DWORD, lpFilename AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD
'--------------------------------------------------------------------------------
FUNCTION GetPathNameFromPid(pid AS DWORD) AS STRING '32-64 bit
LOCAL zFilename AS ASCIIZ * %MAX_PATH
LOCAL zMountPoint AS ASCIIZ * %MAX_PATH
LOCAL sBuffer AS STRING * (26 * 4 + 1)
LOCAL sDrive AS STRING
LOCAL hLib AS DWORD
LOCAL ProcAddress AS DWORD
LOCAL zFilenameSize AS DWORD
LOCAL hProcess AS DWORD
LOCAL BufferLen AS LONG
LOCAL DeviceLen AS LONG
LOCAL Looper AS LONG
hProcess = OpenProcess(%PROCESS_QUERY_INFORMATION OR %PROCESS_VM_READ, %FALSE, pid)
IF hProcess THEN
zFilenameSize = SIZEOF(zFilename)
hLib = GetModuleHandle("Kernel32.dll")
ProcAddress = GetProcAddress(hLib, "QueryFullProcessImageNameA") '>= Vista, 32-64 bit OK, MS recommanded way
IF ProcAddress THEN 'Use dynamic load in case the function is not present on this OS version
CALL DWORD ProcAddress USING QueryFullProcessImageNameTemplate(hProcess, 0, zFilename, zFilenameSize) 'Get filename
ELSE 'QueryFullProcessImageName not found
hLib = LoadLibrary("PsApi.dll")
ProcAddress = GetProcAddress(hLib, "GetProcessImageFileNameA") '>= XP, 32-64 bit ok
IF ProcAddress THEN 'Use dynamic load in case the function is not present on this OS version
CALL DWORD ProcAddress USING GetProcessImageFileNameTemplate(hProcess, zFilename, zFilenameSize) 'Return native device name.
'Convert native device like "\device\harddiskvolume1\windows\explorer.exe" to "C:\Windows\explorer.exe".
BufferLen = GetLogicalDriveStrings(SIZEOF(sBuffer), BYVAL VARPTR(sBuffer))
FOR Looper = 1 TO BufferLen \ 4 'C:\[NUL]D:\[NUL]E:\[NUL]...[NUL]
sDrive = PARSE$(sBuffer, $NUL, Looper)
QueryDosDevice(LEFT$(sDrive, 2), zMountPoint, %MAX_PATH) 'Win98+
DeviceLen = LEN(zMountPoint)
IF LEFT$(zMountPoint, DeviceLen) = LEFT$(zFilename, DeviceLen) THEN
zFilename = sDrive & MID$(zFilename, DeviceLen + 2)
EXIT FOR
END IF
NEXT
ELSE 'None of the above was found for old OS
IF GetModuleFileNameEx(hProcess, %NULL, zFilename, zFilenameSize) = 0 THEN zFilename = $NUL
'>= NT4, use zFilename = $NUL to clean possible scrambled zFilename when an error occur.
END IF
FreeLibrary(hLib)
END IF
CloseHandle(hProcess)
END IF
FUNCTION = zFilename
END FUNCTION
'--------------------------------------------------------------------------------
TYPE WindowList
hwnd AS DWORD
Parent AS LONG
R AS RECT
END TYPE
'--------------------------------------------------------------------------------
FUNCTION ParentCallback (BYVAL hWndChild AS LONG, BYREF wList() AS WindowList) AS LONG
LOCAL szParentClass AS ASCIIZ * %MAX_PATH
LOCAL aResult, iCount AS LONG
aResult = GetClassName(hWndChild, szParentClass, SIZEOF(szParentClass))
iCount = UBOUND(wList) + 1
REDIM PRESERVE wList(iCount)
wList(iCount).PARENT = 1
wList(iCount).hwnd = hWndChild
FUNCTION = %TRUE ' continue top-level enumeration...
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION ExtractExeIcon(BYVAL exePath AS STRING, BYVAL icoIdx AS LONG, outFile AS STRING) AS LONG
LOCAL zFileName AS ASCIIZ * 400
LOCAL SourceModule AS ASCIIZ * %MAX_PATH
LOCAL hSourceModule AS LONG
' Attempt to access resources through the LoadLibrary() method
zFileName = TRIM$(exePath, $DQ)
SourceModule = zFileName
hSourceModule = LoadLibrary(SourceModule)
' Successful > means the exe/dll is a 32-bit program, same as us
IF hSourceModule THEN
gsIcoCount = 0
gsIconIdx = icoIdx
gsOutFile = UCODE$(outFile)
CALL EnumResourceNames(hSourceModule, BYVAL %RT_GROUP_ICON, CODEPTR(EnumResNameProc), 0)
IF EXIST(outFile) THEN
FUNCTION = 0
EXIT FUNCTION
END IF
END IF
' Failed > certainly b/c we're trying to access a 64-bit exe/dll from a 32-bit program
IF NOT EXIST("png2ico.exe") THEN SetFile RCDATA$("EXE1"), EXE.PATH$ + "png2ico.exe"
FUNCTION = ForceExtract32x32Icon (exePath, icoIdx, outFile) ' Backup strat (dirtier)
END FUNCTION
'--------------------------------------------------------------------------------
TYPE GRPICONDIRENTRY
bWidth AS BYTE ' Width, In Pixels, of the Image
bHeight AS BYTE ' Height, In Pixels, of the Image
bColorCount AS BYTE ' Number of colors In Image (0 If >=8bpp)
bReserved AS BYTE ' Reserved
wPlanes AS WORD ' Color Planes
wBitCount AS WORD ' Bits per pixel
dwBytesInRes AS DWORD ' how many bytes In this resource?
nID AS WORD ' the ID
END TYPE
'--------------------------------------------------------------------------------
TYPE GRPICONDIR
idReserved AS WORD ' Reserved (must be 0)
idType AS WORD ' Resource Type (1 For icons)
idCount AS WORD ' How many images?
idEntries(0) AS GRPICONDIRENTRY ' The entries For each Image
END TYPE
'--------------------------------------------------------------------------------
TYPE ICONDIR
idReserved AS WORD ' Reserved (must be 0)
idType AS WORD ' Resource Type (1 For icons)
idCount AS WORD ' How many images?
END TYPE
'--------------------------------------------------------------------------------
TYPE ICONDIRENTRY
bWidth AS BYTE ' Width, In Pixels, of the Image
bHeight AS BYTE ' Height, In Pixels, of the Image
bColorCount AS BYTE ' Number of colors In Image (0 If >=8bpp)
bReserved AS BYTE ' Reserved ( must be 0)
wPlanes AS WORD ' Color Planes
wBitCount AS WORD ' Bits per pixel
dwBytesInRes AS DWORD ' How many bytes In this resource?
dwImageOffset AS DWORD ' Where In the file is this image?
END TYPE
'--------------------------------------------------------------------------------
%IDR_WICONS = 9001 ' Required
'--------------------------------------------------------------------------------
FUNCTION EnumResNameProc(BYVAL hModule AS LONG, BYVAL lpszType AS ASCIIZ PTR, _
BYVAL lpszName AS ASCIIZ PTR, BYVAL lParam AS LONG) AS LONG
LOCAL i, j, k, hFile AS LONG
LOCAL hResGrIcon, hResGrIconLoad AS LONG
LOCAL hResIcon, hResIconLoad AS LONG
LOCAL lpResIconLock AS LONG
LOCAL sResName, sIcoData AS STRING
LOCAL lpResGrIconLock AS GRPICONDIR PTR
INCR gsIcoCount
IF (lpszName AND &HFFFF0000) THEN sResName = @lpszName ELSE sResName = "#" + FORMAT$(lpszName)
DO
hResGrIcon = FindResource(hModule, @lpszName, @lpszType)
IF hResGrIcon = 0 THEN EXIT DO
hResGrIconLoad = LoadResource(hModule, hResGrIcon)
IF hResGrIconLoad = 0 THEN EXIT DO
lpResGrIconLock = LockResource(hResGrIconLoad)
IF lpResGrIconLock = 0 THEN EXIT DO
k = 0
FOR i = 0 TO @lpResGrIconLock.idCount - 1
j = @lpResGrIconLock.idEntries(i).nId
DO
hResIcon = FindResource(hModule, BYVAL j, BYVAL %RT_ICON)
IF hResIcon = 0 THEN EXIT DO
hResIconLoad = LoadResource(hModule, hResIcon)
IF hResIconLoad = 0 THEN EXIT DO
lpResIconLock = LockResource(hResIconLoad)
IF lpResIconLock = 0 THEN EXIT DO
IF i = 0 THEN
DIM IconD AS ICONDIR
IconD.idReserved = 0
IconD.idType = 1
IconD.idCount = @lpResGrIconLock.idCount
REDIM IconDE (IconD.idCount-1) AS ICONDIRENTRY ' Zero Based
REDIM IconImg(IconD.idCount-1) AS STRING ' Zero Based
END IF
IconDE(i).bWidth = @lpResGrIconLock.idEntries(i).bWidth
IconDE(i).bHeight = @lpResGrIconLock.idEntries(i).bHeight
IconDE(i).bColorCount = @lpResGrIconLock.idEntries(i).bColorCount
IconDE(i).bReserved = 0
IconDE(i).wPlanes = @lpResGrIconLock.idEntries(i).wPlanes
IconDE(i).wBitCount = @lpResGrIconLock.idEntries(i).wBitCount
IconDE(i).dwBytesInRes = @lpResGrIconLock.idEntries(i).dwBytesInRes
IF i = 0 THEN
IconDE(i).dwImageOffset = LEN(IconD) + IconD.idCount * LEN(ICONDIRENTRY)
ELSE
IconDE(i).dwImageOffset = IconDE(i - 1).dwImageOffset + k
END IF
k = SizeofResource(hModule, hResIcon)
IconImg(i) = PEEK$(lpResIconLock, k)
EXIT DO
LOOP
NEXT
IF k THEN
sIcoData = PEEK$(VARPTR(IconD), LEN(ICONDIR))
FOR i = 0 TO IconD.idCount - 1
sIcoData = sIcoData + PEEK$(VARPTR(IconDE(i)), LEN(ICONDIRENTRY))
NEXT
FOR i = 0 TO IconD.idCount - 1
sIcoData = sIcoData + IconImg(i)
NEXT
IF gsIcoCount = gsIconIdx THEN
hFile = FREEFILE
OPEN gsOutFile FOR OUTPUT AS #hFile
PRINT #hFile, sIcoData
CLOSE #hFile
END IF
END IF
EXIT DO
LOOP
FUNCTION = 1
END FUNCTION
'--------------------------------------------------------------------------------
MACRO FX32Temp(extension) = EXE.PATH$ + "fx32tmp." + extension
'--------------------------------------------------------------------------------
FUNCTION ForceExtract32x32Icon(BYVAL xin AS STRING, BYVAL kdx AS LONG, _
BYVAL xout AS STRING) AS LONG
LOCAL hIcon, hLst, hBmp, hDC, hObj AS DWORD
LOCAL pImage, pGfx AS DWORD
LOCAL EncClsId AS GUID
LOCAL lRes AS LONG
hIcon = ExtractIcon(BYVAL 0, (xin), kdx-1) ' Extract icon handle from exe/dll
IMAGELIST NEW ICON 32, 32, 24, 1 TO hLst ' Put the icon in a PB ImageList
IMAGELIST ADD ICON hLst, hIcon TO lRes
GRAPHIC BITMAP NEW 32, 32 TO hBmp ' Create a PB bitmap in memory
GRAPHIC ATTACH hBmp, 0
GRAPHIC CLEAR %MAGENTA ' with a magenta background color
GRAPHIC IMAGELIST (0,0), hLst, lRes, 0, %ILD_NORMAL ' Draw the icon from the ImageList on top
GRAPHIC SAVE FX32Temp("bmp")
lRes = SaveAlpha (FX32Temp("bmp"), %MAGENTA, _ ' Convert the magenta bmp to a transparent png
FX32Temp("png"))
IF NOT %DEBUG THEN KILL FX32Temp("bmp")
SHELL "png2ico.exe " + $DQ + xout + $DQ + _ ' Convert the png to an icon
$SPC + $DQ + FX32Temp("png") + $DQ, 0
IF NOT %DEBUG THEN KILL FX32Temp("png")
FUNCTION = lRes
' Cleanup
DestroyIcon hIcon
GRAPHIC DETACH
GRAPHIC BITMAP END
END FUNCTION
'--------------------------------------------------------------------------------
TYPE RGBAtype
red AS BYTE
green AS BYTE
blue AS BYTE
alpha AS BYTE
END TYPE
'--------------------------------------------------------------------------------
UNION LongToRGB ' With union you get instantenious coversion from dword color (ie: FFFFFFFF)
color AS DWORD
RGBcol AS RGBAtype ' to RGBA and vise versa. if you need RGB ignore A
END UNION
'--------------------------------------------------------------------------------
FUNCTION hGdip(OPTIONAL BYVAL hWnd AS DWORD, OPTIONAL BYVAL CtlId AS DWORD) AS DWORD
LOCAL hr AS LONG
IF hWnd <> 0 THEN GRAPHIC ATTACH hWnd, CtlId
GRAPHIC GET DC TO hr
GdipCreateFromHDC hr, hr
FUNCTION = hr
END FUNCTION
'--------------------------------------------------------------------------------
DECLARE FUNCTION GdipBitmapConvertFormat LIB "GDIPLUS.DLL" ALIAS "GdipBitmapConvertFormat" ( _
BYVAL pInputBitmap AS DWORD _ ' __in GpBitmap *pInputBitmap
, BYVAL format AS LONG _ ' __in PixelFormat format
, BYVAL dithertype AS LONG _ ' __in DitherType dithertype
, BYVAL palettetype AS LONG _ ' __in PaletteType palettetype
, BYREF palette AS ColorPalette _ ' __out ColorPalette *palette
, BYVAL alphaThresholdPercent AS SINGLE _ ' __in REAL alphaThresholdPercent
) AS LONG ' GpStatus
'--------------------------------------------------------------------------------
FUNCTION SaveAlpha ( BYVAL strFileName AS STRING, _ ' the source image
BYVAL tRGBColour AS DWORD, _ ' the transparent color
BYVAL strOutFile AS STRING _ ' the target image
) AS LONG
LOCAL hBmp AS DWORD
LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
LOCAL pImage AS DWORD
LOCAL hdc AS DWORD
LOCAL bmpData AS BITMAPDATA
LOCAL rc AS RECT
LOCAL ROWs AS LONG
LOCAL COLs AS LONG
LOCAL pPixels AS DWORD PTR
LOCAL rWidth, rHeight AS SINGLE
LOCAL cRGBA AS LongToRGB
LOCAL EncClsId AS GUID
LOCAL pxs() AS DWORD
LOCAL mime AS STRING
LOCAL rgbCol AS DWORD
' Get MIME type then convert file names for GDI+
mime = LCASE$(RIGHT$(strOutFile,3))
IF mime = "jpg" THEN mime = "jpeg"
IF mime = "tif" THEN mime = "tiff"
IF mime = "ico" THEN mime = "x-icon"
mime = "image/" + mime
strFileName = UCODE$(strFileName)
strOutFile = UCODE$(strOutFile)
' Create a Bitmap object from an image file and get its dimensions
hStatus = GdipCreateBitmapFromFile(STRPTR(strFileName), pImage)
IF hstatus THEN FUNCTION = 1 : GOTO Terminate
hStatus = GdipGetImageDimension(pImage, rWidth, rHeight)
IF hstatus THEN FUNCTION = 2 : GOTO Terminate
' Lock a rectangular portion of the complete bitmap for reading
SetRect rc, 0, 0, rWidth-1, rHeight-1
hStatus = GdipBitmapLockBits(pImage, rc, %ImageLockModeRead, %PixelFormat32bppARGB, bmpData)
IF hstatus THEN FUNCTION = 3 : GOTO Terminate
REDIM pxs(0 TO rWidth-1, 0 TO rHeight-1) ' Pixel data buffer, same size as the image. 0 based, this is were we will read them into.
' Get individual Pixels..
pPixels = bmpData.Scan0
IF pPixels = %NULL THEN FUNCTION = 4 : GOTO Terminate
' Process the Image as required -- Alter RGBA as required
FOR ROWs = 0 TO rHeight-1 ' Height
FOR COLs = 0 TO rWidth-1 ' Width
cRGBA.color = (@pPixels[ROWs * _
bmpData.stride / 4 + COLs]) ' get the indvidual pixel
rgbCol = RGB(cRGBA.RGBcol.Red, _
cRGBA.RGBcol.Green, _
cRGBA.RGBcol.Blue)
IF rgbCol = tRGBColour THEN ' RGB color you want to make Transparent
cRGBA.RGBcol.Alpha = 0 ' set Alpha channel to 0 (transparent) (set 0 to 255 for levels of transparency)
END IF
pxs(COLs,ROWs) = cRGBA.color ' Since we used UNION populating RGB above give us automatic new Color value of pixel
NEXT
NEXT ' we processed whole image
hStatus = GdipBitmapUnlockBits(pImage, bmpData) ' Unlock the Bits
IF hstatus THEN FUNCTION = 5 : GOTO Terminate
bmpData.Width = rWidth ' Set BMP Data Width
bmpData.Height = rHeight ' Height
bmpData.Stride = 4 * bmpData.Width ' Stride
bmpData.PixelFormat = %PixelFormat32bppARGB ' Format
bmpData.Scan0 = VARPTR(pxs(0)) ' pointer to our array with the modified pixel colors
bmpData.Reserved = %NULL
' Lock complete bitmap for writing
SetRect rc, 0, 0, rWidth, rHeight
hStatus = GdipBitmapLockBits(pImage, rc, %ImageLockModeWrite OR %ImageLockModeUserInputBuf, %PixelFormat32bppARGB, bmpData)
' Commit the changes and unlock complete bitmap
hStatus = GdipBitmapUnlockBits(pImage, bmpData)
' Get the CLSID of the encoder. MimeTypes = "image/bmp,image/jpeg,image/gif,image/tiff,image/png"
EncClsId = GUID$(GdiPlusGetEncoderClsId(mime))
' Save our altered image
hStatus = GdipSaveImageToFile(pImage, STRPTR(strOutFile), EncClsId, BYVAL %NULL) ' save format based on EncClsId
FUNCTION = 0
Terminate:
' Unlock the bits
hStatus = GdipBitmapUnlockBits(pImage, bmpData)
' Cleanup
IF pImage THEN GdipDisposeImage(pImage)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB getBitmapDims(BYVAL bmpFile AS STRING, BYREF w AS LONG, BYREF h AS LONG)
LOCAL ff AS LONG
ff = FREEFILE
OPEN bmpFile FOR BINARY AS #ff
GET #ff, 19, w
GET #ff, 23, h
CLOSE #ff
END SUB
'--------------------------------------------------------------------------------
SUB RemoveBlackBorders(BYVAL bmpFile AS STRING)
LOCAL w, h, p0, x, y AS LONG ' source bitmap info
LOCAL tx0, tw, th AS LONG ' target bitmap info
LOCAL imgdata AS STRING
LOCAL hBmp AS DWORD
LOCAL p AS LONG PTR
' Get source bitmap pixel data
getBitmapDims bmpFile, w, h
GRAPHIC BITMAP LOAD bmpFile, w, h TO hBmp
GRAPHIC ATTACH hBmp, 0
GRAPHIC GET BITS TO imgdata
GRAPHIC DETACH
GRAPHIC BITMAP END
p0 = STRPTR(imgdata) + 8
' Detect black border on the left
FOR x = 0 TO w-1
FOR y = 0 TO h-1
p = p0 + (y * w + x) * 4
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT y
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT x
tx0 = x ' first column which is not 100% black
' Detect black border on the right
FOR x = w-1 TO 0 STEP -1
FOR y = 0 TO h-1
p = p0 + (y * w + x) * 4
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT y
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT x
tw = x - tx0 + 1 ' adapt width
' Detect black border at the bottom
FOR y = h-1 TO 0 STEP -1
FOR x = 0 TO w-1
p = p0 + (y * w + x) * 4
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT x
IF RGB(@p) <> %BLACK THEN EXIT FOR
NEXT y
th = y + 1 ' last row which is not 100% black
'?"Source bitmap is "+format$(w)+"x"+format$(h)+$cr+$cr _
'+"Target bitmap will be "+FORMAT$(tw)+"x"+FORMAT$(th)+$CR _
'+"starting at column #"+format$(tx0+1) _
',%mb_iconinformation,exe.name$
' Create new resized bitmap and replace original one on disk
IF %DEBUG THEN FILECOPY bmpFile, LEFT$(bmpFile,-4)+"0.bmp"
GRAPHIC BITMAP NEW tw, th TO hBmp
GRAPHIC ATTACH hBmp, 0
GRAPHIC RENDER bmpFile, (-tx0, 0) - (-tx0+w-1, h-1)
GRAPHIC SAVE bmpFile
GRAPHIC DETACH
GRAPHIC BITMAP END
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' LISTVIEW INCLUDES
'--------------------------------------------------------------------------------
' // Size = 44 bytes
TYPE NMLISTVIEW DWORD
hdr AS NMHDR ' NMHDR hdr
iItem AS LONG ' int iItem
iSubItem AS LONG ' int iSubItem
uNewState AS DWORD ' UINT uNewState
uOldState AS DWORD ' UINT uOldState
uChanged AS DWORD ' UINT uChanged
ptAction AS POINT ' POINT ptAction
lParam AS LONG ' LPARAM lParam
END TYPE
'--------------------------------------------------------------------------------
' // Size = 48 bytes
TYPE NMITEMACTIVATE DWORD
hdr AS NMHDR ' NMHDR hdr
iItem AS LONG ' int iItem
iSubItem AS LONG ' int iSubItem
uNewState AS DWORD ' UINT uNewState
uOldState AS DWORD ' UINT uOldState
uChanged AS DWORD ' UINT uChanged
ptAction AS POINT ' POINT ptAction
lParam AS LONG ' LPARAM lParam
uKeyFlags AS DWORD ' UINT uKeyFlags
END TYPE
'--------------------------------------------------------------------------------
' // Size = 60 bytes (52 bytes in XP)
TYPE LVITEMA DWORD
mask AS DWORD ' UINT mask
iItem AS LONG ' int iItem
iSubItem AS LONG ' int iSubItem
state AS DWORD ' UINT state
stateMask AS DWORD ' UINT stateMask
pszText AS ASCIIZ PTR ' LPSTR pszText
cchTextMax AS LONG ' int cchTextMax
iImage AS LONG ' int iImage
lParam AS LONG ' LPARAM lParam
'#if (_WIN32_IE >= 0x0300)
iIndent AS LONG ' int iIndent
'#endif
'#if (_WIN32_WINNT >= 0x501)
iGroupId AS LONG ' int iGroupId
cColumns AS DWORD ' UINT cColumns // tile view columns
puColumns AS DWORD PTR ' PUINT puColumns
'#endif
'#if _WIN32_WINNT >= 0x0600 // Will be unused downlevel, but sizeof(LVITEMA) must be equal to sizeof(LVITEMW)
#IF %WINVER >= &H0600
piColFmt AS LONG ' int
iGroup AS LONG ' int // readonly. only valid for owner data.
#ENDIF
'#endif
END TYPE
'--------------------------------------------------------------------------------
' // Size = 72 bytes
TYPE LV_DISPINFO DWORD
hdr AS NMHDR ' NMHDR hdr
item AS LVITEMA ' LVITEM item
END TYPE
'--------------------------------------------------------------------------------
' // Size 48 bytes
TYPE NMCUSTOMDRAW DWORD
hdr AS NMHDR ' NMHDR hdr
dwDrawStage AS DWORD ' DWORD dwDrawStage
hdc AS DWORD ' HDC hdc
rc AS RECT ' RECT rc
dwItemSpec AS DWORD ' DWORD_PTR dwItemSpec // this is control specific, but it's how to specify an item. valid only with CDDS_ITEM bit set
uItemState AS DWORD ' UINT uItemState
lItemlParam AS LONG ' LPARAM lItemlParam
END TYPE
'--------------------------------------------------------------------------------
' // Size = 104 bytes
TYPE NMLVCUSTOMDRAW DWORD
nmcd AS NMCUSTOMDRAW ' NMCUSTOMDRAW nmcd
clrText AS DWORD ' COLORREF clrText
clrTextBk AS DWORD ' COLORREF clrTextBk
'#if (_WIN32_IE >= 0x0400)
iSubItem AS LONG ' int iSubItem
'#endif
'#if (_WIN32_WINNT >= 0x501)
dwItemType AS DWORD ' DWORD dwItemType
' // Item custom draw
clrFace AS DWORD ' COLORREF clrFace
iIconEffect AS LONG ' int iIconEffect
iIconPhase AS LONG ' int iIconPhase
iPartId AS LONG ' int iPartId
iStateId AS LONG ' int iStateId
' // Group Custom Draw
rcText AS RECT ' RECT rcText
uAlign AS DWORD ' UINT uAlign // Alignment. Use LVGA_HEADER_CENTER, LVGA_HEADER_RIGHT, LVGA_HEADER_LEFT
'#endif
END TYPE
'--------------------------------------------------------------------------------
UNION LvUnion
NMHDR AS NMHDR
NMLV AS NMLISTVIEW
NMIA AS NMITEMACTIVATE
LVDI AS LV_DISPINFO
LVCD AS NMLVCUSTOMDRAW
END UNION
'--------------------------------------------------------------------------------