Message Box

albert · Post by **albert** » Feb 24, 2017 23:19

How do you create a message box , where you can alter the text of the message??

I don't want a button on it.. Just to be able to alter the text..

So i guess i need is a self closing info box..

Where i can alter the contents during a loop and then close the box after the loop completes..

SARG · Post by **SARG** » Feb 25, 2017 0:54

Something like that ?
The style can be modified for better looking.

Code: Select all

#Include "windows.bi"
Dim As Long x=200,y=100,w=300,h=150
Dim As HWND hwnd
Dim As String mytext="begin"
hwnd=CreateWindowex(0,"static","", WS_popup,X,Y,W,H,0,0,0,0)
ShowWindow hwnd,SW_SHOW
For i As Long =1 To 10
   mytext+=" "+Str(i)
   setwindowtext(hwnd,sadd(mytext))
   Sleep 500
Next
setwindowtext(hwnd,"End after 2 seconds")
Sleep 2000

DestroyWindow hwnd
End

dodicat · Post by **dodicat** » Feb 25, 2017 13:03

Hi Albert.
I had a scratch around and put together some odds and ends.

Code: Select all


#Include Once "windows.bi"
Declare Sub CreateMessageWindow
' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage="start"
Dim Shared As Long flag
Dim Shared As HWND  MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    
    Select Case hWnd
    Case MainWindow  
        Select Case msg
        Case WM_PAINT
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(0, 100, 255)))
            EndPaint(hWnd, @ps)
            
        Case WM_CLOSE
            PostQuitMessage(NULL)   
        Case WM_COMMAND
            Select Case lParam  
            Case msgon 
                CreateMessageWindow 
            End Select
        End Select
        
    Case MessageWindow  
        Select Case msg
        Case WM_COMMAND
            Select Case lParam  
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
                MessageBox(MessageWindow, textMessage, "Saved", MB_OK )
            End Select
            
        Case WM_CLOSE
            flag=0
        End Select
    End Select
    
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function


' Create  window class:
Dim As WNDCLASS wcls

With wcls
    .style      = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc  = Cast(WNDPROC, @WndProc)
    .hInstance    = GetModuleHandle(NULL)
    .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor      = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetStockObject(WHITE_BRUSH)
    .lpszMenuName  = NULL
    .lpszClassName  = Strptr("WindowClass")
End With

If RegisterClass(@wcls) = FALSE Then
    MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
    End
End If


MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)

Sub CreateMessageWindow
    If flag=0 Then
        flag=1
        MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
        EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD, 10, 40, 200, 24, MessageWindow, NULL, NULL, NULL)
        Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
    End If 
End Sub
'

Dim As MSG uMsg

While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

dodicat · Post by **dodicat** » Feb 25, 2017 17:40

An alternative, with no message box.
SetWindowTheme(messagewindow," "," ") for a blue message frame.

flag=0
destroywindow(messagewindow), to close the box on save.

If you don't like the theme or the box closing on save then you can comment them out.
Also i have added auto horizontal scrolling in case the massage is longish.

Code: Select all


#define WIN_INCLUDEALL
#Include Once "windows.bi"

'for blue frame on message
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long 

Declare Sub CreateMessageWindow

' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage="start"
Dim Shared As Long flag
Dim Shared As HWND  MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    
    Select Case hWnd
    Case MainWindow  
        Select Case msg
        Case WM_PAINT
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(0, 100, 255)))
            EndPaint(hWnd, @ps)
            
        Case WM_CLOSE
            PostQuitMessage(NULL)   
        Case WM_COMMAND
            Select Case lParam  
            Case msgon 
                CreateMessageWindow 
            End Select
        End Select
        
    Case MessageWindow  
        Select Case msg
        Case WM_COMMAND
            Select Case lParam  
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
                flag=0'''''''''''''''''''''
                destroywindow(messagewindow)''''''''''''''''''''''
            End Select
            
        Case WM_CLOSE
            flag=0
        End Select
    End Select
    
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function


' Create  window class:
Dim As WNDCLASS wcls

With wcls
    .style      = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc  = Cast(WNDPROC, @WndProc)
    .hInstance    = GetModuleHandle(NULL)
    .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor      = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetStockObject(WHITE_BRUSH)
    .lpszMenuName  = NULL
    .lpszClassName  = Strptr("WindowClass")
End With

If RegisterClass(@wcls) = FALSE Then
    MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
    End
End If


MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)

Sub CreateMessageWindow
    If flag=0 Then
        flag=1
        MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
        EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
        Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
        SetWindowTheme(messagewindow," "," ")'''''''''''''''''''''
    End If 
End Sub

'

Dim As MSG uMsg

While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

albert · Post by **albert** » Feb 25, 2017 19:11

I went with animating the preexisting Button ctrl. with periods.

Code: Select all

    dim as string mytext = ""
    SetWindowText( CYPHER_BTN , "Cyphering" )
    sleep 1000
    for a as integer = 1 to len(BinaryMessageBlocks) step (64*TabPages)
        
        mytext+="." 
        if len(mytext) > 8 then mytext = ""
        SetWindowText( CYPHER_BTN , mytext )

Message Box

Message Box

Re: Message Box

Re: Message Box

Re: Message Box

Re: Message Box