Attribute VB_Name = "modSaveToGif"
Option Explicit

' Модуль modSaveToGif.bas - основные функции, глобальные переменные, декларации
' © Кривоус Анатолий Анатольевич (The trick), 2014

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type DRAWITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemAction As Long
    itemState As Long
    hwndItem As Long
    hdc As Long
    rcItem As RECT
    ItemData As Long
End Type
Public Type MEASUREITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemWidth As Long
    itemHeight As Long
    ItemData As Long
End Type
Public Type ListItem
    img As Long
    FileName As String
    Width As Long
    Height As Long
    TimeMS As Long
    AlphaThreshold As Long
End Type
Private Type locListItem
    img As Long
    lpFileName As Long
    Width As Long
    Height As Long
    TimeMS As Long
    AlphaThreshold As Long
End Type
Public Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
Public Type CLSID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Public Type EncoderParameter
    GUID As CLSID
    NumberOfValues As Long
    type As Long
    Value As Long
End Type
Public Type EncoderParameters
    Count As Long
    Parameter As EncoderParameter
End Type
Public Type PropertyItem
    propId As Long
    Length As Long
    type As Integer
    Value As Long
End Type
Public Type ImageCodecInfo
    ClassID As CLSID
    FormatID As CLSID
    CodecName As Long
    DllName As Long
    FormatDescription As Long
    FilenameExtension As Long
    MimeType As Long
    flags As Long
    Version As Long
    SigCount As Long
    SigSize As Long
    SigPattern As Long
    SigMask As Long
End Type
Public Type ColorPalette
    flags As Long
    Count As Long
    Entries(0 To 255) As Long
End Type
Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As Long
    lpstrCustomFilter As Long
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As Long
    nMaxFile As Long
    lpstrFileTitle As Long
    nMaxFileTitle As Long
    lpstrInitialDir As Long
    lpstrTitle As Long
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
Public Type INITCOMMONCONTROLSEX
    dwSize As Long
    dwICC As Long
End Type

Public Type RGBTriple
    R As Long
    G As Long
    B As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameW" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function SetDCBrushColor Lib "gdi32" (ByVal hdc As Long, ByVal colorref As Long) As Long
Public Declare Function SetDCPenColor Lib "gdi32" (ByVal hdc As Long, ByVal colorref As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hdc As Long, lpStr As Any, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Public Declare Function GetMem1 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Public Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (lpString1 As Any, lpString2 As Any, ByVal iMaxLength As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (lpString As Any) As Long
Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontW" (ByVal h As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal W2 As Long, ByVal i As Long, ByVal u As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As Any) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Public Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Public Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function INITCOMMONCONTROLSEX Lib "comctl32" Alias "InitCommonControlsEx" (ByRef TLPINITCOMMONCONTROLSEX As INITCOMMONCONTROLSEX) As Long
' GDI+
Public Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal Color As Long, ByVal Width As Single, ByVal unit As Long, Pen As Long) As Long
Public Declare Function GdipDeletePen Lib "gdiplus" (ByVal Pen As Long) As Long
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As Long
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As Long
Public Declare Function GdipDrawRectangleI Lib "gdiplus" (ByVal Graphics As Long, ByVal Pen As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As Long
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, Graphics As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Public Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal ARGB As Long, Brush As Long) As Long
Public Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal Graphics As Long, ByVal SmoothingMd As Long) As Long
Public Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal Brush As Long) As Long
Public Declare Function GdipFillRectangleI Lib "gdiplus" (ByVal Graphics As Long, ByVal Brush As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As Long
Public Declare Function GdipDrawImageRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As Long
Public Declare Function GdipSetPenColor Lib "gdiplus" (ByVal Pen As Long, ByVal ARGB As Long) As Long
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (FileName As Any, image As Long) As Long
Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdipSaveAdd Lib "gdiplus" (ByVal image As Long, encoderParams As Any) As Long
Public Declare Function GdipSaveAddImage Lib "gdiplus" (ByVal image As Long, ByVal newImage As Long, encoderParams As Any) As Long
Public Declare Function GdipSetPropertyItem Lib "gdiplus" (ByVal image As Long, Item As PropertyItem) As Long
Public Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As CLSID) As Long
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Public Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As Long
Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As Long
Public Declare Function GdipGetImagePaletteSize Lib "gdiplus" (ByVal image As Long, size As Long) As Long
Public Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, Bitmap As Long) As Long
Public Declare Function GdipGetImageGraphicsContext Lib "gdiplus" (ByVal image As Long, Graphics As Long) As Long
Public Declare Function GdipDrawImageI Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GdipSetImagePalette Lib "gdiplus" (ByVal image As Long, palette As ColorPalette) As Long
Public Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long

Public Const GENERIC_WRITE = &H40000000
Public Const CREATE_ALWAYS = 2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_SHARE_READ = &H1

Public Const ICC_STANDARD_CLASSES = &H4000

Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXPLORER = &H80000

Public Const GWL_USERDATA = (-21)
Public Const GWL_WNDPROC = &HFFFFFFFC

Public Const WM_COMMAND = &H111
Public Const WM_MEASUREITEM As Long = &H2C
Public Const WM_CTLCOLORLISTBOX = &H134
Public Const WM_DRAWITEM = &H2B
Public Const WM_GETMINMAXINFO = &H24

Public Const WS_EX_CLIENTEDGE = &H200&
Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_VSCROLL = &H200000
Public Const WS_TABSTOP = &H10000
Public Const LBS_HASSTRINGS = &H40&
Public Const LBS_NOINTEGRALHEIGHT = &H100&
Public Const LBS_NOTIFY = &H1&
Public Const LBS_OWNERDRAWFIXED = &H10&

Public Const LB_ADDSTRING = &H180
Public Const LB_SETITEMDATA = &H19A
Public Const LB_GETITEMDATA = &H199
Public Const LB_DELETESTRING = &H182
Public Const LB_GETCOUNT = &H18B
Public Const LB_GETCURSEL = &H188
Public Const LB_SETCURSEL = &H186
Public Const LBN_DBLCLK = 2

Public Const SWP_NOZORDER = &H4
Public Const CW_USEDEFAULT = &H80000000
Public Const ODS_SELECTED As Long = &H1
Public Const ODT_LISTBOX = 2

Public Const NULL_PEN = 8
Public Const NULL_BRUSH = 5
Public Const WHITE_BRUSH = 0
Public Const DC_BRUSH As Long = 18
Public Const FW_BOLD = 700
Public Const TRANSPARENT = 1

'GDI+
Public Const PropertyTagFrameDelay = &H5100
Public Const PropertyTagIndexTransparent = &H5104
Public Const PropertyTagGlobalPalette = &H5102
Public Const PropertyTagLoopCount = &H5101
Public Const EncoderSaveFlag As String = "{292266FC-AC40-47BF-8CFC-A85B89A655DE}"
Public Const PropertyTagTypeByte = 1
Public Const PropertyTagTypeLong = 4
Public Const PropertyTagTypeShort = 3
Public Const EncoderParameterValueTypeLong = 4
Public Const EncoderValueMultiFrame = 18
Public Const EncoderValueFlush = 20
Public Const EncoderValueFrameDimensionTime = 21
Public Const PixelFormat8bppIndexed = &H30803
Public Const PixelFormat32bppARGB = &H26200A
Public Const PaletteFlagsHasAlpha = &H1
Public Const UnitPixel = 2

Dim hList As Long                                               ' Хендл списка
Dim mList() As ListItem                                         ' Элементы списка
Dim BackBrush As Long, HeaderFont As Long, DescFont As Long     ' Ресурсы GDI для отрисовки

' Глобальные переменные октодерева
Public TreeLeafLevel As Long, _
       TreeSize As Long, _
       TreeReduceLevel, _
       TreeReduceList() As clsOctree
' Добавить элемент в список
Public Function AddItem(Data As ListItem) As Long
    Dim i As Long
    i = ListCount
    ReDim Preserve mList(i)
    mList(i) = Data
    Normalize
    AddItem = SendMessage(hList, LB_ADDSTRING, 0, ByVal VarPtr(mList(i)))
End Function
' Удалить элемент из списка
Public Function Remove(ByVal Index As Long) As Boolean
    Dim i As Long
    Remove = SendMessage(hList, LB_DELETESTRING, Index, ByVal 0) <> -1
    If Not Remove Then Exit Function
    ' Удаляем эскиз
    GdipDisposeImage mList(Index).img
    For i = Index To ListCount - 1
        mList(i) = mList(i + 1)
    Next
    Normalize
End Function
' Обмен 2-х элементов списка
Public Sub Swap(ByVal I1 As Long, ByVal I2 As Long)
    Dim tmp As ListItem
    tmp = mList(I1)
    mList(I1) = mList(I2)
    mList(I2) = tmp
    Normalize
    InvalidateRect hList, ByVal 0, 0
End Sub
' Получить количество элементов списка
Public Property Get ListCount() As Long
    ListCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0)
End Property
' Получить индекс выбранного элемента
Public Property Get ListIndex() As Long
    ListIndex = SendMessage(hList, LB_GETCURSEL, 0, ByVal 0)
End Property
' Выбрать элемент
Public Property Let ListIndex(ByVal Index As Long)
    SendMessage hList, LB_SETCURSEL, Index, ByVal 0
End Property
' Получить значение списка
Public Property Get List(ByVal Index As Long) As ListItem
    List = mList(Index)
End Property
' Задать значение списку
Public Property Let List(ByVal Index As Long, Data As ListItem)
    mList(Index) = Data
    Normalize
    InvalidateRect hList, ByVal 0, 0
End Property
' Задать позицию списку
Public Function ListMove(ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long) As Boolean
    SetWindowPos hList, 0, Left, Top, Width, Height, SWP_NOZORDER
End Function
' Создать список
Public Sub CreateList()
    Dim Prev As Long
    Prev = SetWindowLong(frmMain.hwnd, GWL_WNDPROC, AddressOf WndProc)
    SetWindowLong frmMain.hwnd, GWL_USERDATA, Prev
    hList = CreateWindowEx(WS_EX_CLIENTEDGE, StrPtr("LISTBOX"), 0, WS_CHILD Or WS_VISIBLE Or LBS_OWNERDRAWFIXED _
                            Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL Or LBS_NOTIFY Or WS_TABSTOP, 0, 0, CW_USEDEFAULT, CW_USEDEFAULT, _
                            frmMain.hwnd, &H123, 0, ByVal 0&)
End Sub
' Удалить список и все ресурсы
Public Sub DeleteList()
    Dim Prnt As Long
    If hList Then
        DestroyWindow hList
        SetWindowLong frmMain.hwnd, GWL_WNDPROC, GetWindowLong(frmMain.hwnd, GWL_USERDATA)
        DeleteObject BackBrush
        DeleteObject HeaderFont
        DeleteObject DescFont
    End If
End Sub
' Обновление указателей
Private Function Normalize()
    Dim i As Long
    For i = 0 To ListCount - 1
        SendMessage hList, LB_SETITEMDATA, i, ByVal VarPtr(mList(i))
    Next
End Function
' Процедура формы
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Prev As Long
    Select Case uMsg
    Case WM_GETMINMAXINFO                                               ' Ограничение минимального размера формы
        Dim mm As MINMAXINFO
        CopyMemory mm, ByVal lParam, Len(mm)
        mm.ptMinTrackSize.x = 400
        mm.ptMinTrackSize.y = 400
        CopyMemory ByVal lParam, mm, Len(mm)
    Case WM_COMMAND                                                     ' Получение уведомлений
        If wParam = &H10123 Then
            frmMain.lstImage_SelChange
        Else
            Prev = GetWindowLong(hwnd, GWL_USERDATA)
            WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
        End If
    Case WM_DRAWITEM                                                    ' Отрисовка элемента
        Dim drw As DRAWITEMSTRUCT
        CopyMemory drw, ByVal lParam, Len(drw)
        If drw.CtlType = ODT_LISTBOX Then
            DrawItem drw
            WndProc = True
        Else
            Prev = GetWindowLong(hwnd, GWL_USERDATA)
            WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
        End If
    Case WM_MEASUREITEM                                                 ' Запрос размеров элемента
        Dim meas As MEASUREITEMSTRUCT
        CopyMemory meas, ByVal lParam, Len(meas)
        If meas.CtlType = ODT_LISTBOX Then
            meas.itemHeight = 100
            CopyMemory ByVal lParam, meas, Len(meas)
            WndProc = True
        Else
            Prev = GetWindowLong(hwnd, GWL_USERDATA)
            WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
        End If
    Case WM_CTLCOLORLISTBOX                                             ' Запрос фона списка
        If BackBrush = 0 Then InitVariables
        WndProc = BackBrush
    Case Else                                                           ' По умолчанию
        Prev = GetWindowLong(hwnd, GWL_USERDATA)
        WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
    End Select
