SilverVox
|
 Posted: Tue Sep 23, 2014 01:53 Post subject: |
 |
|
Я недавно решал аналогичную проблему для себя, ну вот поделюсь и своим решением.
Правда я по специальности художник, и в программировании дилетант полный, раньше писал только батники и то по мере крайней надобности. На VBS, это практически мой первый скрипт, не учитывая разных там "Привет Мир", поэтому попрошу знающих людей жестоко не критиковать мою работу, а по возможности соизволить помочь исправить разные там неприятные глазу проблемы компоновки и оптимизации кода. Потому-что я практически не знаю синтаксиса и все это я сваял исключительно подсматривая в примеры других скриптов. Но несмотря на мою недалекость, у меня все работает более года, вот недавно только (после обнаружения данной темы) внес кое-какие актуальные исправления, прежде чем выложить.
| Code: |
'==========================================================
'VBS
'Имя Файла: ChangeSizeThumbnails.vbs
'Автор: SilverVox
'Версия: 1.1
'Дата: 17.09.2014
'
'Производит изменение размеров эскизов для TotalCommander.
'Размер передается в параметрах командной строки.
'Для работы нужен WSH Helper for TC by Volniy
'
'Параметры вызова:
' {Ширина} {Высота}
'==========================================================
Option Explicit
Dim TCS, Width, Height, MaxValue, ThumbsLocation
Set TCS = CreateObject("TCSCRIPT.Helper")
TCS.Pause = 100
TCS.Wait = True
TCS.LockTC True
MaxValue = 560 'Максимально допустимое значение размеров (Можно изменять на свое усмотрение)
If not TCS.IsRunningTC Then
MsgBox "Процесс TotalCmd.exe не найден.", vbCritical + vbOKOnly, "Ошибка!"
Quit(1)
End If
If WScript.Arguments.Count < 2 Then
MsgBox "Неверное количество параметров.", vbCritical + vbOKOnly, "Ошибка параметров командной строки!"
Quit(2)
End If
Width = CorrectedValue(WScript.Arguments(0))
Height = CorrectedValue(WScript.Arguments(1))
TCS.GetINIFiles
ThumbsLocation = TCS.INIRead(TCS.MainINI, "Configuration", "ThumbsLocation")
If ThumbsLocation = "" Then
TCS.SendCommand 482
TCS.SendKeystroke "{TAB 8}" & Width & "{TAB}" & Height & "{ENTER}"
Else
If Right(ThumbsLocation, 1) = "\" Then ThumbsLocation = Mid(ThumbsLocation, 1, Eval(Len(ThumbsLocation)-1))
With CreateObject("Scripting.FileSystemObject")
If SplitChkValue(.GetFileName(ThumbsLocation)) Then
ThumbsLocation = .GetParentFolderName(ThumbsLocation)
End if
End With
If Right(ThumbsLocation, 1) <> "\" Then ThumbsLocation = ThumbsLocation & "\"
ThumbsLocation = ThumbsLocation & Width & "X" & Height
ThumbsLocation = Replace(ThumbsLocation, "%", "{%}")
TCS.SendCommand 482
TCS.SendKeystroke "{TAB}{BS}" & ThumbsLocation & "{TAB 7}" & Width & "{TAB}" & Height & "{ENTER}"
End If
Quit(0)
'===== СубПроцедуры =============================================================
Function SplitChkValue(Value)
Dim SbStr, Num
SplitChkValue = True
Num = 0
For Each SbStr In Split(Value, "X")
Num = Eval(Num+1)
If Not ChkValue(SbStr) Then SplitChkValue = False
Next
If Num <> 2 Then SplitChkValue = False
End Function
Function ChkValue(Value)
Dim N
ChkValue = False
If IsNumeric(Value) Then
If Trim(Value) = Value Then
Value = CCur(Value)
For N = 1 To Eval(MaxValue/8)
If Value = Eval(N*8) Then
ChkValue = True
End If
Next
End If
End If
End Function
Function CorrectedValue(Value)
Dim N, PrvN
If IsNumeric(Value) Then
Value = Int(Value)
If Value < 8 Then
MsgBox "Значения параметров выходят за границы допустимой области.", vbCritical + vbOKOnly, "Ошибка параметров командной строки!"
Quit(3)
End If
If Value > MaxValue Then
MsgBox "Значения параметров выходят за границы допустимой области.", vbCritical + vbOKOnly, "Ошибка параметров командной строки!"
Quit(4)
End If
PrvN = 0
For N = 1 To Eval(MaxValue/8)
If Value < Eval(N*8) Then
If Value > Eval(PrvN*8) Then
If Eval(N - PrvN) < 4 Then Value = Eval(PrvN*8)
If Eval(N - PrvN) > 4 Then Value = Eval(N*8)
End If
End If
PrvN = N
Next
Else
MsgBox "Нечисловые значения в параметрах.", vbCritical + vbOKOnly, "Ошибка параметров командной строки!"
Quit(5)
End If
CorrectedValue = Value
End Function
Sub Quit(Errorlevel)
Set TCS = Nothing
WScript.Quit Errorlevel
End Sub |
Использование:
ChangeSizeThumbnails.vbs {Ширина} {Высота}
Описание:
Посредством командной строки можно указывать любые размеры (в разумных пределах). Если используется кэширование, то в каталоге по заданному пути создаются папки с именами используемых размеров (по типу: "128x128"), что снижает вероятность конфликтных ситуаций несоответствия указываемых в настройках размеров с размерами уже существующей базы эскизов. Ну и вроде все в общем.
Пример кнопки:
| Code: |
TOTALCMD#BAR#DATA
ChangeSizeThumbnails.vbs
128 128
WCMICONS.dll,26
128x128
%commander_path%\System\
0
-1
|
_________________
Если струну не дотянуть – она не будет звучать.
Если перетянуть – она лопнет. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
