2019/01/23
ファイルの上書き保存モードが無かったので追加しました。
マルチTiffファイルの作成と編集
複数ページのTiffファイルの作成と、ページの追加、削除、取り出しを行うプログラムです。
GDI+のTiffファイルの機能を利用します。
色々な資料の保存に、古いWindowsのコダックのImagingを使用していましたが無くなってしまいました。
32ビットのXPや７の場合、著作権の問題はありましたが、Windows2000のインストールCDを利用してインストールして使用することも可能でした。
しかし、最近ではプログラムが使用するメモリーの容量も多くなり、64ビットのOSを使用するのが一般的となりコダックのImagingは使用できなくなりました。
フリーのソフトで、MultiTiffの扱えるのもあるのですが、画像の編集をすることは殆ど無く、単にファイルの編集だけなので、自作することにしてみました。
フリーソフトでは、IrfanViewがあります、インターネット検索すれば、ダウンロードサイトが直ぐに見つかるでしょう。
自作と言っても、基本的には、Delphi
Library [Mr.XRAY] の 02_GDI+ を使用したマルチページ TIFF 画像の作成と表示
を元にして作成をしました。
ページの編集時、追加削除挿入を簡単に行うため、メモリーストリームを使用するように変更しています。
マルチTiffのイメージに対して単に追加する場合は、追加保存だけでよいのですが、挿入、削除の場合は、前のTiffeを新しいTiffイメージに１ページ目から保存し指定のページになったら挿入の場合は、新しい画像を追加後、最後のページまで保存し、削除の場合は指定のページはスキップして最後のページまで保存することで、挿入削除を行います。
編集は、メモリーストリームを使用し、HDは使用しないので、高速に行えます。
最近のＰＣはメモリーが大量に載っているので問題ないでしょう。
スキャナーからの画像が取り込めると便利なので、TWAIN機器からの画像取り込みも追加してみました。
TWAIN用のプログラムは、インターネットで"DelphiTwain"で検索と出てくるKluug.net Software Solutions
からダウンロードしました。
プログラムは、MakeTiffボタンで編集の開始をします。
このボタンをクリックすると、次のダイアログが開きます。
新規を選ぶと、新しいTiffファイルの作成です、この場合は、最初 AddFileボタンでも画像の追加をします。
追加するものは、ファイルからでもよいし、スキャナーからでも追加が出来ます。
Tiffファイルを選んだ場合は、元々あるTiffファイルのページ編集です、１ページしか無いものでも、マルチページのTiffファイルでも可能です。
AddFileボタンは、最後のページとして追加されます。
Insertボタンは指定されたページの前にページが挿入されます。
マルチTiffファイルを追加、或いは挿入すると、マルチTiffファイルのページ分 新しいページとして追加されます。
追加、挿入の画像ファイルの形式は、GDI+で扱える画像形式なら何でも良いのですが、Gif形式のファイルは、動画の場合、画像が複数あるのですが、最初の画像しか使用されません。
Deleteボタンは指定されたページの削除です、１ページしか無い場合は、単にボタンの設定と、画像の消去、新規であるフラグ再設定を行います。
マルチページの一部のページが必要な場合は、表示中の画像をファイルとして保存するボタンも設定してありますが、プログラムは、Tiffファイルのみです。
GDI+を使用しているので、GDI+ファイル変換プログラムを参照して追加すれば、色々な形式での保存が追加できるようになります。
何処かのページの画像の編集が必要な場合は、一度編集の必要なページを保存して、そのファイルを画像編集ソフトで編集後、元のページに挿入、元のページを削除すれば良い事になります。
今まで、マルチTiffファイルの画像の編集は行ったことが無いので、不必要かと思います。
FileOpenボタンは、単にマルチTiffファイルの表示をするためのものです。
Windowsには、標準で
マルチTiffファイルの表示が出来るソフトが組み込まれているので、本来必要ないのですが、参考の為に組み込んでみました。
Twain用のユニットは、プロジェクトの保存ホルダーと同じホルダーに保存しておけばOKです。
違うホルダーに入れた場合は、ツールオプションの設定でライブラリィパスを通す必要があります。
プログラム
//----------------------------------------------------------------------
// DelphiTwain download http://www.kluug.net/delphitwain.php
//----------------------------------------------------------------------
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
System.UITypes, Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, Vcl.ExtDlgs,
Vcl.Buttons, Vcl.ComCtrls, DelphiTwain, DelphiTwain_Vcl, Vcl.Imaging.pngimage;
type
TForm1 = class(TForm)
OpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
ScrollBox1: TScrollBox;
Image1: TImage;
Edit1: TEdit;
Label1: TLabel;
DownBtn: TButton;
UpBtn: TButton;
MakeTiffBtn: TButton;
AddFileBtn: TButton;
SaveFileBtn: TButton;
CancelBtn: TButton;
Edit2: TEdit;
Label2: TLabel;
DeleteBtn: TButton;
Edit3: TEdit;
Label3: TLabel;
InsertBtn: TButton;
CheckBox1: TCheckBox;
Image2: TImage;
ListBox1: TListBox;
BtnScanWithDialog: TButton;
Image3: TImage;
FsaveDispbtn: TButton;
SavePictureDialog1: TSavePictureDialog;
Label4: TLabel;
OverWriteBtn: TButton;
FileCloseBtn: TButton;
procedure OpenBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DownBtnClick(Sender: TObject);
procedure UpBtnClick(Sender: TObject);
procedure MakeTiffBtnClick(Sender: TObject);
procedure SaveFileBtnClick(Sender: TObject);
procedure AddFileBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure DeleteBtnClick(Sender: TObject);
procedure InsertBtnClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure BtnScanWithDialogClick(Sender: TObject);
procedure FsaveDispbtnClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure OverWriteBtnClick(Sender: TObject);
procedure FileCloseBtnClick(Sender: TObject);
private
Twain: TDelphiTwain;
function TWainCreat: Boolean;
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure ReloadSources;
procedure Scanerin;
procedure PageDisp(P: integer);
procedure FirstWork(Fname: string);
procedure AddWork(FaddS: TMemoryStream; LTiif: boolean);
procedure DeletePage(Page: integer);
procedure insertimge(InsS : TMemoryStream; ipage: integer; LTiff: boolean);
procedure FirstStream(FrtS : TMemoryStream);
procedure FirstEncode;
function MyMessageBox(const Msg: String): integer;
function StartMessageBox(const Msg: String): integer;
procedure DispImge(P: integer);
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
LGPImage : TGPImage;
LPageCount : Integer = 0;
LPageDimensions : TGPSizeF;
LPageGuid : TGUID;
FPage : Integer = -1;
LEncoderParams : TEncoderParameters;
LEncoderParamValue : TEncoderValue;
LclsidTIFF : TGUID;
LGPImageTIFF : TGPImage;
Fname : string;
Exstr : string;
LFirstTiff : boolean;
FFileoutStream : TMemoryStream;
FFileinpStream : TMemoryStream;
LGPImageDisp : TGPImage;
InsertF : Boolean;
InsertP : Integer;
ChangF : Boolean;
OverWF : Boolean;
//-------------------------------------------
// スタート選択メッセージボックス
//-------------------------------------------
function TForm1.StartMessageBox(const Msg: String): integer;
var
Dlg: TForm;
begin
Dlg := CreateMessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbCancel]);
with Dlg do
try
Caption := '編集方法の選択';
TImage(Components[0]).Picture.Assign(Image3.Picture);
// TImage(Components[0]).Picture.LoadFromFile(Filename);
TButton(Components[2]).Caption := '新規'; // ret 6 mrYes
TButton(Components[3]).Caption := 'TiFFファイル'; // ret 7 mrNo
TButton(Components[4]).Caption := '取り消し'; // ret 2 mrCancel
result := ShowModal; // クローズ 2 mrCancel
finally
Free;
end;
end;
//-------------------------------------------
// ソース選択メッセージボックス
//-------------------------------------------
function TForm1.MyMessageBox(const Msg: String): integer;
var
Dlg: TForm;
begin
Dlg := CreateMessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbCancel]);
with Dlg do
try
Caption := 'ソースの選択';
TImage(Components[0]).Picture.Assign(Image2.Picture);
// TImage(Components[0]).Picture.LoadFromFile(Filename);
TButton(Components[2]).Caption := 'ファイル'; // ret 6 mrYes
TButton(Components[3]).Caption := 'スキャナー'; // ret 7 mrNo
TButton(Components[4]).Caption := '取り消し'; // ret 2 mrCancel
result:= ShowModal; // クローズ 2 mrCancel
finally
Free;
end;
end;
//--------------------------------------
// Twainデバイスの一覧表示
//--------------------------------------
procedure TForm1.ReloadSources;
var
I: Integer;
begin
ListBox1.Items.Clear;
for I := 0 to Twain.SourceCount - 1 do
ListBox1.Items.Add(Twain.Source[I].ProductName);
if ListBox1.Items.Count > 0 then
ListBox1.ItemIndex := 0;
end;
//------------------------------------
// Twainデバイスの取得
//------------------------------------
function TForm1.TWainCreat: Boolean;
begin
if Twain <> nil then FreeAndNil(Twain);
Twain := TDelphiTwain.Create;
// Twain画像取得割り込み設定
Twain.OnTwainAcquire := TwainTwainAcquire;
// Twainデバイスライブライの取得
if Twain.LoadLibrary then
begin
// Load source manager
Twain.SourceManagerLoaded := TRUE;
ReloadSources;
result := True;
end else begin
ShowMessage('Twain is not installed.');
result := False;
end;
end;
//---------------------------------------------------
// Twain画像の取得割り込み処理
// Cancel := True で取得終了
// Image: 取得画像
// Index: 取得画像Index
// Cancel: 画像取得打ち切りフラグ true で打ち切り
//--------------------------------------------------
procedure TForm1.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
var
FBitmapStream : TMemoryStream;
begin
FBitmapStream := TMemoryStream.Create;
try
Image.SaveToStream(FBitmapStream);
if not InsertF then begin
if not LFirstTiff then begin
FirstStream(FBitmapStream); // 最初のページ作成
SaveFileBtn.Enabled := True;
LFirstTiff := True; // 最初のページ作成フラグセット
end
else
AddWork(FBitmapStream, False); // ページの追加
end
else
insertimge(FBitmapStream, InsertP, False); // ページの挿入
finally
FBitmapStream.Free;
end;
Cancel := True; // Only want one image
if LPageCount > 0 then begin
insertbtn.Enabled := True;
deleteBtn.Enabled := True
end
else begin
insertbtn.Enabled := False;
deleteBtn.Enabled := False;
end;
end;
//------------------------------
// Twainデバイスでの画像取得開始
//------------------------------
procedure TForm1.Scanerin;
begin
if not TWainCreat then begin
BtnScanWithDialog.Enabled := False;
exit;
end;
BtnScanWithDialog.Enabled := True;
end;
//-------------------------------------
// 指定されたTwinデバイスで画像の取得
//-------------------------------------
procedure TForm1.BtnScanWithDialogClick(Sender: TObject);
begin
Twain.SelectedSourceIndex := ListBox1.ItemIndex;
if Assigned(Twain.SelectedSource) then begin
// Load source, select transference method and enable (display interface)}
Twain.SelectedSource.Loaded := True;
Twain.SelectedSource.ShowUI := True; // display interface
Twain.SelectedSource.Enabled := True;
end;
BtnScanWithDialog.Enabled := False;
end;
//--------------------------------------------------
// Tiffファイル編集中の表示画面Tiffファイル保存
//--------------------------------------------------
procedure TForm1.FsaveDispbtnClick(Sender: TObject);
var
Oname: string;
begin
if LPageCount < 1 then exit;
SavePictureDialog1.Filter := 'すべて (*.tif;*.tiff)|*.tif;*.tiff'
+ '|TIFF 画像 (*.tif) |*.tif'
+ '|TIFF 画像 (*.tiff)|*.tiff';
if not SavePictureDialog1.Execute then exit;
Oname := SavePictureDialog1.FileName;
Exstr := LowerCase(ExtractFileExt(Oname));
if (Exstr = '.tif') or (Exstr = '.tiff') then else
Oname := ChangeFileExt(Oname,'.tif');
if FileExists(Oname) then // ファイル名によるファイル検索
if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Oname) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrNo then exit;
LEncoderParamValue := EncoderValueFrameDimensionPage;
LGPImageDisp.Save(Oname, LclsidTIFF, @LEncoderParams)
end;
//----------------------------------
// 画像追加削除挿入後の表示
// P が負数だったら最後のページ表示
//----------------------------------
procedure TForm1.DispImge(P: integer);
begin
// 画面表示設定
// 解放にFreeAndNilを使用しないと Nil に設定されない場合があります
if LGPImageDisp <> nil then FreeAndNil(LGPImageDisp);
// 出力用メモリーストリームから画像生成
LGPImageDisp := TGPImage.Create(TStreamAdapter.Create(FFileoutStream, soReference));
LPageGuid := FrameDimensionPage;
LPageCount := LGPImageDisp.GetFrameCount(LPageGuid);
// 表示ページ最終ページ目にセット
if P < 0 then
FPage := LPageCount - 1
else
FPage := P;
// ページ数表示
Edit1.Text := intTostr(Fpage + 1) + ' / ' + intTostr(LPageCount);
Edit2.Text := intTostr(Fpage + 1);
Edit3.Text := intTostr(Fpage + 1);
PageDisp(FPage);
end;
//--------------------
// エンコード指定
//--------------------
procedure TForm1.FirstEncode;
begin
MakeTiffBtn.Enabled := False;
// ここではTIFFへのエンコードだけ指定
LEncoderParams.Count := 1;
LEncoderParams.Parameter[0].Guid := EncoderSaveFlag;
LEncoderParams.Parameter[0].Type_ := EncoderParameterValueTypeLong;
LEncoderParams.Parameter[0].NumberOfValues := 1;
LEncoderParams.Parameter[0].Value := @LEncoderParamValue;
// TIFFのGUIDを取得
GetEncoderClsid('image/tiff', LclsidTIFF);
end;
//----------------------------------------------------------
// 最初の画像ストリームをTiff形式でメモリーストリームに保存
//----------------------------------------------------------
procedure TForm1.FirstStream(FrtS : TMemoryStream);
begin
// エンコード指定
FirstEncode;
// 出力用メモリーストリーム生成
if FFileoutStream <> nil then FreeAndNil(FFileoutStream);
FFileoutStream := TMemoryStream.Create;
if LGPImage <> nil then FreeAndNil(LGPImage);
// LGPImageにメモリーストリームから画像生成
LGPImage := TGPImage.Create(TStreamAdapter.Create(FrtS, soReference));
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// １ページ目を出力用メモリーストリームに保存 出力先 出力形式 エンコードパラメーター の指定
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
// 最初のページ画像表示
DispImge(0);
ChangF := true;
if OverWF then OverWritebtn.Enabled := True;
end;
//----------------------------------------------------------
// 最初の画像ファイルをTiff形式でメモリーストリームに保存
// 読み込み用ファイルストリームは省略可能です
//----------------------------------------------------------
procedure TForm1.FirstWork(Fname: string);
var
i : integer;
begin
// FFileinpStreamに入力ファイルが関連付けされていたら解放
if FFileinpStream <> nil then FreeAndNil(FFileinpStream);
FFileinpStream := TMemoryStream.Create;
// メモリーストリームにファイル読み込み
FFileinpStream.LoadFromFile(Fname);
// エンコード指定
FirstEncode;
// 出力用メモリーストリーム生成
if FFileoutStream <> nil then FreeAndNil(FFileoutStream);
FFileoutStream := TMemoryStream.Create;
// LGPImageに入力画像が生成されていたら解放
// 解放にFreeAndNilを使用しないと Nil に設定されない場合があります
if LGPImage <> nil then FreeAndNil(LGPImage);
// LGPImageに入力ファイル画像生成
LGPImage := TGPImage.Create(TStreamAdapter.Create(FFileinpStream, soReference));
// 入力ファイルの拡張子の取り出し
Exstr := LowerCase(ExtractFileExt(Fname));
LPageCount := 1;
// Tiff だったら
if (Exstr = '.tif') or (Exstr = '.tiff') then begin
// Tiffのページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImage.GetFrameCount(LPageGuid);
// １ページ目をアクティブに
LGPImage.SelectActiveFrame(LPageGuid, 0);
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// １ページ目を出力用メモリーストリームに保存 出力先 出力形式 エンコードパラメーター の指定
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
// 複数ページだったら追加保存
if LPageCount > 1 then begin
for i := 1 to LPageCount - 1 do begin
LGPImage.SelectActiveFrame(LPageGuid, i);
// 選択ページのページ状態の書き込み設定 追加ページ
LEncoderParamValue := EncoderValueFrameDimensionPage;
// 追加保存 出力元 エンコードパラメーター の指定 追加の時は出力先の指定は不要
LGPImage.SaveAdd(LGPImage, @LEncoderParams);
end;
end;
// 最初の開始がTifファイルだったら上書きフラグセット
OverWF := True;
end
// Tiffファイル以外だったら
else begin
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// メモリーストリームにTiff形式として保存
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
ChangF := true;
end;
// 最後のページ画像表示
DispImge(LPageCount - 1);
FsaveDispbtn.Enabled := True;
// 必要がなくなったので解放
FreeAndnil(FFileinpStream);
end;
//---------------------------------------------
// 画像メモリストリームの追加
// 最後のページに追加します挿入はありません
//---------------------------------------------
procedure TForm1.AddWork(FaddS: TMemoryStream; LTiif: boolean);
var
i : integer;
begin
// メモリストリーから画像生成
LGPImageTIFF := TGPImage.Create(TStreamAdapter.Create(FaddS, soReference));
// Tiff ファイルだったら
if LTiif then begin
try
// Tiffのページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImageTIff.GetFrameCount(LPageGuid);
// ページ分出力用メモリーストリームに追加保存
for i := 0 to LPageCount - 1 do begin
// アクティブページの設定
LGPImageTIFF.SelectActiveFrame(LPageGuid, i);
// 選択ページのページ状態の書き込み設定 追加ページ
LEncoderParamValue := EncoderValueFrameDimensionPage;
// 追加保存
LGPImage.SaveAdd(LGPImageTIFF, @LEncoderParams);
end;
finally
// LGPImageTIFFの解放
LGPImageTIFF.Free;
end;
end
// Tiff 以外だったら
else begin
try
// 選択ページのページ状態の書き込み設定 追加設定
LEncoderParamValue := EncoderValueFrameDimensionPage;
// 追加保存 最初の Saveで出力先が設定されているので出力先は不要です
LGPImage.SaveAdd(LGPImageTIFF, @LEncoderParams);
finally
// LGPImageTIFFの解放
LGPImageTIFF.Free;
end;
end;
// 最後のページ画像表示
DispImge(-1);
ChangF := true;
if OverWF then OverWritebtn.Enabled := True;
end;
//-----------------------------------------
// 指定ページの削除
//-----------------------------------------
procedure TForm1.DeletePage(Page: Integer);
var
I, P : integer;
FDelStream : TMemoryStream;
begin
// １ページしかなかったら初期化し終了
if LPageCount = 1 then begin
LFirstTiff := False;
LPageCount := 0;
DeleteBtn.Enabled := False;
SaveFileBtn.Enabled := False;
FsaveDispbtn.Enabled := False;
Image1.Canvas.Brush.Color := clBtnface;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Edit1.Text := '';
Edit2.Text := '';
Edit3.Text := '';
ChangF := False;
exit;
end;
// 2ページ以上あったら指定ページ削除
FDelStream := TMemoryStream.Create;
FDelStream.SetSize(0);
// FDelStreamに FFileoutStreamをコピー
FDelStream.CopyFrom(FFileoutStream, 0);
// FFileoutStreamクリア
FFileoutStream.Clear;
if LGPImage <> nil then FreeAndNil(LGPImage);
// LGPImageに入力ファイルストリーム関連付け
LGPImage := TGPImage.Create(TStreamAdapter.Create(FDelStream, soReference));
try
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImage.GetFrameCount(LPageGuid);
// １ページ目をアクティブに
if Page = 1 then P := 1 else P := 0;
LGPImage.SelectActiveFrame(LPageGuid, P);
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// １ページ目を出力用メモリーストリームに保存 出力先 出力形式 エンコードパラメーター の指定
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
// 選択ページのページ状態の書き込み設定 追加設定
LEncoderParamValue := EncoderValueFrameDimensionPage;
// 複数ページだったら追加保存
if LPageCount > 1 then begin
for I := P + 1 to LPageCount - 1 do begin
// 指定ページ以外追加保存
if (I + 1) <> Page then begin
LGPImage.SelectActiveFrame(LPageGuid, I);
// 追加保存 出力元 エンコードパラメーター の指定 追加の時は出力先の指定は不要
LGPImage.SaveAdd(LGPImage, @LEncoderParams);
end;
end;
end;
finally
FDelStream.Free;
end;
// 削除した次のページ画像表示
DispImge(Page - 1);
ChangF := true;
if OverWF then OverWritebtn.Enabled := True;
end;
//--------------------------------------------------
// 指定ページに画像メモリストリーム挿入
//--------------------------------------------------
procedure TForm1.insertimge(InsS : TMemoryStream; ipage: integer; LTiff: boolean);
var
I, J : integer;
FAddStream : TMemoryStream;
Jpagecount : integer;
begin
// FADDStreamメモリーストリーム生成
FAddStream := TMemoryStream.Create;
FAddStream.SetSize(0);
// FADDStreamに FFileoutStreamをコピー
FAddStream.CopyFrom(FFileoutStream, 0);
// 出力用メモリーストリームクリア
FFileoutStream.Clear;
if LGPImage <> nil then FreeAndNil(LGPImage);
// 挿入ページ1ページ目だったら
if ipage = 1 then begin
LGPImage := TGPImage.Create(TStreamAdapter.Create(InsS, soReference));
// Tiff ファイルだったら
if LTiff then begin
// Tiffのページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
Jpagecount := LGPImage.GetFrameCount(LPageGuid);
// １ページ目をアクティブに
LGPImage.SelectActiveFrame(LPageGuid, 0);
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// １ページ目を出力用メモリーストリームに保存 出力先 出力形式 エンコードパラメーター の指定
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
// 複数ページだったら追加保存
// 選択ページのページ状態の書き込み設定 追加ページ
LEncoderParamValue := EncoderValueFrameDimensionPage;
if Jpagecount > 1 then begin
for I := 1 to Jpagecount - 1 do begin
LGPImage.SelectActiveFrame(LPageGuid, I);
// 追加保存 出力元 エンコードパラメーター の指定 追加の時は出力先の指定は不要
LGPImage.SaveAdd(LGPImage, @LEncoderParams);
end;
end;
end
// Tiffファイル以外だったら
else begin
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// メモリーストリームにTiff形式として保存
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
end;
// LGPImageTIFFにメモリーストリームから画像生成
LGPImageTIFF := TGPImage.Create(TStreamAdapter.Create(FAddStream, soReference));
try
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImageTIFF.GetFrameCount(LPageGuid);
// 選択ページのページ状態の書き込み設定 追加ページ
LEncoderParamValue := EncoderValueFrameDimensionPage;
// ページ分出力用メモリーストリームに追加保存
for I := 0 to LPageCount - 1 do begin
// アクティブページの設定
LGPImageTIFF.SelectActiveFrame(LPageGuid, I);
// 追加保存
LGPImage.SaveAdd(LGPImageTIFF, @LEncoderParams);
end;
finally
// LGPImageTIFFの関連付け解放
LGPImageTIFF.Free;
FAddStream.Free;
end;
end
// １ページ目以降だったら
else begin
// LGPImageにメモリーストリームから画像生成
LGPImage := TGPImage.Create(TStreamAdapter.Create(FAddStream, soReference));
LGPImageTIff := TGPImage.Create(TStreamAdapter.Create(InsS, soReference));
try
// Tiffのページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImage.GetFrameCount(LPageGuid);
// １ページ目をアクティブに
LGPImage.SelectActiveFrame(LPageGuid, 0);
// パラメータマルチページに設定
LEncoderParamValue := EncoderValueMultiFrame;
// １ページ目を出力用メモリーストリームに保存 出力先 出力形式 エンコードパラメーター の指定
LGPImage.Save(TStreamAdapter.Create(FFileoutStream, soReference), LclsidTIFF, @LEncoderParams);
for I := 1 to LPageCount - 1 do begin
// 選択ページのページ状態の書き込み設定 追加ページ
LEncoderParamValue := EncoderValueFrameDimensionPage;
// 挿入ページと一致したら
if I + 1 = ipage then begin
// Tiffファイルなら
if LTiff then begin
// Tiffのページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
Jpagecount := LGPImageTIff.GetFrameCount(LPageGuid);
for J := 0 to Jpagecount - 1 do begin
// 選択ページをアクティブに
LGPImageTIff.SelectActiveFrame(LPageGuid, J);
// 追加保存
LGPImage.SaveAdd(LGPImageTIff, @LEncoderParams);
end;
end
// Tiff以外なら
else begin
// 挿入保存
LGPImage.SaveAdd(LGPImageTIFF, @LEncoderParams);
end;
end;
// アクティブページの設定
LGPImage.SelectActiveFrame(LPageGuid, I);
// 追加保存
LGPImage.SaveAdd(LGPImage, @LEncoderParams);
end;
finally
LGPImageTIFF.free;
FAddStream.Free;
end;
end;
// 追加ページの画像表示
DispImge(ipage - 1);
ChangF := true;
if OverWF then OverWritebtn.Enabled := True;
end;
//-------------------------------------
// Tiff ファイル作成編集キャンセル
// 初期状態に戻します
//-------------------------------------
procedure TForm1.CancelBtnClick(Sender: TObject);
begin
if MessageDlg('本当にキャンセルしますか' +#13#10 + '編集内容は全て失われます。',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrNo then exit;
CancelBtn.Enabled := False;
// 出力用メモリーストリーム解放
if FFileoutStream <> nil then FreeAndNil(FFileoutStream);
// TGPImage解放 LGPImage
if LGPImage <> nil then FreeAndNil(LGPImage);
// TGPImage解放 LGPImageDisp
if LGPImageDisp <> nil then FreeAndNil(LGPImageDisp);
// Twain機器の解放
if Twain <> nil then FreeAndNil(Twain);
// 画像表示消去
Edit1.Text := '';
Edit2.Text := '';
Image1.Canvas.Brush.Color := clBtnFace;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
AddFileBtn.Enabled := False;
SaveFileBtn.Enabled := False;
OpenBtn.Enabled := True;
MakeTiffBtn.Enabled := True;
DownBtn.Enabled := False;
UpBtn.Enabled := False;
DeleteBtn.Enabled := False;
InsertBtn.Enabled := False;
BtnScanWithDialog.Enabled := False;
FsaveDispbtn.Enabled := False;
OverWritebtn.Enabled := False;
FPage := -1;
LPageCount := -1;
Form1.Caption := 'MakeTiff';
ChangF := False;
end;
//--------------------------------------------------------------------------
const
LFilter = 'すべて (*.gif;*.jpg;*.jpeg;*.png;*.bmp;*.tif;*.tiff;*.ico)|*.gif;*.jpg;*.jpeg;*.png;*.bmp;*.tif;*.tiff;*.ico'
+ '|GIF 画像 (*.gif)|*.gif'
+ '|JPEG イメージファイル (*.jpg)|*.jpg'
+ '|JPEG イメージファイル (*.jpeg)|*.jpeg'
+ '|Portable Network Graphics (*.png)|*.png'
+ '|ビットマップ (*.bmp)|*.bmp'
+ '|TIFF 画像 (*.tif)|*.tif'
+ '|TIFF 画像 (*.tiff)|*.tiff'
+ '|アイコン (*.ico)|*.ico';
//---------------------------------------------------
// 新しいマルチTiffファイルの作成
// Tiff ファイルを指定するとそのファイルのページ編集
//---------------------------------------------------
procedure TForm1.MakeTiffBtnClick(Sender: TObject);
var
ST : integer;
begin
Fname := '';
// 最初のTiffフラグ解除
LFirstTiff := False;
ST := StartMessageBox('Tiff編集の選択'); // Tiff画像ファイルか新規か選択
if ST = 2 then exit; // キャンセルなら終了
if ST = 7 then begin // Tiffファイルだったら
OpenPictureDialog1.Filter := 'すべて (*.tif;*.tiff)|*.tif;*.tiff'
+ '|TIFF 画像 (*.tif) |*.tif'
+ '|TIFF 画像 (*.tiff)|*.tiff';
if not OpenPictureDialog1.Execute then exit; // キャンセルなら終了
Fname := OpenPictureDialog1.FileName;
Exstr := LowerCase(ExtractFileExt(Fname));
if (Exstr = '.tif') or (Exstr = '.tiff') then // Tiffファイル確認
// 既にあるTiffファイルなら最初のTiffフラグセット
if FileExists(Fname) then LFirstTiff := True;
if LFirstTiff then begin
FirstWork(Fname); // 編集開始
SaveFileBtn.Enabled := True;
Form1.Caption := 'MakeTiff ' + Fname;
end
else exit; // Tiff以外のファイルだったら終了
end;
if ST = 6 then begin // 新規なら
Form1.Caption := 'MakeTiff 新規';
LPageCount := 0;
end;
MakeTiffBtn.Enabled := False;
AddFileBtn.Enabled := True; // 追加ボタン
OpenBtn.Enabled := False;
Cancelbtn.Enabled := True; // キャンセルボタン
insertbtn.Enabled := True;
if LPageCount > 0 then begin // ページが有ったら
insertbtn.Enabled := True; // 挿入ボタン
deleteBtn.Enabled := True // 削除ボタン
end
else begin
insertbtn.Enabled := False;
deleteBtn.Enabled := False;
end;
end;
//--------------------------------------
// 新しいマルチTiffファイルの保存
//--------------------------------------
procedure TForm1.SaveFileBtnClick(Sender: TObject);
var
LSaveFile : string;
begin
SavePictureDialog1.Filter := 'すべて (*.tif;*.tiff)|*.tif;*.tiff'
+ '|TIFF 画像 (*.tif) |*.tif'
+ '|TIFF 画像 (*.tiff)|*.tiff';
if not SavePictureDialog1.Execute then exit;
Fname := SavePictureDialog1.FileName;
Exstr := LowerCase(ExtractFileExt(Fname));
if (Exstr = '.tif') or (Exstr = '.tiff') then
LSaveFile := Fname
else
LSaveFile := ChangeFileExt(Fname,'.tif');
if FileExists(LSaveFile) then // ファイル名によるファイル検索
if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(LSaveFile) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrNo then exit;
// 指定されたファイル名で保存
FFileoutStream.SaveToFile(LSaveFile);
Form1.Caption := 'MakeTiff ' + LSaveFile;
Fname := LSaveFile;
ChangF := false;
// CancelBtnClick(nil);
end;
//-------------
// 上書き保存
//-------------
procedure TForm1.OverWriteBtnClick(Sender: TObject);
var
BackupFile : string;
begin
if FileExists(Fname) and ChangF then // ファイル名によるファイル検索
if MessageDlg('本当に上書きしますか ' + ExtractFileName(Fname) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit
else begin
BackupFile := ChangeFileExt(Fname, '.bak');
CopyFile(PWideChar(Fname), PWideChar(BackupFile), false);
FFileoutStream.SaveToFile(Fname);
end;
ChangF := false;
OverWritebtn.Enabled := False;
end;
//-----------------------
// Tiffに新しい画像追加
//-----------------------
procedure TForm1.AddFileBtnClick(Sender: TObject);
var
Ret : integer;
AddS : TMemoryStream;
LTiff : Boolean;
begin
InsertF := False;
BtnScanWithDialog.Enabled := False;
Ret := MyMessageBox('ファイルかスキャナー選択');
if Ret = 2 then exit;
if Ret = 7 then begin
scanerin; // スキャナーから画像取得追加
exit;
end;
OpenPictureDialog1.Filter := LFilter;
if not OpenPictureDialog1.Execute then exit;
// 最初の画像のTiffがメモリーストリームに作成されていなかったら作成
if not LFirstTiff then begin
FirstWork(OpenPictureDialog1.FileName);
LFirstTiff := True;
end
// 作成されてたら追加
else begin
Exstr := LowerCase(ExtractFileExt(OpenPictureDialog1.FileName));
LTiff := False;
if (Exstr = '.tif') or (Exstr = '.tiff') then LTiff := True;
AddS := TMemoryStream.Create;
try
AddS.LoadFromFile(OpenPictureDialog1.FileName);
AddWork(AddS, LTiff);
finally
AddS.Free;
end;
end;
SaveFileBtn.Enabled := True;
if LPageCount > 0 then begin
insertbtn.Enabled := True;
deleteBtn.Enabled := True
end
else begin
insertbtn.Enabled := False;
deleteBtn.Enabled := False;
end;
ChangF := true;
if OverWF then OverWritebtn.Enabled := True;
end;
//--------------------------
// 指定ページの削除
//--------------------------
procedure TForm1.DeleteBtnClick(Sender: TObject);
var
check : integer;
page : integer;
begin
val(Edit2.Text, Page, check);
if (check <> 0) or (Page < 1) or (page > LPageCount) then begin
application.MessageBox('入力された値に間違いがあります。','注意',0);
exit;
end;
if MessageDlg('本当に指定した' + intTostr(Page) + 'ページを削除しますか ？',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrNo then exit;
DeletePage(Page); // 指定ページ削除
if LPageCount > 0 then begin
insertbtn.Enabled := True;
deleteBtn.Enabled := True
end
else begin
insertbtn.Enabled := False;
deleteBtn.Enabled := False;
end;
end;
//------------------------------
// 指定ページに画像挿入
//------------------------------
procedure TForm1.InsertBtnClick(Sender: TObject);
var
ipage, Ret : integer;
Check : integer;
LTiff : Boolean;
InsS : TMemoryStream;
begin
InsertF := True;
val(Edit3.Text, iPage, check);
if (check <> 0) or (iPage < 1) or (ipage > LPageCount) then begin
application.MessageBox('入力された値に間違いがあります。','注意',0);
exit;
end;
BtnScanWithDialog.Enabled := False;
InsertP := iPage;
Ret := MyMessageBox('ファイルかスキャナー選択');
if Ret = 2 then exit;
if Ret = 7 then begin
scanerin; // スキャナーから画像取得挿入
exit;
end;
// ファイルから画像挿入
OpenPictureDialog1.Filter := LFilter;
if not OpenPictureDialog1.Execute then exit;
Exstr := LowerCase(ExtractFileExt(OpenPictureDialog1.FileName));
LTiff := False;
if (Exstr = '.tif') or (Exstr = '.tiff') then LTiff := True;
InsS := TMemoryStream.Create;
try
InsS.LoadFromFile(OpenPictureDialog1.FileName);
Insertimge(InsS, ipage, LTiff);
finally
InsS.Free;
end;
end;
//==================================================================
//----------------------------------
// Tiffファイルの画像表示
// ページ指定で表示 0～LPageCount - 1
//----------------------------------
procedure TForm1.PageDisp(P: integer);
var
W, H : Integer;
HH, WW, WH : double;
LGPGraphic : TGPGraphics;
begin
if P < 0 then exit;
DownBtn.Enabled := False;
UpBtn.Enabled := False;
Image1.Canvas.Brush.Color := clBtnface;
// Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
LGPImageDisp.SelectActiveFrame(LPageGuid, P);
LGPImageDisp.GetPhysicalDimension(LPageDimensions);
// 各ページの画像のサイズ
W := Trunc(LPageDimensions.Width);
H := Trunc(LPageDimensions.Height);
if CheckBox1.Checked then begin
WW := (ScrollBox1.Width - 5) / W;
HH := (ScrollBox1.Height - 5) / H;
if (WW < 1) or (HH < 1) then begin
if WW < HH then WH := WW
else WH := HH;
W := Trunc(W * WH);
H := Trunc(H * WH);
end;
end;
Image1.width := W;
Image1.Height := H;
Image1.Picture.Bitmap.SetSize(W, H);
Image1.Update;
// Image1のサイズ変更するとHandleが変わるのでサイズ変更後取得します
LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
try
// 表示 MakeRectを使用すると変倍描画が可能となります。
LGPGraphic.DrawImage(LGPImageDisp, MakeRect(0, 0, W, H));
// LGPGraphic.DrawImage(LGPImageDisp, 0, 0, W, H);
Image1.Repaint; // 描画の更新
finally
LGPGraphic.Free;
end;
if LPageCount > 1 then begin
DownBtn.Enabled := True;
UpBtn.Enabled := True;
end;
end;
//---------------------------------------
// 表示を終了と画像の消去
//---------------------------------------
procedure TForm1.FileCloseBtnClick(Sender: TObject);
begin
if LGPImageDisp <> nil then freeAndNil(LGPImageDisp);
Image1.Canvas.Brush.Color := clBtnFace;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
MakeTiffBtn.Enabled := True;
FileCloseBtn.Enabled := False;
OpenBtn.Enabled := True;
DownBtn.Enabled := False;
UpBtn.Enabled := False;
Form1.Caption := 'MultiTiff';
end;
//------------------------------------
// Tiff ファイルの読み込み表示用
// 表示のみです
//------------------------------------
procedure TForm1.OpenBtnClick(Sender: TObject);
begin
OpenPictureDialog1.Filter := 'すべて (*.tif;*.tiff)|*.tif;*.tiff'
+ '|TIFF 画像 (*.tif) |*.tif'
+ '|TIFF 画像 (*.tiff)|*.tiff';
if not OpenPictureDialog1.Execute then exit;
OpenBtn.Enabled := False;
// 解放にFreeAndNilを使用しないと Nil に設定されない場合があります
if LGPImageDisp <> nil then freeAndNil(LGPImageDisp);
// FFileinpStreamに入力ファイルが関連付けされていたら解放
if FFileinpStream <> nil then FreeAndNil(FFileinpStream);
FFileinpStream := TMemoryStream.Create;
// メモリーストリームにファイル読み込み
FFileinpStream.LoadFromFile(OpenPictureDialog1.FileName);
// LGPImageに入力ファイルストリーム関連付け
LGPImageDisp := TGPImage.Create(TStreamAdapter.Create(FFileinpStream, soReference));
// ページ定数セット ページ設定取得用
LPageGuid := FrameDimensionPage;
// ページ数取得
LPageCount := LGPImageDisp.GetFrameCount(LPageGuid);
// 表示ページ１ページ目にセット
FPage := 0;
// ページ数表示
Edit1.Text := '1 / ' + intTostr(LPageCount);
// 指定ページ表示
PageDisp(FPage);
DownBtn.Enabled := True;
UpBtn.Enabled := True;
insertbtn.Enabled := False;
deleteBtn.Enabled := False;
MakeTiffBtn.Enabled := False;
FileCloseBtn.Enabled := True;
Form1.Caption := 'Open Tiff ' + OpenPictureDialog1.FileName;
end;
//-------------------------------
// 表示ページダウン
//-------------------------------
procedure TForm1.DownBtnClick(Sender: TObject);
begin
if Fpage > 0 then begin
dec(Fpage);
Edit1.Text := intTostr(Fpage + 1) + ' / ' + intTostr(LPageCount);
Edit2.Text := intTostr(Fpage + 1);
Edit3.Text := intTostr(Fpage + 1);
PageDisp(Fpage);
end;
end;
//----------------------------
// 表示ページアップ
//----------------------------
procedure TForm1.UpBtnClick(Sender: TObject);
begin
if Fpage < LPageCount - 1 then begin
inc(Fpage);
Edit1.Text := intTostr(Fpage + 1) + ' / ' + intTostr(LPageCount);
Edit2.Text := intTostr(Fpage + 1);
Edit3.Text := intTostr(Fpage + 1);
PageDisp(Fpage);
end;
end;
//---------------------------------------
// チェックでスクロールバー無しで枠内表示
//---------------------------------------
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if Fpage >= 0 then PageDisp(Fpage);
end;
//-------------
// 初期設定
//-------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Top := 0;
Image1.Left := 0;
DownBtn.Enabled := False;
UpBtn.Enabled := False;
AddFileBtn.Enabled := False;
SaveFileBtn.Enabled := False;
Cancelbtn.Enabled := False;
DeleteBtn.Enabled := False;
insertbtn.Enabled := False;
BtnScanWithDialog.Enabled := False;
FsaveDispbtn.Enabled := False;
OverWritebtn.Enabled := False;
FileCloseBtn.Enabled := False;
end;
// 終了前処理
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if ChangF then
if application.MessageBox('変更されています保存せず終了しますか ?','注意', MB_YESNO) = idNo then
CanClose := false;
end;
//------------
// 終了処理
//------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FFileoutStream <> nil then FreeAndNil(FFileoutStream);
if LGPImage <> nil then FreeAndNil(LGPImage);
if LGPImageDisp <> nil then FreeAndNil(LGPImageDisp);
if Twain <> nil then FreeAndNil(Twain);
if FFileinpStream <> nil then FreeAndNil(FFileinpStream);
end;
end.
GdipMultiTIFF.zip
画像処理一覧へ戻る
最初に戻る