End Function
' Инициализация переменных
Private Sub InitVariables()
    Dim bmp As Long, obmp As Long, dc As Long, opn As Long, obr As Long, RC As RECT
    
    ' Создаем "шахматную" кисть светло-серого цвета для фона списка
    bmp = CreateCompatibleBitmap(frmMain.hdc, 10, 10)
    dc = CreateCompatibleDC(frmMain.hdc)
    obmp = SelectObject(dc, bmp)
    opn = SelectObject(dc, GetStockObject(NULL_PEN))
    obr = SelectObject(dc, GetStockObject(DC_BRUSH))
    SetDCBrushColor dc, &HE0E0E0
    RC.Right = 10: RC.Bottom = 10
    FillRect dc, RC, GetStockObject(WHITE_BRUSH)
    Rectangle dc, 0, 0, 6, 6
    Rectangle dc, 5, 5, 11, 11
    BackBrush = CreatePatternBrush(bmp)
    SelectObject dc, opn
    SelectObject dc, obr
    SelectObject dc, obmp
    DeleteObject bmp
    DeleteDC dc
    
    ' Шрифты для списка
    HeaderFont = CreateFont(-12, 0, 0, 0, FW_BOLD, 0, 0, 0, 0, 0, 0, 0, 0, ByVal StrPtr("Arial"))
    DescFont = CreateFont(-10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ByVal StrPtr("Arial"))
     
