Обрезка картинки
Можно ли с помощью bat или сторонних программ обрезать края картинок jpg, расположенных "c:\WINDOWS\Web\Wallpaper\" до пропорций установленного разрешения экрана?
|
Можно. Либо с помощью сторонних программ, либо WSH, либо PoSH.
А зачем?
|
Хочу добавить на установочный диск с задержкой исполнения на пару часов, чтобы после установки винды картинки фона рабочего стола были пропорциональными у пользователей с разными размерами мониторов.
п.с. желательно сделать без помощи сторонних программ. |
sov44, надо понятней изъясняться.
Я понял, что основная проблема в том, что у разных пользователей мониторы с разными форм-факторами. Соответственно, скорее всего, будут и разные пропорции, у одних — 4x3, у других 16:9 и т.п.
И Вы хотите существующие изображения привести к пропорциям установленного у пользователей форм-фактора разрешения, иначе при установке «Расположение: Растянуть» у одних пользователей будет нормально, у других — изображение будет растянуто или ужато. И Вы хотите от этого избавиться. Так?
|
sov44, на основе этого кода сделал такое:
читать дальше »
Код:
Option Explicit
Dim objFSO
Dim objFile
Dim strPath2Wallpapers
Dim strPath2File
Dim objImageFile
Dim objImageProcess
Dim lngScreenHeight
Dim lngScreenWidth
Dim lngDelta
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objImageFile = WScript.CreateObject("WIA.ImageFile")
Set objImageProcess = WScript.CreateObject("WIA.ImageProcess")
strPath2Wallpapers = objFSO.BuildPath(objFSO.GetSpecialFolder(0).Path, "Web\Wallpaper")
With WScript.CreateObject("htmlfile")
With .Script.screen
lngScreenHeight = .Height
lngScreenWidth = .Width
End With
End With
If objFSO.FolderExists(strPath2Wallpapers) Then
For Each objFile In objFSO.GetFolder(strPath2Wallpapers).Files
WScript.Echo objFile.Path
objImageFile.LoadFile objFile.Path
With objImageProcess
.Filters.Add .FilterInfos("Crop").FilterID
With .Filters(1).Properties
If lngScreenHeight / lngScreenWidth > objImageFile.Height / objImageFile.Width Then
' Подрежем справа-слева
lngDelta = (objImageFile.Width - objImageFile.Height * lngScreenWidth / lngScreenHeight) / 2
.Item("Left") = lngDelta
.Item("Right") = lngDelta
ElseIf lngScreenHeight / lngScreenWidth < objImageFile.Height / objImageFile.Width Then
' Подрежем сверху-снизу
lngDelta = (objImageFile.Height - objImageFile.Width * lngScreenHeight / lngScreenWidth) / 2
.Item("Top") = lngDelta
.Item("Bottom") = lngDelta
Else
' Nothing to do
End If
End With
Set objImageFile = .Apply(objImageFile)
.Filters.Remove 1
End With
' Перезаписывать существующий файл компонент не умеет,
' потому предварительно удаляем файл…
strPath2File = objFile.Path
objFile.Delete
' Сохраняем файл под тем же именем:
objImageFile.SaveFile strPath2File
Next
Else
WScript.Echo "Wallpaper's folder [" & strPath2Wallpapers & "] not found"
End If
Set objImageProcess = Nothing
Set objImageFile = Nothing
Set objFSO = Nothing
WScript.Quit 0
Пробуйте.
Код для простоты сделан со следующими ограничениями:
* полагаем, что в папке «%SystemRoot%\Web\Wallpaper» нет иных файлов, кроме как изображений форматов, поддерживаемых библиотекой WIA;
* оригинальные файлы не сохраняются;
* изображения не масштабируются, только равномерно обрезаются до пропорций текущего разрешения экрана (и без учёта места, занимаемого панелью задач) с противоположных сторон.
|
Iska, а с каким расширением сохранять скрипт и в какой кодировке? :dont-know
|
Расширение — «.vbs», кодировка — «Windows-1251», запуск:
Код:
cscript.exe //nologo "<путь к файлу скрипта>"
|
Iska, не получилась обработка картинок.
Для пробы изменил путь к картинкам на
Код:
strPath2Wallpapers = objFSO.BuildPath(objFSO.GetSpecialFolder(0).Path, "Web\Wallpaper1")
и запустил скрипт через командное окно тотала
Код:
cscript.exe //nologo "c:\перевалка\обрезка картинок.vbs"
п.с. можно ли сделать, чтобы скрипт запускался сразу, не прописывая каждый раз путь к нему?
|
Цитата:
Цитата sov44
Iska, не получилась обработка картинок. »
|
А что получилось?
Цитата:
Цитата sov44
п.с. можно ли сделать, чтобы скрипт запускался сразу, не прописывая каждый раз путь к нему? »
|
Поясните Ваш вопрос. |
нечего не получилось. Размеры картинок в папке Wallpaper1 не изменились. |
1. И никаких сообщений, например, о найденных изображениях или об ошибках? Надеюсь, Вы запускали скрипт из командной строки?
2. А размеры точно должны были измениться?
3. Если — да, то приведите пример такого изображения и укажите форм-фактор, к которому должно было быть приведено изображение (изображение выкладывайте в архиве, а не картинкой!).
|
sov44, письмо получил, архив загрузил, файлы изображений опробовал. У меня всё отработало корректно, пропорции Ваших изображений поменялись в соответствии с форм-фактором текущего разрешения.
Попробуйте исполнить скрипт именно в командной строке, как я писал выше, а не из-под Total Commander'а.
|
Iska, пробовал запускать скрипт как с помощью батника, так и на прямую из командной строки как на рабочей системе, так и на виртуальной свежеустановленной оригинальной Windows XP. Увы, во всех случаях одна и та-же ошибка.
|
Nconvert уже советовали? Для батников самое оно.
|
Foreigner, думаю, будет не очень удобно вычислять конечные размеры, прежде всего из-за наличия только целочисленной арифметики.
|
Iska
не вижу проблемы, кол-во пикселей же целое число
|
kiripanda, а отношение ширины к высоте и наоборот?
|
kiripanda, условием задачи было определение установленного разрешения экрана и образка краёв картинки до пропорций этого разрешения. Настройка свойств экрана - фоновый рисунок растянут.
|
kiripanda, не то.
1. В приведённом Вами коде изображение обрезается, невзирая на его собственные размеры, до размеров экрана. А надо — а) согласно его собственным размерам и б) пропорционально размерам экрана.
2. Изображение может быть меньше размеров экрана.
|
kiripanda, зачем «Del»? Статься, кому-нибудь именно Ваш вариант бы и пригодился.
|
Код:
@echo off &setlocal enabledelayedexpansion
set in=z:\sklad\
set out=c:\windows\Web\Wallpaper\
set i_view=i_view32.exe
for /f %%s in ('wmic DesktopMonitor get ScreenHeight^,ScreenWidth /value ^|find "="') do set "%%s"
for /f "delims=" %%f in ('dir /b/a-d/s %in%\*.jpg') do (
title "%%f"
%i_view% "%%f" /info=%temp%\info.tmp
for /f "tokens=4,6" %%x in ('type %temp%\info.tmp ^|find "Image dimensions"') do (
set /a newx=%%x*%ScreenHeight%/%%y &set /a newy=%%y*%ScreenWidth%/%%x
if "!newy!" GEQ "%ScreenHeight%" %i_view% "%%f" /resize_long=%ScreenWidth% /aspectratio /resample /convert=temp.bmp
if "!newx!" GEQ "%ScreenWidth%" %i_view% "%%f" /resize_short=%ScreenHeight% /aspectratio /resample /convert=temp.bmp
%i_view% %in%\temp.bmp /info=%temp%\info.tmp
for /f "tokens=4,6" %%x in ('type %temp%\info.tmp ^|find "Image dimensions"') do (
if "%%y" GTR "%ScreenHeight%" (
set /a starty=^(%%y-%ScreenHeight%^)/2
%i_view% %in%\temp.bmp /crop=^(0,!starty!,%ScreenWidth%,%ScreenHeight%^) /jpgq=90 /convert=%out%\%%~nf.jpg
)
if "%%x" GEQ "%ScreenWidth%" (
set /a startx=^(%%x-%ScreenWidth%^)/2
%i_view% %in%\temp.bmp /crop=^(!startx!,0,%ScreenWidth%,%ScreenHeight%^) /jpgq=90 /convert=%out%\%%~nf.jpg
)
)
)
)
del /q %temp%\info.tmp %in%\temp.bmp
|
kiripanda, попробовал скрипт, ошибка :(
|
попробуй указать полный путь к i_view32.exe
|
Цитата:
Цитата kiripanda
попробуй указать полный путь к i_view32.exe »
|
аналогичная ошибка.
читать дальше »
Пробовал указать полный путь как к директории установки i_view, так и отдельно к папке с батником и копией i_view32.exe
|
in и out если уж брать в кавычки, то
set "in=z:\sklad\"
set "out=c:\windows\Web\Wallpaper\"
|
kiripanda, новый код так же масштабирует изображения к разрешению экрана вместо простого обрезания краёв сверху или снизу. Также изображения, у которых высота больше ширины, становятся банально квадратными со стороной, равной высоте экрана — т.е. недостаточно урезаются по высоте.
sov44, так мой код заработал у Вас после установки библиотеки?
|
Цитата:
Цитата Iska
sov44, так мой код заработал у Вас после установки библиотеки? »
|
да, спасибо, всё работает. Отметил тему решённой. Интересен альтернативный метод в cmd. |
| El Sanchez |
11-05-2012 12:05 1913926 |
Цитата:
Цитата sov44
kiripanda, попробовал скрипт, ошибка »
|
sov44, у вас wmic ничего не возвращает. Попробуйте заменить
Код:
wmic DesktopMonitor get ScreenHeight^,ScreenWidth /value
на
Код:
wmic path Win32_VideoController get CurrentVerticalResolution^,CurrentHorizontalResolution /value
Найти все %ScreenHeight% и %ScreenWidth% и заменить на %CurrentVerticalResolution% и %CurrentHorizontalResolution% соответственно. |
Iska, Можно ли поправить Ваш скрипт vbs в посте 6, чтобы рядом создавался бэкап папки Wallpaper, а затем обработка картинок?
|
sov44, пробуйте:
читать дальше »
Код:
Option Explicit
Dim objFSO
Dim objFile
Dim strPath2Wallpapers
Dim strPath2File
Dim objImageFile
Dim objImageProcess
Dim lngScreenHeight
Dim lngScreenWidth
Dim lngDelta
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objImageFile = WScript.CreateObject("WIA.ImageFile")
Set objImageProcess = WScript.CreateObject("WIA.ImageProcess")
strPath2Wallpapers = objFSO.BuildPath(objFSO.GetSpecialFolder(0).Path, "Web\Wallpaper")
With WScript.CreateObject("htmlfile")
With .Script.screen
lngScreenHeight = .Height
lngScreenWidth = .Width
End With
End With
If objFSO.FolderExists(strPath2Wallpapers) Then
With objFSO.GetFolder(strPath2Wallpapers)
' Создадим копию папки %SystemRoot%\Web\Wallpaper
.Copy objFSO.BuildPath(objFSO.GetSpecialFolder(0).Path, "Web\Wallpaper.bak"), True
For Each objFile In .Files
WScript.Echo objFile.Path
objImageFile.LoadFile objFile.Path
With objImageProcess
.Filters.Add .FilterInfos("Crop").FilterID
With .Filters(1).Properties
If lngScreenHeight / lngScreenWidth > objImageFile.Height / objImageFile.Width Then
' Подрежем справа-слева
lngDelta = (objImageFile.Width - objImageFile.Height * lngScreenWidth / lngScreenHeight) / 2
.Item("Left") = lngDelta
.Item("Right") = lngDelta
ElseIf lngScreenHeight / lngScreenWidth < objImageFile.Height / objImageFile.Width Then
' Подрежем сверху-снизу
lngDelta = (objImageFile.Height - objImageFile.Width * lngScreenHeight / lngScreenWidth) / 2
.Item("Top") = lngDelta
.Item("Bottom") = lngDelta
Else
' Nothing to do
End If
End With
Set objImageFile = .Apply(objImageFile)
.Filters.Remove 1
End With
' Перезаписывать существующий файл компонент не умеет,
' потому предварительно удаляем файл…
strPath2File = objFile.Path
objFile.Delete
' Сохраняем файл под тем же именем:
objImageFile.SaveFile strPath2File
Next
End With
Else
WScript.Echo "Wallpaper's folder [" & strPath2Wallpapers & "] not found"
End If
Set objImageProcess = Nothing
Set objImageFile = Nothing
Set objFSO = Nothing
WScript.Quit 0
Копия папки получит имя «Wallpaper.bak».
|
Время: 05:44.
© OSzone.net 2001-
