Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(7)

TImageListの中身をファイルに保存したり戻したりすることについて。

今まであまり使ったことのないTImageListに苦しんでいる日々ですけど何か。
ちょっと雰囲気が見えてきたのでこのままTImageListを使ってどうにかしたいと思います。で、操作のナチュラルさも含めてうまく行ったとして、少なくともメールのアイコンを保存したくなります。
そうなると最低1つのアイコンというか画像を保存したらいいんですけど、どうせTImageListにキープしてるんだから、TImageList.SaveToFile的なものはないのかと探してみました。
ま、ないんですけど。代わりに似たような感じの、TImageList.WriteDataとTImageList.ReadDataというのが見つかりました。使えそうな感じなので、
procedure TForm1.Button3Click(Sender: TObject);
var
LMemBuf: TMemoryStream;
begin
LMemBuf := TMemoryStream.Create;
ImageList1.WriteData(LMemBuf);
LMemBuf.SaveToFile(ChangeFileExt(ParamStr(0), '.dat'));
LMemBuf.LoadFromFile(ChangeFileExt(ParamStr(0), '.dat'));
ImageList1.ReadData(LMemBuf);
LMemBuf.Free;
end;

とやってみたんですが、うまく行きません。なんとなく

procedure TForm1.Button3Click(Sender: TObject);
var
LMemBuf: TMemoryStream;
begin
LMemBuf := TMemoryStream.Create;
ImageList1.WriteData(LMemBuf);
LMemBuf.SaveToFile(ChangeFileExt(ParamStr(0), '.dat'));
LMemBuf.LoadFromFile(ChangeFileExt(ParamStr(0), '.dat'));
LMemBuf.Position := 0; //コレ
ImageList1.ReadData(LMemBuf);
LMemBuf.Free;
end;

を足してみたら書き出しと読み込みまではできたように見えます。なのに...

前回、TImageListに格納したあとで取り出した画像と格納する前の同じ画像を比較したら違っちゃってる問題が発覚しました。
今回も似た感じで、WriteData/ReadDataする前と後でなんとなく違ってるような感じがします。

ちょっと調べて見ることにします。

と、その前に、Googleにも聞いてみました。結果、今回の目的には合わなかったんですけどせっかくなので。
ImageList - LoadFromFile / SaveToFile - wie geht das?:[2012/10/10] ドイツ語で読めません。
テクニック(Tips)集: ImageList のアイコンを保存 -
Borland C++Builder(BCB) サンプル解説
:[2012/10/10] 1個ずつじゃぁ嫌です。

というわけで、自分を信じて進んでみます。

こんなのを作ってみました。


見たまま? (作った本人には)です。
1. 通知領域の画像を取得
2. ImageList1に格納
3. ImageList1からファイルに書き出して読み込み直してImageList2に格納
4. ImageList1の格納画像とImageList2の格納画像を比較してみる
というテストです。
要点は、WriteDate/ReadDataをしてデータが変質するか、です。

結果的にはしていないようです。最初にちょびっと試したときはなんかダメっぽかったのにイケてるようです。

ソースコードはコレ。ウィンドウハンドルから画像を取得するところ(再掲)、TImageListの画像を一括でファイルに書き出し読み込みするところ、が役に立つかも。

// ex) LWnd := TraceWindow(0, 'Shell_TrayWnd,TrayNotifyWnd,SysPager');
function TraceWindow(const aWnd: HWND; const CsNames: string): HWND;
var
LBuf: TStringList;
LName: string;
begin
Result := aWnd;
LBuf := TStringList.Create;
try
LBuf.CommaText := Trim(CsNames);
while (LBuf.Count > 0) do
begin
LName := LBuf[0];
LBuf.Delete(0);
Result := FindWindowEx(Result, 0, PChar(LName), nil);
end;
finally
FreeAndNil(LBuf);
end;
end;

