FreeBasic

Мы уже пробовали рисовать изображения с помощью кистей. Но это не самый хороший способ. Лучшим способом рисовать непрозрачные изображения в уже имеющийся контекст, является метод, предложенный ниже:

• Создать совместимый контекст изображения
• Выбрать туда наш объект(хендл) изображения
• Скопировать площадь контекста, равную размеру изображения в имеющийся контекст из совместимого контекста с помощью BitBlt

В нашем примере ниже, мы будем загружать иображение с помощью функции LoadImage, а узнавать размеры изображения с помощью GetObject. Если с первой функцией мы знакомились в этой статье, то GetObject еще не рассматривали.

Данная функция позволяет получать информацию об объектах GDI (палитры, изображений, кистей, перьев и шрифтов)

Ее прототип выглядит следующим образом:

GetObject(_
      As HGDIOBJ hgdiobj,_  ' хендл объекта
      As Integer cbBuffer,_  ' размер буфера для информации об объекте
      As LPVOID lpvObject _  ' буфер с информацией об объекте
    ) As Integer

В качестве буфера в параметр функции помещается указатель на структуру, зависящую от типа объекта (LOGPEN, LOGBRUSH, LOGFONT, BITMAP, и др.) В нашем случае, для получения размеров, нужно в третьем параметре функции передать указатель на структуру BITMAP , в которую система запишет информацию об изображении. Во второй параметр передать размер этой структуры. Ну и в первый параметр передается хендл нашего изображения.

Сама структура BITMAP выглядит так:

Type BITMAP
    bmType As Long ' тип точечного рисунка
    bmWidth As Long ' ширина изображения в пикселях
    bmHeight As Long ' высота изображения в пикселях
    bmWidthBytes As Long 'число байт в каждой строке развертки
    bmPlanes As WORD 'число цветовых плоскостей
    bmBitsPixel As WORD 'кол-во бит на пиксель
    bmBits As LPVOID 'указатель на массив с пикселями
End Type

А теперь пример, в котором мы загрузим изображение, напишем на нем надпись и нарисуем на нашем холсте. Для примера я использовал изображение в формате bmp 128x128:

#INCLUDE "windows.bi"
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String NameClass="MyClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)
Dim Shared As HBITMAP img
Dim Shared bInfo As BITMAP

Sub DrawImage(hdc As HDC)

    ' Создаем контекст в памяти
    Dim As HDC memhdc = CreateCompatibleDC(hdc)

   ' Помещаем туда наш рисунок
   Dim As HGDIOBJ oldObject = SelectObject(memhdc,img)
   
   ' определяем фон для текста прозрачным
   SetBkMode(memhdc,TRANSPARENT)
   
   ' Рисуем надпись на изображении
   TextOut(memhdc,1,1,@"image",5)
   
   ' копируем содержимое одного контекста в другой
   BitBlt(hdc, 45, 20, bInfo.bmWidth , bInfo.bmHeight , memhdc, 0, 0, SRCCOPY)

    ' загружаем в контекст старый объект
    SelectObject(hdc,oldObject)
    
    ' удаляем контекст
    DeleteDC(memhdc)

End Sub

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

    Static canvas As HWND

    Select Case msg
        Case WM_CREATE
            ' создаем наш холст для рисования
            canvas = CreateWindowEx(0,"Static","",WS_VISIBLE Or WS_CHILD,10,10,230,220,hwnd,Cast(HMENU,1),0,0)
            ' загружаем изображение
            img = LoadImage(0,"bmp128x128.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE)
            ' получаем информацию об изображении
            getobject(Cast(HBITMAP,img),Sizeof(BITMAP),@bInfo)
        Case WM_PAINT
            Dim ps As PAINTSTRUCT
            BeginPaint(canvas,@ps)
            DrawImage(ps.hDC)
            EndPaint(canvas,@ps)
        Case WM_DESTROY
            DeleteObject(img)
            PostQuitMessage(0)
    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(NameClass)
    .hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

CreateWindowEx(0,NameClass,"Рисование изображения",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,250,240,0,0,Hinst,0)

While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend

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