解像度を変更したJpegをクリップボードから貼り付けるには？
解決// GetAPP0_Offset 過去ログより引用
function GetAPP0_Offset(Ms: TMemoryStream): Integer;
var
p1, p2: PByte;
begin
result := -1;
p1 := Ms.Memory;
while (Integer(p1) - Integer(Ms.Memory)) < Ms.Size do
begin
if p1^=$FF then
begin
p2:=p1;
Inc(p2);
if p2^=$E0 then
begin
result := Integer(p1) - Integer(Ms.Memory);
exit;
end;
end;
Inc(p1);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
Jpg: TJpegImage;
Ms: TMemoryStream;
APPO_Offset: Integer;
Units, Hidpi, Lodpi: Byte;
dpi: WORD;
ExcelFile, ExcelSheet: String;
MyFormat: Word;
AData: THandle;
APalette: HPALETTE;
begin
Jpg := TJpegImage.Create;
try
Bmp := TBitmap.Create;
Ms := TMemoryStream.Create;
try
Bmp.Width := 2955;
Bmp.Height := 1622;
SetStretchBltMode(Bmp.Canvas.Handle, HALFTONE);
StretchBlt(Bmp.Canvas.Handle, 219, 0, 2736, 1622,
Image1.Canvas.Handle, 0, 0, Image1.Picture.Width, Image1.Picture.Height, SRCCOPY);
Jpg.Assign(Bmp);
Jpg.SaveToStream(Ms);
APPO_Offset := GetAPP0_Offset(Ms);
Ms.Position := APPO_Offset +2 +9;
Units := 1;
Ms.Write(Units, 1);
// 解像度を300に設定
dpi := 300;
Hidpi := HiByte(dpi);
Lodpi := LoByte(dpi);
Ms.Write(Hidpi, 1);
Ms.Write(Lodpi, 1);
Ms.Write(Hidpi, 1);
Ms.Write(Lodpi, 1);
Ms.Position:=0;
Jpg.LoadFromStream(Ms);
finally
Bmp.Free;
Ms.Free;
end;
ExcelFile := 'C:\Test.xls';
ExcelSheet := 'Test';
try
ExcelApplication1.Connect;
ExcelApplication1.Visible[0] := True;
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Open
(ExcelFile, null, null, null, null, null,
null, null, null, null, null, null, null, null, null, 0));
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[ExcelSheet] as _Worksheet);
try
// SaveToClipboardFormatではBitmap形式になり解像度が72dpiに戻る
Jpg.SaveToClipboardFormat(MyFormat, AData, APalette);
ClipBoard.SetAsHandle(MyFormat, AData);
// SaveToFileでは300dpiで出力できる
Jpg.SaveToFile('d:\test.jpg');
ExcelWorksheet1.Range['A1','A1'].Select;
// クリップボードからシートに画像貼り付け
ExcelWorksheet1.Paste;
except
ExcelWorksheet1.Range['A1','A1'].Select;
end;
ExcelWorkbook1.SaveAs('c:\Test2.xls', Null, Null, Null, Null, Null,
xlNoChange, Null, Null, Null, Null, Null, 0);
finally
ExcelApplication1.Disconnect;
end;
finally
Jpg.Free;
end;
end;
上記ソースで、Image1に表示された画像を拡大し、解像度を300に変更したJpegを
ExcelのSheetにクリップボード経由で貼り付けたいと思っています。
クリップボードを経由しなくてもいいんですが、それしか思いつきませんでした。
そこで、TJpegImage の SaveToClipboardFormat を使って見たんですが、
Bitmapに戻ってしまい、解像度も72dpiに戻ってしまいます。
SaveToFile を使うと300dpiのJpegで保存出来るので、SaveToClipboardFormat
を使っては無理なんだと勝手に思っています。
なにか良い方法はないでしょうか？
よろしくお願いします。
環境は、Delphi7 + Excel2003 です。
拡大縮小 と dpiの変更 との間には直接の関係はないんじゃないですか？？？私はそう思っていましたが。
過去ログでもjokさんは
＞これは出力デバイスというかソフトへの指示になりますので画像そのものには変化ありません。
と書いていますし・・・
とおりすがりさん
こんにちは。
確かに拡大縮小とdpi変更との間には直接関係はないと思います。
その部分は特に問題はないのですが、欲しい結果は「300dpiの画像をExcelの
シートに貼り付ける」という事なのです。
同じサイズの画像の72dpiの物と、300dpiの物をExcelに貼り付けると、
当然300dpiの物の方が小さく表示されてしまいます。
それを防ぐために拡大しているわけです。
Excel上で300dpiの画像をコピーすると、貼り付けた画像も300dpiなので、
結局の所クリップボードの使い方の問題なんじゃなかと思っています。
EXCELで 挿入->図->ファイルから で挿入すると確かにdpiによって大きさが変わりますね・・知らなかった。
しかしこれはクリップボードとは何の関係もないわけで・・
「挿入->図->ファイルから」の操作をクリップボード経由の貼り付けでやろうとしたってできません。（と思います）
クリップボード上にjpegデータとして存在するわけじゃあないでしょうし。
挿入->図->ファイルから で挿入するとdpiによって大きさが変わります。
印刷時も高画質で印刷できます。
Excel上でその挿入した画像をコピーすると、クリップボード経由でも解像度を保持したまま貼り付け出来るので、出来ない事はないと思うんですが、どうなんでしょう？
ちなみにExcel上でコピーした画像は、Jpegデータかどうかは調べていなんで分かりませんが、Jpegとして保持されると思います。（違うかも・・・）
Jpeg や Gif や Png や メタファイルとして変換して貼り付ける事も出来ます。
まぁクリップボードにこだわる事もないんですが、それ以外にExcelにデータ渡す方法が分からないんですよね・・・
やりたいことをEXCELマクロで記録してそれを試行錯誤したら大抵動きますよ。
私のBDS2006ProではDelphiプロジェクトだと何故だかofficeコンポーネントが無い（！）ので、試せませんが、
挿入->図->ファイルから のマクロの中身は
ActiveSheet.Pictures.Insert ("適当ファイル72DPI.jpg")
でした。
上の記述に即するなら、
ExcelWorksheet1.Pictures.Insert ('適当ファイル72DPI.jpg');
てな感じでしょうか・・・（試せませんが）
これで試行錯誤してみてください（無責任）
dpiを変更してセーブし、そのファイルを上述の方法でインサートすればできませんか？
とおりすがりさん
上記方法は私も考えましたが、Pictures は使えるのですが、Insertメソッドが使えません・・・というかありません・・・
バージョンの問題なのかもしれませんね。
もう少し試行錯誤してみます。
ありがとうございました。
> Jpegとして保持されると思います。
Windows は SDK レベルで Jpeg を認識しません。ビットマップになると思います。
うんとさん
なるほど。
という事は、クリップボード上ではビットマップとして持つことしか出来ないと言う事ですね。
なるほど。なるほど。
まぁビットマップではまずいですが、Jpegでなくてもいいので 300dpi さえ確保出来ればいいんですけどね。
_Worksheet.PasteSpecial メソッド っていうのを見つけたんで、これでなんとか出来ないかなと考え中です。
PasteSpecial では無理ですね・・・
実は解像度なんてものを変更せずとも、挿入した画像のスケールを変更するだけでよいと思う。
でもまあ、今までの流れに沿ってやってみました。
ちなみに私のBDS2006ProではOfficeコンポが無い（何故かな・・？）ので ComObjでやります。
実は便乗？質問したいです。
私のBDS2006ProのDelphiプロジェクトではOfficeコンポが無いんですけど、どうすれば・・？
※Uses に comobj を追加すること
procedure TForm1.Button1Click(Sender: TObject);
var
E_Excel : Variant;
E_Application : Variant;
E_WorkBook : Variant;
E_WorkSheet : Variant;
begin
// Excel をオープン
try
E_Excel := CreateOleObject('Excel.Application');
E_Application := E_Excel.Application;
except
on EOleSysError do begin
//起動失敗
ShowMessage('Excelが起動できません');
E_Excel := Null;
Exit;
end;
end;
E_Application.Visible := True;
E_Application.WorkBooks.Open( ExtractFilePath(Application.ExeName) + 'MyData.xls');
E_WorkBook := E_Application.ActiveWorkbook;
E_WorkSheet := E_Application.ActiveSheet;
// セルA1に画像を挿入
E_Application.Range['A1:A1'].Select;
E_WorkSheet.Pictures.Insert('c:\自宅72DPI.jpg').select;
//ここで画像を自由に伸縮（水平垂直半分）
E_WorkSheet.Pictures[1].ShapeRange.ScaleWidth(0.5,0,0);
E_WorkSheet.Pictures[1].ShapeRange.ScaleHeight(0.5,0,0);
E_Excel := unAssigned;
E_WorkBook := Unassigned;
E_WorkSheet := Unassigned;
end;
参考
https://www.petitmonte.com/bbs/answers?question_id=3651
var
Xlsheet: Variant;
Jpg.SaveToFile('c:\test.jpg');
Xlsheet := ExcelWorkbook1.ActiveSheet;
Xlsheet.Pictures.Insert('c:\test.jpg');
TExcelWorksheetでは、Insertメソッドをサポートしていないようで、
上記のようにする事で解決いたしました。
ちょっとタイトルとは主旨がが違ってしまいましたが、自己解決しました。
ありがとうございました。
とおりすがりさん
わざわざソースありがとうございます。
結局のところ ComObj 使った方が良いようですね。
Officeコンポはイマイチのようで・・・ｗ
使い方がイマイチなのかなぁ〜ｗ
解決押すの忘れてました（爆）
とおりすがりさん
BDS2006ProのOfficeコンポの件ですけど、私はBDS持っていないのでなんとも言えないのですが、下のリンクを見る限りでは、インストール時にC++用かDelphi用のどちらかしか選べないのではないかと思います。
参考になるかどうか・・・
http://homepage2.nifty.com/Mr_XRAY/Delphi/CompoInstall/BDS2006Install.htm
ありがとうございます。
そういえばそんなダイアログが出ていました。もう1年前になるのですっかり失念していました。
| ツイート |  |