Palette Finder (ANY Bitmap Image!)

Source-code only - please, don't post questions here.
datwill310
Posts: 308
Joined: May 29, 2015 20:37
Location: England
Contact:

Re: Palette Finder (ANY Bitmap Image!)

Postby datwill310 » Mar 20, 2017 14:51

MrSwiss wrote:
datwill310 wrote:I may want to only get dimensions of an image in certain situations.
Just give me one viable sample, of that ...

Such as with a file explorer: show only dimensions in the listview control.

Such as with a paint program, displaying info in the status bar (though actually, that would come with the raw image format internally).

Mainly showing the user info.
MrSwiss
Posts: 1555
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Palette Finder (ANY Bitmap Image!)

Postby MrSwiss » Mar 20, 2017 15:01

datwill310 wrote:Mainly showing the user info.
OK, accepted but:

Code: Select all

ImageCreate(GetBitmapWidth(img), GetBitmapHeight(img))
is definitely not for information retrieval ... (stick with your own examples, so to speak).
You'll need variables too, for that. (unless you want the calls within a print statement -- I'd call that: messy)
dodicat
Posts: 4014
Joined: Jan 10, 2006 20:30
Location: Scotland

Palette Eyeball (ANY Bitmap Image!)

Postby dodicat » Mar 20, 2017 18:34

Peeker
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

 

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests