Hex Viewer (Draw)

В этой статье, начнем писать отрисовку данных. Сразу определимся, что окно как бы будет разделено на три области:

Адрес
Hex данные
AСSII данные

Для начала, неплохо бы эти области залить разными цветами. Не будем мудрить, просто нарисуем три разноцветных прямоугольника. Делать это будем в процедуре PaintHexProc

Сперва нужные переменные:

Dim As HDC hdc,hdc2 ' контексты устройства
Dim As PAINTSTRUCT ps ' структура, содержащая инфу для рисования
Dim As HBITMAP hbitmap ' битмап для рисования
Dim As HBRUSH  brush ' хендл кисти
Dim As HPEN pen ' хендл пера

Далее макрос рисования прямоугольников. В макросе три вводных значения (цвет заливки, координата x , ширина):

#MACRO mRectangle(col,x,w) ' макрос рисования прямоугольников
    brush=CreateSolidBrush(col) ' создаем кисть
    SelectObject(hdc,brush) ' кисть в контекст
    pen= CreatePen(PS_SOLID ,1,Cast(COLORREF,col)) ' создаем перо
    SelectObject(hDC,Cast(HGDIOBJ,pen)) ' перо в контекст
    Rectangle(hDC,x,0,w,552) ' рисуем прямоугольник
    DeleteObject(brush) ' удаляем кисть
    DeleteObject(pen) ' удаляем перо
#EndMacro

Собственно само рисование:

hdc2 = BeginPaint(childHwnd, @ps) ' начинаем рисование, получаем контекст
hdc   = CreateCompatibleDC(hdc2) 'создаем совместимый контекст
hbitmap = CreateCompatibleBitmap(hdc2,794,552) ' создаем совместимый битмап
SelectObject(hdc,hbitmap) ' битмап в контекст
mRectangle(&hFFE9E9,0,109) ' рисуем прямоугольник для адресов
mRectangle(&hf0f0f0,110,595) 'рисуем прямоугольник для Hex символов
mRectangle(&hE9FFE9,596,794) ' рисуем прямоугольник для ASCII символов

BitBlt(hdc2,0,0,794,552,hdc,0,0,SRCCOPY) ' копируем содержимое контекста в другой контекст
DeleteObject(hbitmap) ' удаляем битмап
DeleteDC(hDC) ' удаляем совместимый контекст
EndPaint(childHwnd, @ps) ' заканчиваем рисование

Перед тем как отрисовывать текст, было неплохо иметь буфер, откуда этот текст можно взять. Пока у нас нет HEX данных из файла, мы для наших опытов временно создадим массив с рандомными значениями. Потом когда информация будет поступать из файла, мы этот массив удалим.

Dim Shared As Byte TempDIM(10000)
' ......
For i As Integer = 0 To 10000
    TempDIM(i) = Rnd*256
Next

Так же нам понадобится небольшой буфер размером 416 байт, как раз столько, сколько помещается в нашей области рисования:

Dim Shared As Ubyte Ptr pbBytesBuffer ' буфер , ограниченный в размере (416 байт),
'используется для копирования в него части информации, которая отображается в видимой части окна
pbBytesBuffer = Callocate(416) ' выделим память для буфера

Создадим процедуру копирования из реального буфера (в последствии из файла) в наш небольшой буфер pbBytesBuffer:

'заполнение буфера pbBytesBuffer данными
Sub CopyBytesProc()
    ' пока мы копируем с нулевого адреса (пока нет прокрутки)
    ' далее мы эту процедуру перепишем
    CopyMemory( pbBytesBuffer ,@TempDIM(0) , 416)
End Sub

Создадим еще 2 глобальные переменные. Одна будет содержать реальный размер файла. Другая - смещение в самом начале видимой части окна. По сути вторая переменная нам будет нужна тогда, когда будет работать скроллинг, но в коде мы ее пристроим прямо сейчас.

Dim Shared As Ulongint ullSizeFile ' размер файла
ullSizeFile = 10000
Dim Shared As Ulongint ullNullOffsetView 'смещение в самом начале видимой части окна

В процедуре рисования создадим еще 2 локальные переменные. Одна будет содержать высоту букв в пикселях. Другая смещение в буфере.

Dim As Integer offset ' смещение
Dim As Integer y = 21 ' высота букв

Напишем макрос для рисования текста:

#MACRO mDrawText()
    SelectObject(hdc, hFontCourierNEW) ' свой шрифт в контекст
    TextOut(hdc,10,y*i+5,Hex(i*16+ullNullOffsetView,11), 11) ' рисуем строку - адрес
    TextOut(hdc,142,y*i+3,sHex, 47)' рисуем строку - HEX
    TextOut(hdc,611,y*i+3,sString, 16)' рисуем строку - ASCII
#EndMacro

Перед отрисовкой текста, скопируем данные в наш буфер. И установим режим прозрачности для вывода текста:

CopyBytesProc() ' копируем данные в буфер, из которого будем читать информацию и рисовать
SetBkMode(hdc,1) ' режим прозрачности для текста

И собственно сама логика вывода текста:

For i As Integer = 0 To 25 ' цикл по числу видимых строк
    Dim As ZString*50 sHex ' хранит HEX символы
    Dim As ZString*16 sString ' хранит ASCII символы
    For x As Integer = 0 To 15 ' цикл по числу столбцов
        If ullNullOffsetView+offset = ullSizeFile Then ' если конец буфера
            If x>0 Then ' если прошла хоть одна итерация
                mDrawText() ' вызываем макрос
            Endif
            Exit For, For ' выход из обоих циклов
        Endif
        sHex &= (Hex(pbBytesBuffer[offset],2)& " ") ' собираем строку HEX
        Dim As Ubyte btempSimbol = pbBytesBuffer[offset]' получаем ASCCI код
        Select Case btempSimbol ' отсеиваем непечатываемые символы
            Case &h0 To &h1f,&hAD,&h98,&h7f
                btempSimbol = &h2E ' заменяем их точками
        End Select
        sString[x] = btempSimbol ' собираем строку ASCII
        offset +=1 ' увеличиваем смещение
    Next
    mDrawText()' вызываем макрос
Next

Немного поясню.

Этот участок:

If ullNullOffsetView+offset = ullSizeFile Then ' если конец буфера
    If x>0 Then ' если прошла хоть одна итерация
        mDrawText() ' вызываем макрос
    Endif
    Exit For, For ' выход из обоих циклов
Endif

дорисовывает последнюю строку в файле. Дело в том, что последняя строка при рисовании может быть и не полной (т.е. не во всю длину). Вот как раз для этого и внедрен данный участок.

Остальное думаю должно быть понятно.

Весь код полностью:

#INCLUDE "windows.bi"
#INCLUDE "win/commctrl.bi"
#INCLUDE "win/commdlg.bi"
InitCommonControls()

Declare Function HexWndProc(hwnd As HWND, msg As Uinteger,_
wparam As WPARAM, lparam As LPARAM) As Integer

' Переменные
Dim Shared hinst As HINSTANCE : hinst = GetModuleHandle(0)
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As ZString*20 sNameClass = "HexViewer"
Dim Shared As ZString*20 szHexClass: szHexClass = "szHexClass"
Dim Shared As HFONT hFontCourierNew
Dim Shared As HWND mainHwnd
Dim Shared As HWND childHwnd
Dim Shared ofn  As OPENFILENAME
Dim Shared filename        As Zstring * 512
Dim Shared As Byte TempDIM(10000)
Dim Shared As Ulongint ullSizeFile ' размер файла
ullSizeFile = 10000
Dim Shared As Ulongint ullNullOffsetView 'смещение в самом начале видимой части окна
Dim Shared As Ubyte Ptr pbBytesBuffer ' буфер , ограниченный в размере (416 байт),
'используется для копирования в него части информации, которая отображается в видимой части окна
pbBytesBuffer = Callocate(416) ' выделим память для буфера

' загрузка шрифта
Function LoadFontProc(Byval Name_     As String, _
    Byval Size      As Integer, _
    Byval corner    As Integer,_
    Byval BOLD      As Integer,_
    Byval Italic    As Integer,_
    Byval Underline As Integer,_
    Byval StrikeOut As Integer,_
    Byval CharSet As Integer) As HFONT
    Dim As Integer size_
    If BOLD=1 Then
        BOLD=700 ' жирный шрифт
    Else
        BOLD=400 ' обычный
    Endif
    Dim As HDC hdc = CreateDC("DISPLAY",0,0,0) ' создаем контекст
    size_ = -MulDiv(Size, GetDeviceCaps(hdc, LOGPIXELSY), 72) ' высчитываем размер шрифта
    DeleteDC(hdc) ' удаляем контекст
    Return CreateFont(size_,0,corner*10,0,Bold,Italic,Underline,StrikeOut, _ 'создаем шрифт
    CharSet, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE,Name_)
End Function

' диалог получения имени файла
Function FileOpen(Byval Title As String,Byval curentdir As String, Byval Pattern As String, Byval templateName As String = "") As String
    Dim fbguiTemp As Integer
    filename = templateName

    With ofn
        .hwndOwner       = 0
        .lStructSize     = Sizeof(OPENFILENAME)
        .lpstrFilter     = Cast(LPCTSTR,Strptr(Pattern) )
        .lpstrFile       = Strptr(filename)
        .nFileOffset     = 0
        .nMaxFile        = Sizeof(filename)
        .lpstrFileTitle  = Cast(LPTSTR,Strptr(Title))
        .nMaxFileTitle   = Sizeof(Title)
        .lpstrInitialDir = Cast(LPCTSTR,Strptr(curentdir))
        .lpstrTitle      = Cast(LPCTSTR,Strptr(Title))
        .Flags           = OFN_EXPLORER Or OFN_FILEMUSTEXIST
    End With

    If( GetOpenFileName( @ofn ) = 0 ) Then
        Return ""
    Else
        Return filename
    End If
End Function

' создание HEX окна
Sub CreateChildProc(hwnd As hwnd)
    Dim As WNDCLASSEX wc
    With wc
        .cbSize=SizeOf(WNDCLASSEX)
        .lpfnWndProc=@HexWndProc
        .hInstance=Hinst
        .hCursor=LoadCursor(0,IDC_IBEAM)
        .hbrBackground=Cast(HBRUSH,COLOR_SCROLLBAR)
        .lpszClassName=StrPtr(szHexClass)
    End With

    If RegisterClassEx(@wc)=0 Then
        Print "Register error, press any key"
        Sleep
        End
    Endif
    childHwnd = CreateWindowEx( WS_EX_CLIENTEDGE,szHexClass,"",_
    WS_VSCROLL Or WS_CHILD Or WS_VISIBLE,0,25,794,552,hwnd,Cast(HMENU,1),Hinst,0)
End Sub

' оконная процедура главного окна
Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_CREATE

            CreateChildProc(hwnd) ' Создаем свое дочернее окно для вывода HEX значений

            CreateWindowEx(0,"Button","Открыть файл",_
            WS_VISIBLE Or WS_CHILD,10,1,100,20,hwnd,Cast(HMENU,2),Hinst,0) ' Создаем обычную кнопку

        Case WM_COMMAND
            If lparam <> 0 Then ' если сообщения от контролов
                Select Case Loword(wParam)
                    Case 2
                        ? FileOpen("Открыть","C:\","All files (*.*)"+Chr(0)+"*.*"+Chr(0) ,"")
                End Select
            Endif
        Case WM_DESTROY
            DeleteObject(hFontCourierNew)
            PostQuitMessage(0)' выходим
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

'заполнение буфера pbBytesBuffer данными
Sub CopyBytesProc()
    ' пока мы копируем с нулевого адреса
    ' далее мы эту процедуру перепишем
    CopyMemory( pbBytesBuffer ,@TempDIM(0) , 416)
End Sub

' рисование на окне childHwnd
Sub PaintHexProc()
    Dim As HDC hdc,hdc2 ' контексты устройства
    Dim As PAINTSTRUCT ps ' структура, содержащая инфу для рисования
    Dim As HBITMAP hbitmap ' битмап для рисования
    Dim As HBRUSH  brush ' хендл кисти
    Dim As HPEN pen ' хендл пера
    Dim As Integer offset ' смещение
    Dim As Integer y = 21 ' высота букв

    #MACRO mRectangle(col,x,w) ' макрос рисования прямоугольников
        brush=CreateSolidBrush(col) ' создаем кисть
        SelectObject(hdc,brush) ' кисть в контекст
        pen= CreatePen(PS_SOLID ,1,Cast(COLORREF,col)) ' создаем перо
        SelectObject(hDC,Cast(HGDIOBJ,pen)) ' перо в контекст
        Rectangle(hDC,x,0,w,552) ' рисуем прямоугольник
        DeleteObject(brush) ' удаляем кисть
        DeleteObject(pen) ' удаляем перо
    #EndMacro

    #MACRO mDrawText()
        SelectObject(hdc, hFontCourierNEW) ' свой шрифт в контекст
        TextOut(hdc,10,y*i+5,Hex(i*16+ullNullOffsetView,11), 11) ' рисуем строку - адрес
        TextOut(hdc,142,y*i+3,sHex, 47)' рисуем строку - HEX
        TextOut(hdc,611,y*i+3,sString, 16)' рисуем строку - ASCII
    #EndMacro

    hdc2 = BeginPaint(childHwnd, @ps) ' начинаем рисование, получаем контекст
    hdc   = CreateCompatibleDC(hdc2) 'создаем совместимый контекст
    hbitmap = CreateCompatibleBitmap(hdc2,794,552) ' создаем совместимый битмап
    SelectObject(hdc,hbitmap) ' битмап в контекст
    mRectangle(&hFFE9E9,0,109) ' рисуем прямоугольник для адресов
    mRectangle(&hf0f0f0,110,595) 'рисуем прямоугольник для Hex символов
    mRectangle(&hE9FFE9,596,794) ' рисуем прямоугольник для ASCII символов

    CopyBytesProc() ' копируем данные в буфер, из которого будем читать информацию и рисовать
    SetBkMode(hdc,1) ' режим прозрачности для текста

    For i As Integer = 0 To 25 ' цикл по числу видимых строк
        Dim As ZString*50 sHex ' хранит HEX символы
        Dim As ZString*16 sString ' хранит ASCII символы
        For x As Integer = 0 To 15 ' цикл по числу столбцов
            If ullNullOffsetView+offset = ullSizeFile Then ' если конец буфера
                If x>0 Then ' если прошла хоть одна итерация
                    mDrawText() ' вызываем макрос
                Endif
                Exit For, For ' выход из обоих циклов
            Endif
            sHex &= (Hex(pbBytesBuffer[offset],2)& " ") ' собираем строку HEX
            Dim As Ubyte btempSimbol = pbBytesBuffer[offset]' получаем ASCCI код
            Select Case btempSimbol ' отсеиваем непечатываемые символы
                Case &h0 To &h1f,&hAD,&h98,&h7f
                    btempSimbol = &h2E ' заменяем их точками
            End Select
            sString[x] = btempSimbol ' собираем строку ASCII
            offset +=1 ' увеличиваем смещение
        Next
        mDrawText()' вызываем макрос
    Next

    BitBlt(hdc2,0,0,794,552,hdc,0,0,SRCCOPY) ' копируем содержимое контекста в другой контекст
    DeleteObject(hbitmap) ' удаляем битмап
    DeleteDC(hDC) ' удаляем совместимый контекст
    EndPaint(childHwnd, @ps) ' заканчиваем рисование
End Sub

' оконная процедура своего окна, на котором будем рисовать HEX данные
Function HexWndProc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_PAINT ' если требуется рисование
            PaintHexProc()
            Return 0
        Case WM_VSCROLL ' если произошло событие скроллинга
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)

End Function

' настройки главного окна
With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(sNameClass)
    .hIconSm=.hIcon
End With

' регистрация окна
If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

' Загрузка шрифтов
hFontCourierNew = LoadFontProc("Courier new",11,0,0,0,0,0,DEFAULT_CHARSET)

' создаем главное окно
mainHwnd = CreateWindowEx(0,sNameClass,"HexViewer",_
WS_VISIBLE Or WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_MINIMIZEBOX,100,100,800,610,0,0,Hinst,0)

For i As Integer = 0 To 10000
    TempDIM(i) = Rnd*256
Next

' главный цикл
While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend

На этом думаю, данную статью можно закончить. А в следующей уже решить вопрос с прокруткой, что даст возможность читать любой участок буфера в пользовательском режиме.

содержание | назад | вперед