Unicodeファイル名に対応したTGIFImage。
Delphi 6でGIFファイルを読み込んだり書き込んだりする場合Finn Tolderlund - Delphi programmingでダウンロードできるTGIFImageを使うのが一番良いようです。
けれどもこのTGIFImageはUnicodeなファイル名のファイルを読み込んだり書き込んだりできません。
書き込みに関してはUnicodeな文字が代替文字に変わったファイル名で保存することは出来ますが(Queensrÿche.gifがQueensryche.gifになるなど)WideStringからAnsiStringへ変換後にUnicodeな文字が「?」になるハングルなどは「?」がファイル名に使えない文字であるのでそのままではエラーになってしまいます。
読み込みに関してはUnicode非対応のコンポーネントにファイルを渡すでやったようにUnicodeなファイル名を短いファイル名に変換してしまうやり方もありますがもっとましなやり方で。
Unicode対応のTBitmapでやったようにUnicode対応のTFileStreamを利用して、TGIFImageを継承したクラスを作成します。
interface
uses
Classes,
Jpeg,
SysUtils,
Windows;
type
//Unicode対応TFileStream
TMyFileStream = class(THandleStream)
public
constructor Create(
FileName : WideString;
AccessMode : DWORD = GENERIC_READ;
ShareMode : DWORD = FILE_SHARE_READ or FILE_SHARE_WRITE
);
destructor Destroy; override;
end;
type
//Unicode対応TGIFImage
TMyGIFImage = class(TGIFImage)
public
procedure LoadFromFile(const Filename : WideString); reintroduce;
procedure SaveToFile (const Filename : WideString); reintroduce;
end;
implementation
//------------------------------------------------------------------------------
{ TMyFileStream }
//Unicode対応TFileStream
constructor TMyFileStream.Create(
FileName : WideString;
AccessMode : DWORD = GENERIC_READ;
ShareMode : DWORD = FILE_SHARE_READ or FILE_SHARE_WRITE
);
var
li_CreateMode: DWORD;
begin
if ((AccessMode and GENERIC_WRITE) <> 0) then begin
li_CreateMode := OPEN_ALWAYS;
end else begin
li_CreateMode := OPEN_EXISTING;
end;
inherited Create(CreateFileW(
PWidechar(FileName), //ファイル名
AccessMode,
//アクセスモード
ShareMode,
//共有モード
nil, //セキュリティ
li_CreateMode, //作成方法
FILE_ATTRIBUTE_NORMAL, //ファイル属性
0
//テンプレート
));
end;
destructor TMyFileStream.Destroy;
begin
if (FHandle >= 0) then begin
CloseHandle(FHandle);
end;
inherited Destroy;
end;
//------------------------------------------------------------------------------
{ TMyGIFImage }
//Unicode対応TGIFImage
procedure TMyGIFImage.LoadFromFile(const Filename : WideString);
//Unicode対応の読み込み。
var
l_Stream : TStream;
begin
l_Stream := TMyFileStream.Create(Filename);
try
LoadFromStream(l_Stream);
finally
l_Stream.Free;
end;
end;
procedure TMyGIFImage.SaveToFile(const Filename : WideString);
//Unicode対応の書き込み。
var
l_Stream : TStream;
begin
l_Stream := TMyFileStream.Create(Filename, GENERIC_WRITE);
try
SaveToStream(l_Stream);
finally
l_Stream.Free;
end;
end;
TMyFileStreamはTFileStreamと引数の指定の仕方が違います。
それはTFileStreamと同じ指定の仕方だと実装がややこしくなるので実装が簡単なやり方にしているためです。
AccessModeとShareModeはCreateFile APIの指定そのままです。
AccessModeには読み込みか書き込みかあるいはその両方かをGENERIC_READとGENERIC_WRITEの組み合わせで指定します。
ShareModeには共有するモードをFILE_SHARE_READとFILE_SHARE_WRITEの組み合わせで指定します。
あとはこのUnicode対応のTMyFileStreamを介してファイルとのやり取りをするだけでOKです。
使用例
const
F_sFileName =
WideString(WideChar($00C4)) //Ä
+ WideString(WideChar($00D5)) //Õ
+ WideString(WideChar($00DC)) //Ü
;
procedure TForm1.Button1Click(Sender: TObject);
var
l_GIFImage : TMyGIFImage;
begin
l_GIFImage := TMyGIFImage.Create;
try
l_GIFImage.LoadFromFile(F_sFileName + '.gif');
Image1.Picture.Assign(l_GIFImage);
finally
l_GIFImage.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
//黒を透明色にした透過GIFで保存のサンプル
var
l_GIFImage : TMyGIFImage;
l_Bitmap : TBitmap;
begin
l_GIFImage := TMyGIFImage.Create;
try
l_Bitmap := TBitmap.Create;
try
l_Bitmap.Assign(Image1.Picture);
l_Bitmap.Transparent := True;
l_Bitmap.TransparentColor := clBlack;
//
l_GIFImage.ColorReduction := rmQuantize; //
l_GIFImage.Assign(l_Bitmap);
l_GIFImage.SaveToFile(F_sFileName + '_save.gif');
finally
l_Bitmap.Free;
end;
finally
l_GIFImage.Free;
end;
end;
適当にUnicodeな名前(この例では「ÄÕÜ.gif」)のビットマップファイルを用意します。
Button1をクリックすると用意した「ÄÕÜ.gif」を読み込んでImage1に表示します。
Button2をクリックするとImage1に表示している画像を「ÄÕÜ_save.gif」として保存します。
2011-03-17: