#!perl -w
use Win32::OLE::Const 'Adobe Photoshop';
use strict;
my $app = Win32::OLE->GetActiveObject('Photoshop.Application') || Win32::OLE->new('Photoshop.Application')
or die "Cannot find Photoshop";
# 初期の設定値を保存する
my @old_param;
$old_param[0] = $app->preferences->{RulerUnits};
$old_param[1] = $app->preferences->{TypeUnits};
$old_param[2] = $app->{DisplayDialogs};
# 設定値を書き換える
$app->preferences->{RulerUnits} = 1; # psPixels
$app->preferences->{TypeUnits} = 1; # psTypePixels
$app->{DisplayDialogs} = 3; # psDisplayNoDialogs
# 所望の処理
#
#
# 設定値を元に戻す
$app->preferences->{RulerUnits} = $old_param[0];
$app->preferences->{TypeUnits} = $old_param[1];
$app->{DisplayDialogs} = $old_param[2];
package TlPs;
use Win32::OLE::Const 'Adobe Photoshop';
use strict;
sub initialize{
my $app = shift @_;
my $param = shift @_;
$$app = Win32::OLE->GetActiveObject('Photoshop.Application') || Win32::OLE->new('Photoshop.Application')
or die "Cannot find Photoshop";
$$param[0] = $$app->preferences->{RulerUnits};
$$param[1] = $$app->preferences->{TypeUnits};
$$param[2] = $$app->{DisplayDialogs};
$$app->preferences->{RulerUnits} = 1; # psPixels
$$app->preferences->{TypeUnits} = 1; # psTypePixels
$$app->{DisplayDialogs} = 2; # psDisplayNoDialogs
}
sub finalize{
my $app = shift @_;
my $param = shift @_;
$$app->preferences->{RulerUnits} = $$param[0];
$$app->preferences->{TypeUnits} = $$param[1];
$$app->{DisplayDialogs} = $$param[2];
}
1;
#/////////////////////////////////////////////////////////////////
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param); # 初期の設定値を保存してから、書き換える
# 所望の処理
print "$app->{Version}\n";
&TlPs::finalize(\$app, \@old_param); # 設定値を元に戻す
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param); # 初期の設定値を保存してから、書き換える
#===================================================
#新規ドキュメントを作成する
#Function Add([Width], [Height], [Resolution], [Name], [Mode], [InitialFill], [PixelAspectRatio]) As Document
# a document
#---------------------------------------------------
my $doc1 = $app->Documents->Add();
my $doc2 = $app->Documents->Add(256, 256, 72, "DOC003");
#---------------------------------------------------
print "$doc1->{Name}\n";
print "$doc2->{Name}\n";
&TlPs::finalize(\$app, \@old_param); # 設定値を元に戻す
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#ドキュメントを開く
#Sub Load(Document As String)
# load a support document
#---------------------------------------------------
$app->Load("e:\\Documents\\211784.jpg");
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#Property Count As Long
# readonly
# number of elements in the collection
#---------------------------------------------------
my $count = $app->Documents->{Count};
#---------------------------------------------------
print "$count\n";
&TlPs::finalize(\$app, \@old_param);
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
$app->Documents->Add;
$app->Documents->{Count} or die;
#===================================================
#アクティブ・ドキュメントにアクセス
#Property ActiveDocument As Document
# the frontmost document
#---------------------------------------------------
my $doc = $app->ActiveDocument;
#---------------------------------------------------
print "name : $doc->{Name}\n";
print "size : $doc->{Width} X $doc->{Height}\n";
&TlPs::finalize(\$app, \@old_param);
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
$app->Documents->Add();
#===================================================
#ドキュメントを列挙する
#Property Item(ItemKey) As Document
# readonly
# get an element from the collection
#---------------------------------------------------
for(1..$app->Documents->{Count}){
my $doc = $app->Documents->Item($_);
print "$_: $doc->{Name}\n";
}
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
#!perl -w require 'TlPs.pm'; use strict; my $app; my @old_param; &TlPs::initialize(\$app, \@old_param); my $doc = $app->ActiveDocument or die; #=================================================== #ドキュメントのインデックスを取得する #Function Index(ItemPtr As Document) As Long #--------------------------------------------------- my $index = $app->Documents->Index($doc); #--------------------------------------------------- print "document index: $index\n"; &TlPs::finalize(\$app, \@old_param);
#!perl -w require 'TlPs.pm'; use strict; my $app; my @old_param; &TlPs::initialize(\$app, \@old_param); my $doc = $app->ActiveDocument or die; #=================================================== #ドキュメントを閉じる #Sub Close([Saving]) # close the document #--------------------------------------------------- $doc->Close(); #--------------------------------------------------- &TlPs::finalize(\$app, \@old_param);
Close の引数
Const psSaveChanges = 1
Const psDoNotSaveChanges = 2
Const psPromptToSaveChanges = 3
デフォールトは psPromptToSaveChanges のようだ。
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
my $doc = $app->ActiveDocument or die;
#===================================================
#名前を付けて保存する
#Sub SaveAs(SaveIn As String, [Options], [AsCopy], [ExtensionType])
# save the document with specific save options
#---------------------------------------------------
$doc->SaveAs("f:\\save1"); #[Options]を省略するとPSDで保存されるようだ
my $option = Win32::OLE->new('Photoshop.JPEGSaveOptions');
$doc->SaveAs("f:\\save2", $option); #JPEGで保存
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
第2引数 Options は多分
BMPSaveOptions
EPSSaveOptions
GIFSaveOptions
JPEGSaveOptions
PDFSaveOptions
PICTFileSaveOptions
PNGSaveOptions
PhotoshopSaveOptions
PixarSaveOptions
RawSaveOptions
SGIRGBSaveOptions
TargaSaveOptions
TiffSaveOptions
注 (Jun. 9, 2009)
この方法だと、ドキュメントがレイヤーを持っていたり、インデックス・カラーの場合まずいことが分かった。例えば JPEG で保存する場合には SaveAs の前に
$doc->Flatten();
$doc->ChangeMode(psConvertToRGB);
を挿入すれば解決する。
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
my $doc = $app->ActiveDocument or die;
#===================================================
#アクションを使用する
#Sub DoAction(Action As String, From As String)
# play an action from the Actions Palette
#---------------------------------------------------
$app->DoAction('アクション 1', 'セット 1');
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
これは利用価値が高そうだ。
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#JavaScript を実行する
#Function DoJavaScriptFile(JavaScriptFile As String, [Arguments], [ExecutionMode]) As String
# execute javascript file
#---------------------------------------------------
$app->DoJavaScriptFile("f:\\myscript.jsx");
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
//myscript.jsx
alert("my test script");
アクショクと併用するといろいろできそう。
#!perl -w
use strict;
require 'TlPs.pm';
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#JavaScript を実行する
#Function DoJavaScriptFile(JavaScriptFile As String, [Arguments], [ExecutionMode]) As String
# execute javascript file
#---------------------------------------------------
my @param = ("Data : ", 200, 100);
$app->DoJavaScriptFile("f:\\myscript.jsx", \@param);
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
// myscript.jsx
if(arguments.length == 0){
alert("引数なし");
}else{
var str = "引数\n";
for(var j = 0; j < arguments.length; ++j){
str += arguments[j] + " ";
}
alert(str);
}
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#JavaScript コードを実行する
#Function DoJavaScript(JavaScriptCode As String, [Arguments], [ExecutionMode]) As String
# execute JavaScript code
#---------------------------------------------------
$app->DoJavaScript("alert('My message')");
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
使い物にならないような気がする。
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
foreach(keys %$app){
print "$_ : $app->{$_}\n";
}
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
結果 ColorSettings : Japan General Purpose 2 ActiveDocument : Win32::OLE=HASH(0x19b07c8) Name : Adobe Photoshop Path : C:\Program Files\Adobe\Adobe Photoshop CS2\ Preferences : Win32::OLE=HASH(0x19b07ec) ScriptingVersion : 9.0.0 FreeMemory : 243705235 Version : 9.0.0 Visible : 1 DisplayDialogs : 2 ForegroundColor : Win32::OLE=HASH(0x19b0828) BackgroundColor : Win32::OLE=HASH(0x19b07f8) PlaybackParameters : Win32::OLE=HASH(0x19b0834) PlaybackDisplayDialogs : 2 NotifiersEnabled : 0 WindowsFileTypes : ARRAY(0x19b07bc) MacintoshFileTypes : ARRAY(0x19b0894) PreferencesFolder : C:\Documents and Settings\tail\Application Data\Adobe\Photoshop\9.0\Adobe Photoshop CS2 Settings\ Locale : ja_JP Documents : Win32::OLE=HASH(0x19b090c) Fonts : Win32::OLE=HASH(0x19b08b8) Notifiers : Win32::OLE=HASH(0x19b0918) Application : Win32::OLE=HASH(0x19b08e8)
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#描画色または背景色を変更する
#Property ForegroundColor As _SolidColor
#Property BackgroundColor As _SolidColor
#---------------------------------------------------
$app->ForegroundColor->RGB->{Green} = 128;
$app->BackgroundColor->RGB->{Green} = 80;
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
#===================================================
#描画色と背景色を交換する
#Property ForegroundColor As _SolidColor
#Property BackgroundColor As _SolidColor
#---------------------------------------------------
my $color = $app->{ForegroundColor};
$app->{ForegroundColor} = $app->{BackgroundColor};
$app->{BackgroundColor} = $color;
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
#!perl -w require 'TlPs.pm'; use strict; my $app; my @old_param; &TlPs::initialize(\$app, \@old_param); my $doc = $app->ActiveDocument or die; #=================================================== $doc->Flatten(); #--------------------------------------------------- &TlPs::finalize(\$app, \@old_param);
#!perl -w require 'TlPs.pm'; use strict; my $app; my @old_param; &TlPs::initialize(\$app, \@old_param); my $doc = $app->ActiveDocument or die; #=================================================== $doc->ChangeMode(psConvertToRGB); #--------------------------------------------------- &TlPs::finalize(\$app, \@old_param); ChangeMode の第一引数は psConvertToBitmap psConvertToCMYK psConvertToGrayscale psConvertToIndexedColor psConvertToLab psConvertToMultiChannel psConvertToRGB
#!perl -w
require 'TlPs.pm';
use strict;
my $app;
my @old_param;
&TlPs::initialize(\$app, \@old_param);
my $doc = $app->ActiveDocument or die;
#===================================================
my $width = 200;
my $height = 150;
my $resolution = $doc->{Resolution};
$doc->ResizeImage(int($width), int($height), $resolution, psBilinear);
#---------------------------------------------------
&TlPs::finalize(\$app, \@old_param);
ResizeImage の第4引数で再サンプリング方法を指定する
psBicubic
psBicubicSharper
psBicubicSmoother
psBilinear
psNearestNeighbor
psNoResampling