Prev: Common Controls 5.0 / Windows 7
Next: Dao350.dll unsupported under Windows 7
From: Larry Serflaten on 14 Nov 2009 17:05

"k_zeon" <silvermaine2000(a)googlemail.com> wrote

> I have just finished making my own usercontrol to display a picture (aprox
> inch & half wide and 2inch high.
> I can load them up now no problem, except one.

I just tried using a large thumbnail image (3500, 3500 twips) and found
the array method also ran out of memory. For testing the 1000 images,
I used the small thumbnail, as shown in the example code (1200, 1200).

Another caveate I found, the BuildThumb does the aspect calculation
with the assumption that the target area is square. Setting it to other than
square (as you indicate above) distorts the image. Additional calculation
would be needed to account for each dimension.

While I would still advise using a timer to load images in the background,
you might want to only keep 3 pages of images in memory, the previous
page, the current page, and the next page. That is sort of a windowing
method in that you're looking at the files through a moving window of
loaded images.

But, keep at it, and be creative! If you find a good solution, do post
back to tell others about it....

LFS





From: k_zeon on 14 Nov 2009 18:38
Hi Guys

Just thought I would post some info on where i am at.

I have created a usercontrol that allows me to add an image and also change
the border colour and back colour.I can also enter the name of the file and
also the path to the picture.
I have then been able to load this usercontrol and place in a picturebox.
Once i have 50 loaded i call a resize event to arrange on my Picturebox.(
each pic will be loaded from a list)
When getting the picture , I have found a Module that uses GDI+ to resize an
image on the fly keeping the aspect ratio and I can resize to whatever I
need.

(I did try to load 500 but it seems that the Picturebox has a limitation of
how high it can be, so once i go above a certain amount i cannot scroll down
any further) ie Pic1.Height + Pic2.Height + Pic3.Height etc etc = How High
PictureBox needs to be.
I have found another usercontrol created by someone else that is a
Scrollport ie i just place my PictureBox onto this usercontrol and it deals
with all the scrollbar stuff.

As i said above i load 50 pics at a time. I can resize my form and the
pictures move to the correct X Y positions. This is as far as I have got and
all seems to work well.

What I am now trying to do is Load my form with 50 pics and then have 2
buttons on the form for Backwards & Forwards.

Maybe I am just tired but for the life of me cannot think of the best way to
code for Backwards & Forwards. <<< If anyone can help, pls email me. (tks)

Below is some code I use to load the first 50, this is done in a Button
Click event for test purposes but will be moved once I add to my main
projects.

If anyone is interested in what I have so far , then let me know and I would
be happy to email.

Private Sub Command1_Click()

Dim picwidth As Integer
Dim picheight As Integer
Dim xx As Long
Dim y As Long
Dim lCols As Long
Dim Token As Long
' Initialise GDI+
Token = InitGDIPlus

LockWindow Picture1.hWnd, True
Dim x As Integer

'If any controls are loaded unload them
For x = 1 To UserControl11.Count - 1
Unload UserControl11(x)
Next x
UserControl11(0).Visible = False ' Set origonal one to invisible

For x = 0 To 55
DoEvents
Label1.Caption = x
If x > 0 Then

Load UserControl11(x)
End If
UserControl11(x).Height = 3735
UserControl11(x).Width = 2895

picwidth = UserControl11(x).Width + 200
picheight = UserControl11(x).Height + 200
lCols = Int((Picture1.ScaleWidth) / picwidth)

xx = (x Mod lCols) * picwidth
y = Int(x / lCols) * picheight

UserControl11(x).Move xx + 200, y + 200
Picture1.Height = y + UserControl11(0).Height + 400

UserControl11(x).MovieName = "Test Movie"
UserControl11(x).MoviePicturePath = "Testpath"
UserControl11(x).MovieID = x
UserControl11(x).MoviePicture =
modGDIPlusResize.LoadPictureGDIPlus("C:\Documents and
Settings\Garry\Desktop\testttt\test2\Largeimage.jpg", 200, 200, , True) '<<
This is the GDI+ mod call to resize picture
UserControl11(x).Visible = True
Next x


' Free GDI+
FreeGDIPlus Token
LockWindow Picture1.hWnd, False

ScrollingViewPort1.FormatControl '<< this will force the usercontrol to
arrange my Pictures


End Sub



"Larry Serflaten" <serflaten(a)usinternet.com> wrote in message
news:eGiHu7XZKHA.4920(a)TK2MSFTNGP04.phx.gbl...
>
> "k_zeon" <silvermaine2000(a)googlemail.com> wrote
>
>> I have just finished making my own usercontrol to display a picture
>> (aprox
>> inch & half wide and 2inch high.
>> I can load them up now no problem, except one.
>
> I just tried using a large thumbnail image (3500, 3500 twips) and found
> the array method also ran out of memory. For testing the 1000 images,
> I used the small thumbnail, as shown in the example code (1200, 1200).
>
> Another caveate I found, the BuildThumb does the aspect calculation
> with the assumption that the target area is square. Setting it to other
> than
> square (as you indicate above) distorts the image. Additional calculation
> would be needed to account for each dimension.
>
> While I would still advise using a timer to load images in the background,
> you might want to only keep 3 pages of images in memory, the previous
> page, the current page, and the next page. That is sort of a windowing
> method in that you're looking at the files through a moving window of
> loaded images.
>
> But, keep at it, and be creative! If you find a good solution, do post
> back to tell others about it....
>
> LFS
>
>
>
>
>
From: Nobody on 14 Nov 2009 21:32
Here are two functions GetPictureBits/SetPictureBits that take a hDC of an
AutoRedraw PictureBox, and returns the picture as byte array(no resizing),
or restore back from a byte array. This is for caching thumbnails. Speed
tests show that it takes 86us to get the picture as byte array, and 45us to
restore byte array to a picture box. These times are for 128x128 pixels
picture box(client area), and for Intel Quad 2.4 GHz, XP+SP2+4GB memory,
1280x1024x32Bit color display. Buffer size needed is 66KB per picture.

To try the sample, add a PictureBox and Command button to Form1, then use
the following code:

' Form1 code ============================

Option Explicit

Private Sub Command1_Click()
Dim bOut() As Byte
Dim LastDllError As Long
Dim ret As Long

' Set PictureBox size to 132x132, client area would
' be 128x128. 2 Pixels at either side are used for border.
Picture1.Width = 132 * Screen.TwipsPerPixelX
Picture1.Height = 132 * Screen.TwipsPerPixelY

Picture1.AutoRedraw = True

' Draw a "\" line
Picture1.Line (0, 0)-(500, 500)
ret = GetPictureBits(Picture1.hDC, bOut(), LastDllError)
Debug.Print "GetPictureBits returned " & ret & _
", LastDllError = " & LastDllError

' Draw a "/" line, this will be erased by the call to SetPictureBits()
Picture1.Line (500, 0)-(0, 500)
MsgBox "About to restore PictureBox"
If ret = 0 Then
ret = SetPictureBits(Picture1.hDC, bOut(), LastDllError)
Debug.Print "SetPictureBits returned " & ret & _
", LastDllError = " & LastDllError
Picture1.Refresh
End If
End Sub

' Module1 code ============================

Option Explicit

Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As RGBQUAD
End Type
Public Const BI_RGB = 0&
Public Const BI_RLE4 = 2&
Public Const BI_RLE8 = 1&
Public Const DIB_RGB_COLORS = 0 ' color table in RGBs
Public Const DIB_PAL_COLORS = 1 ' color table in palette indices
Public Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, _
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As _
Long, lpBits As Any, lpbi As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hDC As Long, _
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As _
Long, lpBits As Any, lpbi As BITMAPINFO, ByVal wUsage As Long) As Long
Public Const OBJ_BITMAP = 7
Public Const OBJ_BRUSH = 2
Public Const OBJ_FONT = 6
Public Const OBJ_PAL = 5
Public Const OBJ_PEN = 1
Public Declare Function GetCurrentObject Lib "gdi32" (ByVal hDC As Long, _
ByVal uObjectType As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" ( _
ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Sub OutputDebugString Lib "kernel32" Alias _
"OutputDebugStringA" (ByVal lpOutputString As String)

'
' GetPictureBits
'
' Gets bitmap info and pixel value of AutoRedraw PictureBox or form
'
' PARAMETERS
'
' hDC hDC of AutoRedraw PictureBox or form
' bOut Receives bitmap info and pixel value. The routine ReDim
' this array to the correct size
' LastDllError LastDllError when an error occurs
'
' RETURNS
'
' 0 Success
' -1 GetCurrentObject failed
' -2 GetObject failed
' -3 Out of memory
' -4 GetDIBits failed
' -5 Unknown error
'
Public Function GetPictureBits(ByVal hDC As Long, ByRef bOut() As Byte, _
ByRef LastDllError As Long) As Long
Dim ResumeNext As Boolean
Dim ErrNumber As Long
Dim hBitmap As Long
Dim bm As BITMAP
Dim bi As BITMAPINFO
Dim BufferSize As Long
Dim ret As Long

On Error GoTo ErrorHandler

' Get the handle to the current bitmap
hBitmap = GetCurrentObject(hDC, OBJ_BITMAP)
If hBitmap = 0 Then
LastDllError = Err.LastDllError
GetPictureBits = -1 ' GetCurrentObject failed
Exit Function
End If

' Debug.Print "hBitmap = " & Hex(hBitmap)

' Get bitmap info, like width and height
If GetObject(hBitmap, Len(bm), bm) = 0 Then
LastDllError = Err.LastDllError
GetPictureBits = -2 ' GetObject failed
Exit Function
End If

' Buffer size to hold pixel data
BufferSize = ((((bm.bmWidth * bm.bmBitsPixel) + 31) And &HFFFFFFE0) _
\ 8) * bm.bmHeight
' We also need to include BITMAPINFO. We choose to include
' it at the beginning.
BufferSize = BufferSize + Len(bi)

' Allocate buffer
ResumeNext = True
ReDim bOut(0 To BufferSize - 1) As Byte
ResumeNext = False
If ErrNumber <> 0 Then
LastDllError = 0
GetPictureBits = -3 ' Out of memory
Exit Function
End If

bi.bmiHeader.biSize = LenB(bi.bmiHeader)
bi.bmiHeader.biWidth = bm.bmWidth
bi.bmiHeader.biHeight = bm.bmHeight
bi.bmiHeader.biPlanes = bm.bmPlanes
bi.bmiHeader.biBitCount = bm.bmBitsPixel
bi.bmiHeader.biCompression = BI_RGB
bi.bmiHeader.biSizeImage = 0
bi.bmiHeader.biXPelsPerMeter = 0
bi.bmiHeader.biYPelsPerMeter = 0
bi.bmiHeader.biClrUsed = 0
bi.bmiHeader.biClrImportant = 0

ret = GetDIBits(hDC, hBitmap, 0, bm.bmHeight, bOut(Len(bi)), bi, _
DIB_RGB_COLORS)
If ret = 0 Then
LastDllError = Err.LastDllError
GetPictureBits = -4 ' GetDIBits failed
Exit Function
End If

' Copy BITMAPINFO to the beginning of the array
CopyMemory bOut(0), bi, Len(bi)

GetPictureBits = 0 ' Success

ExitSub:
Exit Function
ErrorHandler:
ErrNumber = Err.Number
If ResumeNext Then
Resume Next
Else
LastDllError = Err.LastDllError
GetPictureBits = -5 ' Unknown error
'MsgBox "GetPictureBits: Error " & Err.Number & ": " & _
Err.Description
Resume ExitSub
End If
End Function

'
' SetPictureBits
'
' Restores bitmap info and pixel value to AutoRedraw PictureBox or form
'
' PARAMETERS
'
' hDC hDC of AutoRedraw PictureBox or form
' bOut Array of bitmap info and pixel values, from
' GetPictureBits routine
' LastDllError LastDllError when an error occurs
'
' RETURNS
'
' 0 Success
' -1 GetCurrentObject failed
' -2 GetObject failed
' -3 GetDIBits failed
' -4 Unknown error
'
Public Function SetPictureBits(ByVal hDC As Long, ByRef bOut() As Byte, _
ByRef LastDllError As Long) As Long
Dim ResumeNext As Boolean
Dim ErrNumber As Long
Dim hBitmap As Long
Dim bm As BITMAP
Dim bi As BITMAPINFO
Dim BufferSize As Long
Dim ret As Long

On Error GoTo ErrorHandler

' Get the handle to the current bitmap
hBitmap = GetCurrentObject(hDC, OBJ_BITMAP)
If hBitmap = 0 Then
LastDllError = Err.LastDllError
SetPictureBits = -1 ' GetCurrentObject failed
Exit Function
End If

' Debug.Print "hBitmap = " & Hex(hBitmap)

' Get bitmap info, like width and height
If GetObject(hBitmap, Len(bm), bm) = 0 Then
LastDllError = Err.LastDllError
SetPictureBits = -2 ' GetObject failed
Exit Function
End If


' Buffer size to hold pixel data
BufferSize = ((((bm.bmWidth * bm.bmBitsPixel) + 31) And &HFFFFFFE0) _
\ 8) * bm.bmHeight
' We also need to include BITMAPINFO. We choose to include
' it at the beginning.
BufferSize = BufferSize + Len(bi)

' Copy BITMAPINFO from the beginning of the array
CopyMemory bi, bOut(0), Len(bi)
ret = SetDIBits(hDC, hBitmap, 0, bm.bmHeight, bOut(Len(bi)), bi, _
DIB_RGB_COLORS)
If ret = 0 Then
LastDllError = Err.LastDllError
SetPictureBits = -3 ' SetDIBits failed
Exit Function
End If

SetPictureBits = 0 ' Success

ExitSub:
Exit Function
ErrorHandler:
ErrNumber = Err.Number
If ResumeNext Then
Resume Next
Else
LastDllError = Err.LastDllError
SetPictureBits = -4 ' Unknown error
'MsgBox "SetPictureBits: Error " & Err.Number & ": " & _
Err.Description
Resume ExitSub
End If
End Function

Public Sub DebugPrint(ByRef MSG As String)
Debug.Print MSG
OutputDebugString MSG & vbCrLf
End Sub



From: Larry Serflaten on 14 Nov 2009 21:10

"Nobody" <nobody(a)nobody.com> wrote
> "Larry Serflaten" <serflaten(a)usinternet.com> wrote

> Off topic: Please check your system time and time zone. It seems to be one
> hour off.

Interesting. I see nothing wrong here. I am within seconds of www.time.gov
with the appropeate time zone correctly selected.

posted at 21:10 hours
LFS


From: Larry Serflaten on 14 Nov 2009 21:30

"k_zeon" <silvermaine2000(a)googlemail.com> wrote

> Maybe I am just tired but for the life of me cannot think of the best way to
> code for Backwards & Forwards. <<< If anyone can help, pls email me. (tks)

> UserControl11(x).MoviePicture =
> modGDIPlusResize.LoadPictureGDIPlus("C:\Documents and
> Settings\Garry\Desktop\testttt\test2\Largeimage.jpg", 200, 200, , True) '<<
> This is the GDI+ mod call to resize picture


> ScrollingViewPort1.FormatControl '<< this will force the usercontrol to
> arrange my Pictures


From the code you posted it is apparent you are only showing one picture.
Somehow you have to turn that into a list of pictures based on the For/Next
loop iteration. Typically Foward and Back are routines that apply to
the list index value used to denote the first image on the page. Build the
example I posted earlier and check out how TopIndex is used. That
is the value that the scroll bar adjusts, and it is the value used in
UpdateThumbs to indicate where (in the array) to start.

If you're lucky, your ViewPort will expose methods to scroll the list
from code. Check and see....

HTH
LFS


First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4
Prev: Common Controls 5.0 / Windows 7
Next: Dao350.dll unsupported under Windows 7