End Sub
' Отрисовка элемента
Private Function DrawItem(drw As DRAWITEMSTRUCT) As Boolean
    Dim gr As Long, pn As Long, Br As Long, Name As String, itm As locListItem, l As Long
    Dim iw As Long, ih As Long, a As Single, d As Single, x As Long, y As Long, of As Long
    Dim Title As String, bufDC As Long, bufBmp As Long, oBufBmp As Long, RC As RECT
    
    ' Используем двойную буферизацию
    RC.Right = drw.rcItem.Right - drw.rcItem.Left: RC.Bottom = drw.rcItem.Bottom - drw.rcItem.Top
    bufDC = CreateCompatibleDC(drw.hdc)
    bufBmp = CreateCompatibleBitmap(drw.hdc, RC.Right, RC.Bottom)
    oBufBmp = SelectObject(bufDC, bufBmp)
    
    ' Очистка фона
    FillRect bufDC, RC, BackBrush
    
    GdipCreateFromHDC bufDC, gr
    GdipCreatePen1 &HFF3040A0, 1, UnitPixel, pn

    If (drw.itemState And ODS_SELECTED) Then
        ' Пометка при выделенном пункте
        GdipCreateSolidFill &H303040A0, Br
        GdipFillRectangleI gr, Br, 0, 0, RC.Right - 1, RC.Bottom - 1
        GdipDrawRectangleI gr, pn, 0, 0, RC.Right - 1, RC.Bottom - 1
        GdipDeleteBrush Br
    End If
    
    ' Рамка для рисунка
    GdipSetPenColor pn, &H50A04030
    GdipDrawRectangleI gr, pn, 2, 2, 95, 95
                    
    ' Получение значение списка
    
    If drw.ItemData = 0 Then Exit Function
    
    CopyMemory itm, ByVal drw.ItemData, Len(itm)
    GetMem4 ByVal itm.lpFileName - 4, l: l = l \ 2
    Name = Space(l)
    lstrcpyn ByVal StrPtr(Name), ByVal itm.lpFileName, l + 1
    Title = (drw.itemID + 1) & ". " & Mid$(Name, InStrRev(Name, "\") + 1)
    
    GdipGetImageWidth itm.img, iw: GdipGetImageHeight itm.img, ih
    Name = Name & vbNewLine & CStr(itm.Width) & "x" & CStr(itm.Height) & vbNewLine & _
                  "Interval: " & itm.TimeMS & " ms." & vbNewLine & "Threshold: " & _
                  Format$(itm.AlphaThreshold, "0;;Non\e")
    
    x = (94 - iw) \ 2 + 3
    y = (94 - ih) \ 2 + 3
    
    ' Рисуем превью
    GdipDrawImageRectI gr, itm.img, x, y, iw, ih
    
    GdipDeletePen pn
    GdipDeleteGraphics gr
    
    ' Отрисовка параметров
    SetBkMode bufDC, TRANSPARENT
    RC.Left = RC.Left + 100
    of = SelectObject(bufDC, HeaderFont)
    l = DrawText(bufDC, ByVal StrPtr(Title), Len(Title), RC, 0)
    SetTextColor bufDC, &HA04030
    of = SelectObject(bufDC, DescFont)
    RC.Top = RC.Top + l
    
    DrawText bufDC, ByVal StrPtr(Name), Len(Name), RC, 0
    SelectObject bufDC, of
    
    ' Перенос на передний буфер
    BitBlt drw.hdc, drw.rcItem.Left, drw.rcItem.Top, RC.Right, RC.Bottom, bufDC, 0, 0, vbSrcCopy
    
    SelectObject bufDC, oBufBmp
    DeleteObject bufBmp
    DeleteDC bufDC
End Function
' Получить список выбранных изображений
Public Function GetOpenFile(ByVal hwnd As Long, Count As Long) As String()
    Dim ofn As OPENFILENAME, Out As String, ic As Long, io As Long, p As Long, ret() As String
    
    ofn.flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
    ofn.nMaxFile = 32767
    Out = String(32767, vbNullChar)

    ofn.hwndOwner = hwnd
    ofn.lpstrTitle = StrPtr("Добавить изображение")
    ofn.lpstrFile = StrPtr(Out)
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFilter = StrPtr("Файлы изображений" & vbNullChar & "*.bmp;*.jpg;*.jpeg;*.gif;*.png;*.tiff")
    If GetOpenFileName(ofn) Then
        ReDim ret(0)
        ' 1-й элемент - путь
        ret(p) = Left$(Out, ofn.nFileOffset - 1)
        io = ofn.nFileOffset + 1: p = p + 1
        ic = InStr(io, Out, vbNullChar)
        ' Перебираем файлы
        Do Until ic = io
            ReDim Preserve ret(p)
            ret(p) = Mid$(Out, io, ic - io)
            io = ic + 1: p = p + 1
            ic = InStr(io, Out, vbNullChar)
        Loop
        Count = UBound(ret) + 1
        GetOpenFile = ret
    End If
End Function
' Получить имя сохраняемого GIF файла
Public Function GetSaveFile(ByVal hwnd As Long) As String
    Dim ofn As OPENFILENAME, Out As String, i As Long
    
    ofn.nMaxFile = 260
    ofn.flags = OFN_OVERWRITEPROMPT Or OFN_EXPLORER
    Out = String(260, vbNullChar)
    ofn.hwndOwner = hwnd
    ofn.lpstrTitle = StrPtr("Сохранить анимацию")
    ofn.lpstrFile = StrPtr(Out)
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFilter = StrPtr("GIF анимации" & vbNullChar & "*.gif")
    ofn.lpstrDefExt = StrPtr("gif")
    If GetSaveFileName(ofn) Then
        i = InStr(1, Out, vbNullChar, vbBinaryCompare)
        If i Then GetSaveFile = Left$(Out, i - 1)
    End If
End Function

