[решено] Обрезка картинки

[sov44]

kiripanda, условием задачи было определение установленного разрешения экрана и образка краёв картинки до пропорций этого разрешения. Настройка свойств экрана - фоновый рисунок растянут.

[kiripanda]

Del

[Iska]

kiripanda, не то.

1. В приведённом Вами коде изображение обрезается, невзирая на его собственные размеры, до размеров экрана. А надо — а) согласно его собственным размерам и б) пропорционально размерам экрана.

2. Изображение может быть меньше размеров экрана.

[Iska]

kiripanda, зачем «Del»? Статься, кому-нибудь именно Ваш вариант бы и пригодился.

[kiripanda]

@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

[sov44]

kiripanda, попробовал скрипт, ошибка :(
http://savepic.su/1957168m.jpg (http://savepic.su/1957168.htm)
в скрипте изменил только путь к папке sklad

[kiripanda]

попробуй указать полный путь к i_view32.exe

[sov44]

попробуй указать полный путь к i_view32.exe »
аналогичная ошибка.
http://savepic.su/1944904m.jpg (http://savepic.su/1944904.htm)
Пробовал указать полный путь как к директории установки i_view, так и отдельно к папке с батником и копией i_view32.exe

[kiripanda]

in и out если уж брать в кавычки, то
set "in=z:\sklad\"
set "out=c:\windows\Web\Wallpaper\"

[Iska]

kiripanda, новый код так же масштабирует изображения к разрешению экрана вместо простого обрезания краёв сверху или снизу. Также изображения, у которых высота больше ширины, становятся банально квадратными со стороной, равной высоте экрана — т.е. недостаточно урезаются по высоте.

sov44, так мой код заработал у Вас после установки библиотеки?

[sov44]

sov44, так мой код заработал у Вас после установки библиотеки? » да, спасибо, всё работает. Отметил тему решённой. Интересен альтернативный метод в cmd.

[El Sanchez]

kiripanda, попробовал скрипт, ошибка »
sov44, у вас wmic ничего не возвращает. Попробуйте заменить

wmic DesktopMonitor get ScreenHeight^,ScreenWidth /value

на

wmic path Win32_VideoController get CurrentVerticalResolution^,CurrentHorizontalResolution /value

Найти все %ScreenHeight% и %ScreenWidth% и заменить на %CurrentVerticalResolution% и %CurrentHorizontalResolution% соответственно.

[sov44]

Iska, Можно ли поправить Ваш скрипт vbs в посте 6, чтобы рядом создавался бэкап папки Wallpaper, а затем обработка картинок?

[Iska]

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».