Страница: 1 |
Вопрос: Размер Picture | Добавлено: 09.12.07 21:04 |
Автор вопроса: ![]() |
Приятного всем времени суток!!!!!
Всем привет!!!!!!!!!!!!!! У меня вопрос как избежать это? 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 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #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, "." ![]() 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 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 10.12.07 01:33 |
Помню очень долго мучился этим самым вопросом: как узнать размер изображения |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 10.12.07 02:40 |
Winand ГРОМАДНОЕ СПАСИБО!
Ты отмучился и за меня! Был бы рейтинг ответов, то поставил бы + 5 |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 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 |
|