PlgBlt Объявление в VB : Declare Function PlgBlt Lib "gdi32" Alias "PlgBlt" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long
Описание Функция копирует растр, преобразуя его в параллелограмм (=>можно и поворачивать, надо лишь написать алгоритм поворота прямоугольника и юз его точки)
Параметр Тип\Описание hdcDest-long приёмный контекст устр-ва lpPoint-pointapi превый элемент массива структур pointapi. Первая точка -левый верхний угол парал-ма, вторая-правый нижний, а третья-левый нижний угол. Четвертая точка расчитывается по первым трём. hdcSrc -исх. конт. уст-ва nXSrc, nYSrc- логич. корд. левого вехнего угла исх. изобр. nWidth, nHeight- размены исх. изобр. Вместо последних трёх параметров (hbmMask... ) я пишу нули
PlgBlt Объявление в VB : Declare Function PlgBlt Lib "gdi32" Alias "PlgBlt" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long
Описание Функция копирует растр, преобразуя его в параллелограмм (=>можно и поворачивать, надо лишь написать алгоритм поворота прямоугольника и юз его точки)
Параметр Тип\Описание hdcDest-long приёмный контекст устр-ва lpPoint-pointapi превый элемент массива структур pointapi. Первая точка -левый верхний угол парал-ма, вторая-правый нижний, а третья-левый нижний угол. Четвертая точка расчитывается по первым трём. hdcSrc -исх. конт. уст-ва nXSrc, nYSrc- логич. корд. левого вехнего угла исх. изобр. nWidth, nHeight- размены исх. изобр. Вместо последних трёх параметров (hbmMask... ) я пишу нули
Вот что на первом месте: пора на нормальную графику переходить! Создай пиктуребокс и GIF-файл, допустим, с 256-цветной палитрой или полноцветный JPG-файл, неважно, что там нарисовано, задай разрешение, допустим, 640x480, вставь в пиктуребокс дальше код такой добавь:
Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private Type SAFEARRAY1D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 0) As SAFEARRAYBOUND End Type Private Type SAFEARRAY2D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 1) As SAFEARRAYBOUND End Type Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Dim MPIC() As Byte, sa As SAFEARRAY2D, bmp As BITMAP
Private Sub Form_Load() Dim I&, II& Randomize
GetObjectAPI [pctbox].Picture, Len(bmp), bmp With sa .cbElements = 1 .cDims = 2 .Bounds(0).lLbound = 0 .Bounds(0).cElements = bmp.bmHeight .Bounds(1).lLbound = 0 .Bounds(1).cElements = bmp.bmWidthBytes .pvData = bmp.bmBits End With CopyMemory ByVal VarPtrArray(MPIC), VarPtr(sa), 4
Me.Show For II = 0 To [height] For I = 0 To [width] * [channels] MPIC(I, II) = 0 Next Next End Sub
Поставь флажки в Advanced Optimizations и рисуй в буфере что хошь. Изображения хранить в других таких же массивах можно. Вроде бы ничего не забыл.