Изображения для ImageList

[PAVEL_USER]

Привет всем!

Заполняю ImageList уменьшенными изображениями следующим образом:

Код: Выделить всё

Dim IL As New ImageList, size As System.Drawing.Size = New Size(180, 180)
IL.ImageSize = size

LV.LargeImageList = IL  'LV - ListView
Dim p As New PictureBox
Dim bm As Bitmap = New Bitmap(size.Width, size.Height)
p.SizeMode = PictureBoxSizeMode.Zoom
p.Width = size.Width : p.Height = size.Height
p.Image = Image.FromFile(...)

p.DrawToBitmap(bm, New Rectangle(0, 0, size.Width, size.Height))
IL.Images.Add(i, bm)
LV.Items.Add(..., i)

p.Image.Dispose()
p.Dispose()
bm.Dispose()


Подскажите пожалуйста, как можно ускорить процесс создания мини-изображений, есть ли другие оптимальные способы?

[Nord777]

посмотри функцию GetThumbnailImage класса Image

[PAVEL_USER]

Спасибо за предложение, получение изображения, функцией GetThumbnailImage и добавление в ImageList происходит немного быстрее, но теряются пропорции картинки. Для избежания этого, я использую:

Код: Выделить всё

...
p.SizeMode = PictureBoxSizeMode.Zoom
...
p.DrawToBitmap(bm, New Rectangle(0, 0, size.Width, size.Height))
...


Так что пока ничего не могу найти, чтобы заставть работать быстрее

[Nord777]

Пример, в котором все картинки из папки отображаются в ListView.

Код: Выделить всё

   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
      Dim sz As System.Drawing.Size = New Size(180, 180)
      Dim DestRect As Rectangle
      Dim im As Image, bm As Bitmap
      Dim IL As New ImageList
      Dim indx As Integer

      IL.ColorDepth = ColorDepth.Depth32Bit
      IL.ImageSize = sz
      LV.LargeImageList = IL

      Dim Files() As String = IO.Directory.GetFiles("E:\DOC\Мои рисунки\Картинки", "*.png")

      'LV.BeginUpdate()
      For Each fn As String In Files
         bm = New Bitmap(sz.Width, sz.Height)
         Using G As Graphics = Graphics.FromImage(bm)
            im = Image.FromFile(fn)
            DestRect = GetDestRect(sz.Width, sz.Height, im)
            G.DrawImage(im, DestRect, 0, 0, im.Width, im.Height, GraphicsUnit.Pixel)
         End Using
         IL.Images.Add(bm)
         LV.Items.Add(fn, indx)
         indx += 1
      Next
      'LV.EndUpdate()

   End Sub


   Function GetDestRect(ByVal destW%, ByVal destH%, ByVal im As Image) As Rectangle
      Dim R As New Rectangle
      Dim k As Double = (im.Width / im.Height)

      If k >= 1.0# Then
         R.Height = destH / k
         R.Width = destW
         R.Y = (destH - R.Height) / 2
      Else
         R.Width = destW * k
         R.Height = destH
         R.X = (destW - R.Width) / 2
      End If

      Return R
   End Function

[PAVEL_USER]

Спасибо за помощь!