rinboka.csc

警告
　このスクリプトは未完成です。Graphics MLの話題にするためにアップしました。
　塗りつぶし透明による輪郭のぼかしを実行するものですが、スクリプト実行後改めてインタラクティブ透明ツールでパターンの選択をしなおす必要があります。また、この処理を施したファイルを保存終了しようとするとかなり高い確率で「予期しないエラー」が発生します。おそらく許されないパラメータを渡しているせいだと思いますが、まだ原因が判っていません。
　試用に当たっては十分注意してください。

---

'塗りつぶし透明による輪郭のぼかし
'Graphics ML 黒住さん紹介の方法を実行
'Script by Albatross
'Ver. 0.01 2000/11/18

'includeファイルのフォルダが異なる場合は以下の文を有効にしてパスを記入すること。
'#addfol  ".\scripts"
#include "ScpConst.csi"
#include "DrwConst.csi"

dim oid as long
dim wp as string
dim wf1 as string, wf2 as string
wp = GETTEMPFOLDER ( )
wf1=wp+"$wf1.cpt"
wf2=wp+"$wf2.cpt"

'helpではcptは1799だけど...
const fid&=1808
const res&=300
const of&=30

dim xp as long, yp as long,xs as long, ys as long

WITHOBJECT  OBJECT_DRAW
    if .isselection()=false then
        message "オブジェクトが選択されていません"
        stop
    endif
    .SuppressPainting TRUE
    oid =.GetObjectsCDRStaticID()
    .GetSize xs, ys
    .ApplyUniformFillColor 
    .FileExport wf1, fid&, lengthconvert(7,1,xs)*res&, lengthconvert(7,1,ys)*res&, res&, res&, 2, 0, TRUE, FALSE
END WITHOBJECT

WITHOBJECT OBJECT_PHOTOPAINT
    .FileOpen wf1, 0, 0, 0, 0, 0, 1, 1
    .ObjectCreateFromBackground 
    .ColorMaskCreateMask 0, 1, 0, 0, FALSE, 127, 0
        .ColorMaskColor 0, 9, 0, 0, 0, 0, 20, 20, 20, 20
        .EndColorMask 
    .MaskInvert 
    .EditClear 9, 255, 0, 0, 0
    .MaskRemove
    .ObjectFeather of&, 0
        .EndObject 
    .MaskCreate TRUE, 0
        .EndMaskCreate 
    .EditCopyToFile wf2, fid&, 0
    .filesave wf1, fid&, 0
    .Fileclose
    .FileOpen wf2, 0, 0, 0, 0, 0, 1, 1
    .ObjectSelectAll 
    .ObjectMerge TRUE
        .EndObject 
    .ImageInvert 
        .EndColorEffect 
    .FileSave wf2, fid&, 0
    .Fileclose
END WITHOBJECT

'ここからはまだおかしい
WITHOBJECT  OBJECT_DRAW
    .ApplyTwoColorBitmapLens wf2, xs, ys, 0, 0, TRUE, 0, TRUE, FALSE, 0, 0, 0, 100, 0, FALSE
    .ApplyTextureBitmapLens "a", wf2,"a" , xs, ys, 0, 0, TRUE, 0, true, 0, 0, 0, 100,0, false
'    .ApplyTextureBitmapLens "@･ｮ" + CHR(2) + "<", "9" + CHR(2), CHR(9), xs, ys, 0, 0, TRUE, 0, FALSE, 0, 0, 0, 100, 0, FALSE
'    .ApplyOutline 0, 0, 0, 0, 0, 0, 0, 0, 0, FALSE, 0, 33810, FALSE
    .ResumePainting 
END WITHOBJECT

---

＜＜戻る