Anders
En form med CommonDialog (for file open) og et Image1 med stretch = true,
samt command 1. Denne vil åpne GIF, PNG og JPG med den høyde Image1 har, og
endre bredde etter bildets naturlige proporsjoner. Kode for samme bredde,
endre høyde er remarked.
I form-modul:
Private Sub Command1_Click()
Dim bildefil As String
bildefil = CommonDialog1.FileName
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.Filter = "All Files (*.*)" 'endre til GIF + JPG
CommonDialog1.ShowOpen
bildefil = CommonDialog1.FileName
Call HentBilde(Me.Image1, bildefil)
Exit Sub
ErrHandler:
End Sub
I en standard modul:
Option Explicit
Public Type ImageSize
Width As Long
Height As Long
End Type
Sub HentBilde(BildeBoks As Image, fil As String)
Dim bildefil As String
Dim usize As ImageSize
On Error GoTo slutter
If Dir(fil) <> "" Then
usize = GetImageSize(fil)
BildeBoks.Width = BildeBoks.Height * usize.Width / usize.Height
'eller, for samme bredde, varierende høyde:
'BildeBoks.Height = BildeBoks.Width * usize.Height / usize.Width
BildeBoks.Picture = LoadPicture(fil)
BildeBoks.Visible = True
End If
slutter:
End Sub
Function GetImageSize(sFileName As String) As ImageSize
On Error Resume Next
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer
lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()
'PNG file
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'GIF file
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'JPEG file
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
'Debug.print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen
For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
End Function
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function
HTH. Beste hilsen Harald
Ditte og Anders Zuschlag <zuschlag@mail.tele.dk> skrev i
news:3bbb666e$0$218$edfadb0f@dspool01.news.tele.dk...
> Hej
> I en imagekontrol på en formular viser jeg nogle billeder. Hvis
kontrollens
> egenskab "stretch" sættes til true kan alle billeder være i boksen. Til
> gengæld er proportionerne tit forkerte. Sættes egenskaben til false fylder
> nogle billeder mere end skærmen.
> Hvordan fikser jeg det så alle billeder blir inden for rammen af image1,
men
> samtidig bevarer deres proportioner?
> VH AZ
>
>
|