edit: with a tip.
Code: Select all
#include "windows.bi"
#include "win\Commdlg.bi"
#Include once "/win/commctrl.bi"
Dim As Any Ptr Main=CreateWindowEx(0,"#32770","ONLY BITMAPS ONLY",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,0,0,800,300,0,0,0,0)
Dim As Any Ptr btn=CreateWindowEx( 0,"BUTTON","Open", ws_border Or WS_VISIBLE Or WS_CHILD ,150,50,100,30, Main,0,0,0)
Dim As Any Ptr fname =createwindowex(0,"Static","" , WS_VISIBLE Or WS_CHILD,0,150,800,30,Main,0,0,0)
Dim As Any Ptr lbl =createwindowex(0,"Static","" , WS_VISIBLE Or WS_CHILD,0,200,800,30,Main,0,0,0)
dim as hwnd tip 'tooltip
Declare Sub getfiles(As OpenFileName)
Declare Function GetSize(As String,byref as ushort) As Long
declare Function CreateToolTip(As hwnd,As String="") As hwnd
Dim BMPfile As OpenFileName
Dim As msg msg1
tip=CreateToolTip(btn,"Search for bitmaps")
While GetMessage(@msg1,0,0,0)
TranslateMessage(@msg1)
DispatchMessage(@msg1)
Select Case msg1.hwnd
Case Main
Select Case msg1.message
Case 273 'close by clicking X
End
End Select
'-----------------------------
Case btn
Select Case msg1.message
Case WM_LBUTTONDOWN
getfiles(BMPfile)
dim as string s=*BMPfile.lpstrFile
dim as ushort b
Dim As Long L= GetSize(*BMPfile.lpstrFile,b)
if L then
screenres loword(L), hiword(L),b
screencontrol 100,0,300
bload s
end if
setWindowText(fname,s)
setwindowtext(lbl,"Width " & loword(L) & " , " & "Height " & hiword(L) & " (" & b & " bits)" )
End Select
'------------------------------
End Select
Wend
Sub getfiles(Byref BMPfile As OpenFileName)
Dim As zstring * 2048 SELFILE
Dim As String MYFILTER
MYFILTER = "Bitmap Files"+Chr(0)+"*.bmp"+Chr(0)
With BMPfile
.lStructSize = Sizeof(OpenFileName)
.hInstance = null
.lpstrFilter = Strptr(MYFILTER)
.lpstrFile = @SELFILE
.nMaxFile = 2048
.nMaxFileTitle = 0
.lpstrTitle =@"Open Bitmap"
End With
GetOpenFileName(@BMPfile)
End Sub
Function GetSize(BMP As String,byref bts as ushort=0) As Long
#define mk(a,b) a Or b Shl 16
Dim As Short a,b,n=Freefile
If Open(BMP For Binary Access Read As #n) = 0 Then
Get #n, 19, a ' width
Get #n, 23, b ' height
get #n, 29, bts
Close #n
Return mk(a,b) ' concatenate
End If
End Function
Function CreateToolTip(X As hwnd,msg As String="") As hwnd
Dim As hwnd TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
'64=bubble,0 = rectangle
SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 180)
SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40)
SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW ,60)
Dim bubble As TOOLINFO
bubble.cbSize = Len(TOOLINFO)
bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
bubble.uId = Cast(Uinteger,X)
bubble.lpszText = Strptr(msg)
SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
Return TT
End Function