| Вопрос: Уменьшения картинки | Добавлено: 17.03.07 20:46 |
Автор вопроса:  D o c a l | Web-сайт: www.doc-source.pp.net.ua/ | ICQ: 408802757 |
|
Я получаю картинку в pictureboxне нада ее уменшить із 1024*768 до 135*110.Может хто нибудь как ето сделать причем резултат сохранить у файл.
P.S. Сохранять я знаю. |
| Ответы | Всего ответов: 11 |
|
Номер ответа: 1 Автор ответа:  Боцман ICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #1 | Добавлено: 17.03.07 21:15 |
|
По моему, от 4 февраля этого года, заголовок
Picture изменение размеров,рисование,сохранение здесь же на форуме. |
||
|
Номер ответа: 2 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #2 | Добавлено: 17.03.07 21:16 |
| Declare Function StretchBlt Lib "gdi32" Alias "StretchBlt" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long | ||
|
Номер ответа: 3 Автор ответа: D o c a l ICQ: 408802757 Вопросов: 76 Ответов: 985 |
Web-сайт: Профиль | | #3 | Добавлено: 18.03.07 10:59 |
| Спасиба иду пробивать | ||
|
Номер ответа: 4 Автор ответа: D o c a l ICQ: 408802757 Вопросов: 76 Ответов: 985 |
Web-сайт: Профиль | | #4 | Добавлено: 18.03.07 11:07 |
|
Боцман нашел страница
http://vbnet.ru/forum/show.aspx?id=130173 |
||
|
Номер ответа: 5 Автор ответа: AgentFire ICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #5 | Добавлено: 18.03.07 14:34 |
| А со сглаживанием? ) как там GDI+ заюзать-то на шестом? ) | ||
|
Номер ответа: 6 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #6 | Добавлено: 18.03.07 15:22 |
|
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function GetStretchBltMode Lib "gdi32" (ByVal hdc As Long) As Long Const HALFTONE = 4 Public Function AutoSizeFoto()
Dim kF As String kF = Picture1.Width / Picture1.Height 'расчет коэффициента If kF > 1.33 Then ' это коэффициент для обычного стандарта фото Picture2.Width = 600 'здесь нужная максимальная ширина в проекте Picture2.Height = Picture2.Width / kF Else Picture2.Height = 400 'здесь нужная максимальная высота в проекте Picture2.Width = Picture2.Height * kF End If Picture2.Left = 0 Picture2.Top = 0 Dim py As Long 'узнаем величину заголовка формы, 'для этого Form1.ScaleHeight переводим в твипы py = Form1.Height - ScaleX(Form1.ScaleHeight, vbPixels, vbTwips) Dim px As Long ' то же для ширины, определяем размер бордюра px = Form1.Width - ScaleX(Form1.ScaleWidth, vbPixels, vbTwips) 'Задаем размеры формы по полученному рисунку Form1.Width = ScaleX(Picture2.Width, vbPixels, vbTwips) + px Form1.Height = ScaleY(Picture2.Height, vbPixels, vbTwips) + ScaleY(0, vbPixels, vbTwips) + py 'копируем изоражение из Picture1 в Picture2 или точнее рисуем, но сновыми размерами If GetStretchBltMode(Picture2.hdc) <> HALFTONE Then SetStretchBltMode Picture2.hdc, HALFTONE 'Ретушируем End If StretchBlt Picture2.hdc, 0, 0, Picture2.Width, Picture2.Height, Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, SRCCOPY Picture2.Refresh ' "освежаем" рисунок для точного вывода вида, при постоянном открытии новых фото End Function У меня отлично работает, а gdi32.dll идет с ХР сразу. Картинку 2500 х 1500 уменьшал в десять раз, и видимых искажений не видел, меньше делать не пробовал, тогда помню Gif_ми заинтересовался открывал, но не все нормально, некоторые невозможно смотреть, дергаются, на том и закончил тему цели как таковой небыло. |
||
|
Номер ответа: 7 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #7 | Добавлено: 18.03.07 15:57 |
|
Серега! ты ведь ретушь давал, подскажи AgentFire,
а то я NET в глаза невидел. |
||
|
Номер ответа: 8 Автор ответа: D o c a l ICQ: 408802757 Вопросов: 76 Ответов: 985 |
Web-сайт: Профиль | | #8 | Добавлено: 18.03.07 16:25 |
| http://vbnet.ru/forum/show.aspx?id=130173 здесь все есть и как згладить и как... | ||
|
Номер ответа: 9 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #9 | Добавлено: 18.03.07 20:28 |
Боцман, я тоже NET в глаза не видел 
|
||
|
Номер ответа: 10 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #10 | Добавлено: 18.03.07 20:41 |
|
А почему тогда GDI+ спрашивал, ведь это в NET по моему появилось? Я подумал, что он код уже видел по ссылке и нашел в нем нечто от GDI+.
Извини если что. |
||
|
Номер ответа: 11 Автор ответа: GogicВопросов: 38 Ответов: 121 |
Профиль | | #11 | Добавлено: 18.03.07 23:45 |
|
Давно писал
Public Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Public Const IMAGE_BITMAP = 0 Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long Public Const LR_LOADFROMFILE = &H10 Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Sub SaveToJpg1 Lib "c:\windows\system\savtojpg.dll" (ByVal hgd As Long, ByVal FileName As String, _ ByVal Height As Long, ByVal Width As Long) ' Ternary raster operations Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Public Const SRCPAINT = &HEE0086 ' (DWORD) dest = source OR dest Public Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest Public Const SRCINVERT = &H660046 ' (DWORD) dest = source XOR dest Public Const SRCERASE = &H440328 ' (DWORD) dest = source AND (NOT dest ) Public Const NOTSRCCOPY = &H330008 ' (DWORD) dest = (NOT source) Public Const NOTSRCERASE = &H1100A6 ' (DWORD) dest = (NOT src) AND (NOT dest) Public Const MERGECOPY = &HC000CA ' (DWORD) dest = (source AND pattern) Public Const MERGEPAINT = &HBB0226 ' (DWORD) dest = (NOT source) OR dest Public Const PATCOPY = &HF00021 ' (DWORD) dest = pattern Public Const PATPAINT = &HFB0A09 ' (DWORD) dest = DPSnoo Public Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest Public Const DSTINVERT = &H550009 ' (DWORD) dest = (NOT dest) Public Const BLACKNESS = &H42 ' (DWORD) dest = BLACK Public Const WHITENESS = &HFF0062 ' (DWORD) dest = WHITE Sub Convert() lblStatus.Caption = "Processing... Please, wait." Bar01.Max = CInt(lblTotal.Caption) TempPath = App.Path & "\img\000000.bmp" Me.Enabled = False For I = 0 To lstMain.ListCount - 1 Step 1 lstMain.ListIndex = I Bar01.Value = I + 1 Picture2.Picture = LoadPicture(lstMain.Text) SavePicture Picture2.Picture, TempPath ShadowDC = CreateCompatibleDC(Picture1.hdc) TR = LoadImage(0, TempPath, IMAGE_BITMAP, 176, 220, LR_LOADFROMFILE) Gus = SelectObject(ShadowDC, TR) Di = BitBlt(Picture1.hdc, 0, 0, 176, 220, ShadowDC, 0, 0, SRCCOPY) SaveToJpg1 Picture1.hdc, lblOutput.Caption & "\" & txtName.Text & "000" & CStr(I) & ".jpg", 220, 176 If I = lstMain.ListCount - 1 Then Me.Enabled = True lblStatus.Caption = "Complete "
Picture1.Picture = LoadPicture(App.Path & "\NoPict.jpg" 
End If DoEvents Next End Sub Тут правда лишнего много, но разобраться можно. |
||
Страница: 1 |