procedure GetImageFromHandle(const WH: HWND; Bmp: Graphics.TBitmap);
var
LCanvas: TCanvas;
LWI: TWindowInfo;
LRect: TRect;
begin
LCanvas := TCanvas.Create;
LCanvas.Handle := GetWindowDC(WH);
try
if GetWindowInfo(WH, LWI) then
begin
LRect := LWI.rcWindow;
OffsetRect(LRect, -LRect.Left, -LRect.Top);
Bmp.Width := LRect.Right - LRect.Left;
Bmp.Height := LRect.Bottom - LRect.Top;
Bmp.Canvas.CopyRect(LRect, LCanvas, LRect);
end;
finally
ReleaseDC(WH, LCanvas.Handle);
FreeAndNil(LCanvas);
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
LWnd: HWND;
LRect: TRect;
LCount: integer;
i: integer;
LPath: String;
LMemBuf: TMemoryStream;
begin
LWnd := TraceWindow(0, 'Shell_TrayWnd,TrayNotifyWnd,SysPager,ToolbarWindow32');
StatusBar1.SimpleText := SysErrorMessageUTF8(GetLastError());
if (LWnd <> 0) then
begin
//***
GetImageFromHandle(LWnd, Image1.Picture.Bitmap);

//***
ImageList1.Clear();
ImageList1.Height := Image1.Picture.Bitmap.Height;
ImageList1.Width := 24;

Image2.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height;
Image2.Picture.Bitmap.Width := 24;
Image2.AutoSize := True;
LRect := Image2.ClientRect;

LCount := (Image1.Picture.Bitmap.Width - 6) div 24;
OffsetRect(LRect, 3, 0);

for i := 1 to LCount do
begin
Image2.Picture.Bitmap.Canvas.CopyRect(
Image2.ClientRect, Image1.Picture.Bitmap.Canvas, LRect
);
ImageList1.Add(Image2.Picture.Bitmap, nil);
OffsetRect(LRect, 24, 0);
end;

//***
HeaderControl1.Sections.Clear();
for i := 0 to ImageList1.Count - 1 do
HeaderControl1.Sections.Add.ImageIndex := i;
HeaderControl1.Images := ImageList1;
HeaderControl1.Repaint;

//***
LPath := ChangeFileExt(ParamStr(0), '.dat');
LMemBuf := TMemoryStream.Create;
try
ImageList1.WriteData(LMemBuf);
LMemBuf.SaveToFile(ChangeFileExt(ParamStr(0), '.dat'));
LMemBuf.Clear;
LMemBuf.LoadFromFile(ChangeFileExt(ParamStr(0), '.dat'));
LMemBuf.Position := 0;
ImageList2.ReadData(LMemBuf);
finally
FreeAndNil(LMemBuf);
end;

//***
HeaderControl2.Sections.Clear();
for i := 0 to ImageList2.Count - 1 do
HeaderControl2.Sections.Add.ImageIndex := i;
HeaderControl2.Images := ImageList2;
HeaderControl2.Repaint;
end;
end;

procedure TForm1.HeaderControl1SectionClick(HeaderControl: TCustomHeaderControl;
Section: THeaderSection);
begin
ImageList1.GetBitmap(Section.ImageIndex, Image3.Picture.Bitmap);
if Image3.Picture.Bitmap.RawImage.IsEqual(Image4.Picture.Bitmap.RawImage) then
Label1.Caption := '='
else
Label1.Caption := '<>';
end;

procedure TForm1.HeaderControl2SectionClick(
HeaderControl: TCustomHeaderControl; Section: THeaderSection);
begin
ImageList2.GetBitmap(Section.ImageIndex, Image4.Picture.Bitmap);
if Image3.Picture.Bitmap.RawImage.IsEqual(Image4.Picture.Bitmap.RawImage) then
Label1.Caption := '='
else
Label1.Caption := '<>';
end;


ここまでできたらひょっとして後は作るだけなのかも。一番めんどくさいところに手を付ける時期が来たようです。面白くなさそうな気がしてきました。

続く。
関連記事
スポンサーサイト