Code:
' program to demonstrate use of Edwin Knoppert's Binbas application
' used to load an icon as part of the application without requiring
' a resource file. PBWin 8.04, DDT style.
' you can get Binbas here : http://www.hellobasic.com/pwrdev
'
' example by Chris Holbrook 20-MAR-2008
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
%IDD_DIALOG1 = 101
%IDC_LABEL1 = 1001
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
'---------------------------------------------------------------
'//////////////////////////////////////////////////////////////////////////
'// Icon loading
'//////////////////////////////////////////////////////////////////////////
TYPE TAGICONDIR
idReserved AS WORD '// Reserved (must be 0)
idType AS WORD '// Resource Type (1 For icons)
idCount AS WORD '// How many images?
END TYPE
TYPE TAGICONDIRENTRY
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
'// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
'// Returns a iconhandle.
FUNCTION SetIconFileBits( BYVAL lpMem AS LONG ) AS LONG
DIM pIconDir AS TAGICONDIR PTR
DIM IconDirEntry AS TAGICONDIRENTRY PTR
pIconDir = lpMem
IF @pIconDir.idCount < 1 THEN EXIT FUNCTION
IconDirEntry = pIconDir + LEN( @pIconDir )
FUNCTION = CreateIconFromResource( _
BYVAL pIconDir + @IconDirEntry.dwImageOffset _
, @IconDirEntry.dwBytesInRes _
, @pIconDir.idType _
, &H30000& _
)
END FUNCTION
'//////////////////////////////////////////////////////////////////////////
'---------------------------------------------------------------
SUB BinBas1( T AS STRING )
DIM a&: FOR a& = 1 TO DATACOUNT: T = T & READ$( a& ): NEXT a&
DATA 0000010001001010100001000400280100001600000028000000100000002000000001
DATA 000400000000000000000000000000000000000000000000000000000000000000FF00
DATA 0000000000000000000000000000000000000000000000000000000000000000000000
DATA 0000000000000000000000000000000000000000000000000000000000010000000000
DATA 0010011000000000011000110000000011000001000000011000000110000010000000
DATA 0011000100000000000111100000000000001100000000000000110000000000000101
DATA 1100000000001100011100000001100000011000001100000000110001000000000001
DATA 100000000000000000FFFF0000BFFD00009FF90000CFF30000EFE70000E7DF0000F3BF
DATA 0000F87F0000FCFF0000FCFF0000FA3F0000F38F0000E7E70000CFF30000BFF90000FF
DATA FF0000
END SUB
'---------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
DIM a AS LONG
DIM hDlg AS LONG
DIM hIcon AS LONG
DIM T1 AS STRING
DIM T2 AS STRING
LOCAL s AS STRING
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
s = "1. Choose your icon" + $CRLF + _
"2. Run Binbas, change settings to not zip the file" + $CRLF + _
"3. load icon into Binbas" + $CRLF + _
"4. cut and paste the data statements to replace those in Binbaseg"+ $CRLF + _
"5. Recompile and run Binbaseg"+ $CRLF + _
"6. ...and relax."
CONTROL SET TEXT CBHNDL, %idc_label1, s
'// Retrieve the datastatements.
BinBas1 T1
'// Convert to actual (file)data.
FOR a = 1 TO LEN( T1 ) STEP 2
T2 = T2 & CHR$( VAL( "&H" & MID$( T1, a , 2 ) ) )
NEXT a
'// Create the icon.
hIcon = SetIconFileBits( STRPTR( T2 ) )
'// Set the icon to this dialogbox.
DIALOG SEND CBHNDL, %WM_SETICON, %ICON_small, hicon ' %ICON_BIG?
CASE %WM_DESTROY
IF hIcon THEN DestroyIcon hIcon
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_LABEL1
END SELECT
END SELECT
END FUNCTION
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Edwin Knoppert's Binbas eg to load icon in code", 152, 160, 253, 121, %WS_POPUP OR %WS_BORDER OR _
%WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "", 5, 5, 245, 110
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
FUNCTION = lRslt
END FUNCTION
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
Comment