VBNet - Форум - Размер Picture

Вопрос: Размер Picture Добавлено: 09.12.07 21:04

Автор вопроса: Боцман | Web-сайт: Rus-Skipper.narod.ru | ICQ: 295725312

Приятного всем времени суток!!!!!
Всем привет!!!!!!!!!!!!!!
У меня вопрос как избежать это?

Option Explicit
Private Type picInfo
    Rashirenie As String
    Width As Long
    Height As Long
End Type

Private Function razmerPicture(TheFile) As picInfo
    Dim Rashirenie, IstinaRazmer As picInfo, WseFile
    WseFile = FreeFile
    Open TheFile For Binary As WseFile
        Rashirenie = Input(10, WseFile)
    Close WseFile
    If Mid(Rashirenie, 7, 4) = "JFIF" Then
        IstinaRazmer.Rashirenie = "JPG"
        Open TheFile For Binary As WseFile
            Rashirenie = Input(167, WseFile)
        Close WseFile
        IstinaRazmer.Height = Asc(Mid(Rashirenie, 165, 1)) + 256 * Asc(Mid(Rashirenie, 164, 1))
        IstinaRazmer.Width = Asc(Mid(Rashirenie, 167, 1)) + 256 * Asc(Mid(Rashirenie, 166, 1))
    End If
    If Mid(Rashirenie, 1, 3) = "GIF" Then
        IstinaRazmer.Rashirenie = "GIF"
        IstinaRazmer.Width = Asc(Mid(Rashirenie, 7, 1)) + 256 * Asc(Mid(Rashirenie, 8, 1))
        IstinaRazmer.Height = Asc(Mid(Rashirenie, 9, 1)) + 256 * Asc(Mid(Rashirenie, 10, 1))
    End If
    razmerPicture = IstinaRazmer
End Function
Private Sub Form_Load()
Form1.OLEDropMode = 1
Form1.Width = 8000
Form1.Caption = "Тащи рисунок на меня"
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MyFile As String, MyPath As String, MyName As String
If Data.GetFormat(vbCFFiles) = True Then
Dim c As Long
For c = 1 To Data.Files.Count
MyPath = Data.Files(c)
Next c
End If
On Error GoTo Cancel

MyName = Dir(MyPath, vbNormal)
If MyName = vbNullString Then
Exit Sub
Else
Form1.Picture = LoadPicture(MyPath)
    Dim a As picInfo
           a = razmerPicture(MyPath)
                Me.Caption = a.Rashirenie & "   a.Width=  " & a.Width & "   a.Height=  " & a.Height
End If
Cancel:
Exit Sub
End Sub

попробуйте свои картинки, как же браузеры это лечат?
Типа 'Image1.Stretch = True с считыванием разиеров не интересует.
За добавление и других форматов заранее благодарен!
Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #1	Добавлено: 10.12.07 01:31
	ээээээ Предлагаю сделать чуть проще Option Explicit Private Type picInfo Rashirenie As String Width As Long Height As Long End Type Private Sub Form_Load() Form1.OLEDropMode = 1 Form1.Width = 8000 Form1.Caption = "Тащи рисунок на меня" End Sub Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Dim sFilename As String, a As picInfo On Error GoTo Cancel: If Data.GetFormat(vbCFFiles) = True Then sFilename = Data.Files(Data.Files.Count) If Dir(sFilename, vbNormal) = vbNullString Then Exit Sub Else Exit Sub End If Form1.Picture = LoadPicture(sFilename) a.Rashirenie = UCase(Mid(sFilename, InStrRev(sFilename, "." + 1)) a.Height = ScaleY(Picture.Height, vbHimetric, vbPixels) a.Width = ScaleX(Picture.Width, vbHimetric, vbPixels) Caption = a.Rashirenie & " a.Width = " & a.Width & " a.Height = " & a.Height Cancel: End Sub Ответить

Номер ответа: 2 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #2	Добавлено: 10.12.07 01:33
	Помню очень долго мучился этим самым вопросом: как узнать размер изображения Ответить

Номер ответа: 3 Автор ответа: Боцман ICQ: 295725312 Вопросов: 53 Ответов: 830	Web-сайт: Rus-Skipper.narod.ru Профиль \| \| #3	Добавлено: 10.12.07 02:40
	Winand ГРОМАДНОЕ СПАСИБО! Ты отмучился и за меня! Был бы рейтинг ответов, то поставил бы + 5 Ответить

Номер ответа: 4 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #4	Добавлено: 10.12.07 08:59
	Dim pic As IPictureDisp Set pic = LoadPicture(MyPath) Debug.Print ScaleX(pic.Width, vbHimetric, vbPixels) & " x " & ScaleY(pic.Height, vbHimetric, vbPixels) 'API Dim bmp As BITMAP Call GetObject(pic.Handle, LenB(bmp), bmp) Debug.Print bmp.bmWidth & " x " & bmp.bmHeight Ответить

Страница: 1 |