画像を減色して保存する際の重要な注意(Hyper-Paint チュートリアル 使い方 講座)
Hyper-Paintで画像を減色して保存した画像をIEなどで表示した場合に正しく表示されない場合があります。
詳しく説明すると例えば背景が青い画像を減色してPNG保存してIEなどで表示すると下図のように背景が赤ぽくなってしまう場合があります。
原因はIEとGLDPNGのパレットが若干違う仕様になっているからです、これはPNG読み込みに使っているGLDPNGのバグなのかIEのバクなのかは判然としませんが(IEのパレットが反対になっているのでIEのバグと言えるようだ)、パレットの1番目の赤と青が反対になっている為に起こります。
これには困りましたが仕方なく下図の保存ウインドウの○印の所に小さなボタンを取り付けました。もし上記のようにIEで表示した時に色が変わってしまう場合には○印のボタンを押し下げて保存して下さい、パレットの一番目の赤と青を入れ替えますのでIEで正常に表示されるようになります。但しその画像はHyper-Paintで表示すると色が変わってしまいますが。この現象はBMPやGIFで保存する際には起こりません。
IEで表示した場合に下図のような色に表示された場合に
○印のボタンを押し下げて保存するとパレットの1番目の赤と青が入れ替わり下図のように表示される。
追伸
Hyper-Paint ver.118B以降GLDPNGのソ−スを変更して上記の現象が起きないように修整しました。
つまり BMP、GIF、PNGに関わらず減色する時1番目のパレットの赤と青を入れ替えています、BMPとGIFはこうして保存するとIEや他のソフトで正常に表示されます、PNGは更に保存の際にGLDPNGで1番目のパレットの赤と青を入れ替えています、こうするとPNGの保存の際は減色してからパレットを入れ替えていないのと同じです、こうしてPNGをIEで表示すると正常ですがGLDPNGで読み込むと色がおかしくなりますので読み込みの際にGLDPNGで1番目のパレットの赤と青を入れ替えています、こうすると正常に表示されます、だいぶややこしい話なので混乱しないように。
IEにこのようなバグがあってもこのことはどこでも聞いたことがないのが不思議だがかなり長期間に渡ってしまうと他のソフトがこのバグが出ないように対応してしまっていると今更IEを正常に修正するわけにもいかないのだろう。もし正常になるよう修正するとバグに対応した全てのソフトもまたそれに合わせなければならずとんでもない混乱を引き起こすことになるわけで、そういうわけで今更バグ取りもできないというわけだ。
またこのようなバグは通常の作成では起こりにくいものでどういうわけで起こったのか興味津々でもある、まさかIEのその部分の作成者が何かしらのイタズラでこのようにしたのか?どんな人が行ったのか興味がつきない。
GLDPNGStream.pas
procedure TGLDPNGWriteStream.WritePLTE;
・
・
・
try
len:=GetPaletteColorTable(Palette,PGLDPalRGB(ps));
if len>0 then
begin
for i:=0 to Pred(len) do
begin
if i=0 then
begin
PArrayByte(pd)^[i*3+0]:=PArrayRGB(ps)^[i].rgbBlue; //ここで赤に青を入れる
PArrayByte(pd)^[i*3+1]:=PArrayRGB(ps)^[i].rgbGreen;
PArrayByte(pd)^[i*3+2]:=PArrayRGB(ps)^[i].rgbRed; //ここで青に赤を入れる
end
else
begin
PArrayByte(pd)^[i*3+0]:=PArrayRGB(ps)^[i].rgbRed;
PArrayByte(pd)^[i*3+1]:=PArrayRGB(ps)^[i].rgbGreen;
PArrayByte(pd)^[i*3+2]:=PArrayRGB(ps)^[i].rgbBlue;
end;
end;
WriteChunk(PLTE,pd,len*sizeof(TPNGRGB));
end;
finally
FreeMem(ps);
FreeMem(pd);
end;
・
・
・
procedure TGLDPNGReadStream.ReadPalette;
・
・
・
// RGBデータ読み込み
if len>0 then
for i:=0 to Pred(len) do
begin
ReadByte(@paldat,sizeof(paldat));
with PArrayRGB(ColorTBLBuf)^[i]
do
begin
if i=0 then
begin
rgbRed:=paldat.B; //ここで赤に青を入れる
rgbGreen:=paldat.G;
rgbBlue:=paldat.R; //ここで青に赤を入れる
end
else
begin
rgbRed:=paldat.R;
rgbGreen:=paldat.G;
rgbBlue:=paldat.B;
end;
end;
end;
Dec(FChunkSize,len*sizeof(paldat));
PaletteSize:=len;
FChunkFlag:=FChunkFlag+[pcPLTE];
// コールバック
DoCallBack(0);
・
・
・
GLDPngのCopyRight表記
ネストしたフォルダを一度に作成する
通常webにはソ−スを載せないつもりでいますがこれを使いたい人のために一つ上げておきます、この手続きにパスを渡すともしそのパスが存在しない場合にフォルダを作成してくれます、しかも例えば c:\test1\test2\test3\test4\test5 を渡すと
c: に test1 のフォルダを作り test1の下にtest2を作り test2の下にtest3を作り test3の下にtest4を作り test4の下にtest5を作りを作ってくれます、途中まで例えばtest3までフォルダが存在してもかまいません。通常Delphiの
MkDir 手続きはこういうことを行ってくれません、但し一応フォルダのネストは9個までとなっています。While文を使えばもっとスッキリするでしょうけど一応使えるしめんどくさいので誰かやって下さい。
procedure make_dir(dir:string);
label ttt;
var
i,i1,i2,i3,i4,i5,i6,i7,i8,i9:integer;
sss,s1,s2,s3,s4,s5,s6,s6_1,s6_2,s6_3,s6_4,s6_5,s6_6,s6_7,s6_8,s6_9:string;
searchrecx:TSearchrec;
begin
sss:=GetCurrentDir;
s6_1:='';
for i1:=1 to length(dir) do
begin
s6_1:=s6_1+' ';
s6_1[i1]:=dir[i1];
if i1=length(dir) then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_1);
goto ttt;
end;
if (comparetext(dir[i1],'\')=0) and (i1>3)
then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_1);
chDir(s6_1);
s6_2:='';
for i2:=i1+1 to length(dir) do
begin
s6_2:=s6_2+' ';
s6_2[i2-i1]:=dir[i2];
if i2=length(dir) then
begin
s6:='';
for i:=1 to length(s6_2)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_2[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_2);
goto ttt;
end;
if comparetext(dir[i2],'\')=0 then
begin
s6:='';
for i:=1 to length(s6_2)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_2[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_2);
chDir(s6_2);
s6_3:='';
for i3:=i2+1 to length(dir) do
begin
s6_3:=s6_3+' ';
s6_3[i3-i2]:=dir[i3];
if i3=length(dir) then
begin
s6:='';
for i:=1 to length(s6_3)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_3[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_3);
goto ttt;
end;
if comparetext(dir[i3],'\')=0
then
begin
s6:='';
for i:=1 to length(s6_3)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_3[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_3);
chDir(s6_3);
s6_4:='';
for i4:=i3+1 to length(dir)
do
begin
s6_4:=s6_4+' ';
s6_4[i4-i3]:=dir[i4];
if i4=length(dir) then
begin
s6:='';
for i:=1 to length(s6_4)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_4[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_4);
goto ttt;
end;
if comparetext(dir[i4],'\')=0
then
begin
s6:='';
for i:=1 to length(s6_4)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_4[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_4);
chDir(s6_4);
s6_5:='';
for i5:=i4+1 to length(dir)
do
begin
s6_5:=s6_5+' ';
s6_5[i5-i4]:=dir[i5];
if i5=length(dir) then
begin
s6:='';
for i:=1 to length(s6_5)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_5[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_5);
goto ttt;
end;
if comparetext(dir[i5],'\')=0
then
begin
s6:='';
for i:=1 to length(s6_5)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_5[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_5);
chDir(s6_5);
s6_6:='';
for i6:=i5+1 to length(dir)
do
begin
s6_6:=s6_6+' ';
s6_6[i6-i5]:=dir[i6];
if i6=length(dir)
then
begin
s6:='';
for i:=1 to length(s6_6)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_6[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_6);
goto ttt;
end;
if comparetext(dir[i6],'\')=0
then
begin
s6:='';
for i:=1 to length(s6_6)-1
do
begin
s6:=s6+' ';
s6[i]:=s6_6[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_6);
chDir(s6_6);
s6_7:='';
for i7:=i6+1 to
length(dir) do
begin
s6_7:=s6_7+'
';
s6_7[i7-i6]:=dir[i7];
if i7=length(dir)
then
begin
s6:='';
for i:=1 to
length(s6_7)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_7[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_7);
goto ttt;
end;
if comparetext(dir[i7],'\')=0
then
begin
s6:='';
for i:=1 to
length(s6_7)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_7[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_7);
chDir(s6_7);
s6_8:='';
for i8:=i7+1
to length(dir) do
begin
s6_8:=s6_8+'
';
s6_8[i8-i7]:=dir[i8];
if i8=length(dir)
then
begin
s6:='';
for i:=1
to length(s6_8)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_8[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_8);
goto ttt;
end;
if comparetext(dir[i8],'\')=0
then
begin
s6:='';
for i:=1
to length(s6_8)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_8[i];
end;
if (findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_8);
chDir(s6_8);
s6_9:='';
for i9:=i8+1
to length(dir) do
begin
s6_9:=s6_9+'
';
s6_9[i9-i8]:=dir[i9];
if i9=length(dir)
then
begin
s6:='';
for
i:=1 to length(s6_9)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_9[i];
end;
if
(findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_9);
goto
ttt;
end;
if comparetext(dir[i9],'\')=0
then
begin
s6:='';
for
i:=1 to length(s6_9)-1 do
begin
s6:=s6+'
';
s6[i]:=s6_9[i];
end;
if
(findfirst(s6,fadirectory,SearchRecx)<>0)
then mkdir(s6_9);
MessageDlg(s6_9+'以上の深いネストのフォルダは作成できません!',mtwarning,[mbOK],0);
chDir(sss);
exit;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
ttt:
chDir(sss);
end;
再帰を使った場合
フォルダネストが深くなると再帰する回数がおおくなりその分スタックが消費されるが通常この場合100回や200回再帰されたとしてもスタックオ−バ−フロウにはならないだろうし現実問題200回以上フォルダがネストされるようなことは無いと考えて問題はない。
procedure make_dir(dir:string);
var
i,i1:integer;
s6,s6_1,sss:string;
searchrecx:TSearchrec;
begin
s6_1:='';
for i1:=1 to length(dir) do
begin
s6_1:=s6_1+' ';
s6_1[i1]:=dir[i1];
if i1=length(dir) then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if DirectoryExists(s6)=false then mkdir(s6_1);
exit;
end;
if (comparetext(dir[i1],'\')=0) and
(i1>3) then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if DirectoryExists(s6)=false then mkdir(s6_1);
make_dir(s6_1);
end;
end;
end;
上の再帰のものはフォルダのネストが14とか17とかになると遅くなるし経験上FileExists手続きがLanなどで接続した他のパソコンに対しては確か機能しないことからお仲間のDirectoryExistsやForceDirectoriesも機能しない可能性があるので(確かめていないが)これらを解決すると下記のようになるのではないだろうか。
procedure make_dir(dir:string);
var
i,i1:integer;
s6,s6_1,sss:string;
searchrecx:TSearchrec;
begin
s6_1:='';
for i1:=1 to length(dir) do
begin
s6_1:=s6_1+' ';
s6_1[i1]:=dir[i1];
if i1=length(dir) then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if dir_nest>12 then
begin
if (findfirst(s6,fadirectory,SearchRecx)<>0) then ForceDirectories(dir);
end
else if (findfirst(s6,fadirectory,SearchRecx)<>0) then mkdir(s6_1);
exit;
end;
if ((comparetext(dir[i1],'\')=0) or (comparetext(dir[i1],'/')=0)) and (i1>3) then
begin
s6:='';
for i:=1 to length(s6_1)-1 do
begin
s6:=s6+' ';
s6[i]:=s6_1[i];
end;
if ((findfirst(s6,fadirectory,SearchRecx)<>0) and (comparetext(dir[i1],'\')=0)) or ((directoryExists(s6)=true) and (comparetext(dir[i1],'/')=0)) then
begin
if dir_nest>12 then
begin
ForceDirectories(dir);
exit;
end
else
begin
if (comparetext(dir[i1],'/')=0) then ForceDirectories(s6_1)
else mkdir(s6_1);
end;
end;
inc(dir_nest);
make_dir(s6_1);
end;
end;
end;
Home
