Palette Finder (ANY Bitmap Image!)

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

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.
Posts: 2022
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)
Posts: 4410
Joined: Jan 10, 2006 20:30
Location: Scotland

Palette Eyeball (ANY Bitmap Image!)

Postby dodicat » Mar 20, 2017 18:34

edit: with a tip.

Code: Select all

#include ""
#include "win\"
#Include once "/win/"

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)
    Select Case msg1.hwnd
    Case Main
        Select Case msg1.message
        Case 273  'close by clicking X
        End Select
    Case btn
        Select Case msg1.message 
            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(lbl,"Width " & loword(L) & " , " & "Height " & hiword(L) & "  (" & b & "  bits)" )
        End Select
    End Select
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
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)
    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