Delphi ソ−ス　フアイル　　　　　　　　　　Return

ソース　フアイル(dsrc.zip)

配置図 Formに　ImageViewer、Label　Panelを配置 Dialog　：　OpenDialog,　SaveDilog、MainMenu　を利用し、フアイルのOpen、Saveのフアイル名を、MainMenuでフアイル、クリップボード、ImageViewer1.MakeScreenshot()でScreen　ショットの 保存など動作を指定 ClipBordの操作はDelphiでは、サンプルがありましたが、C++Builderはサンプルがほとんどなく苦戦しました。

unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Menus, FMX.Layouts, FMX.ExtCtrls, FMX.Controls.Presentation, FMX.StdCtrls; type TForm1 = class(TForm) MainMenu1: TMainMenu; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; MenuItem1: TMenuItem; MenuItem2: TMenuItem; MenuItem3: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; ImageViewer1: TImageViewer; Panel1: TPanel; Label2: TLabel; Label3: TLabel; Label1: TLabel; MenuItem9: TMenuItem; MenuItem10: TMenuItem; MenuItem11: TMenuItem; procedure MenuItem2Click(Sender: TObject); procedure MenuItem4Click(Sender: TObject); procedure MenuItem3Click(Sender: TObject); procedure MenuItem6Click(Sender: TObject); procedure ImageViewer1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); procedure ImageViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure ImageViewer1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure ImageViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); procedure MenuItem9Click(Sender: TObject); procedure MenuItem11Click(Sender: TObject); private { private 宣言 } public { public 宣言 } end; var Form1: TForm1; implementation {$R *.fmx} uses FMX.Clipboard,FMX.Platform,System.IOUtils; var X0,Y0 :Single; var DFlg :Integer; function takefilename(): string; //File Nameの処理 begin var ext :string; var path :string; var path1 :string; if Form1.SaveDialog1.Execute then ext :=LowerCase(TPath.GetExtension(Form1.SaveDialog1.FileName)); path := TPath.GetFileNameWithoutExtension(Form1.SaveDialog1.FileName); path1 :=ExtractFilePath(Form1.SaveDialog1.FileName); if (ext='') then begin Form1.SaveDialog1.FileName :=Form1.SaveDialog1.FileName+'.jpg'; end else if (ext<>'.jpg')and(ext<>'.bmp')and(ext<>'.png') then Form1.SaveDialog1.FileName :=path1+path+'.jpg'; if(path='') then Form1.SaveDialog1.FileName :=''; Result := Form1.SaveDialog1.FileName; //Result変数、返す値を入れる end; //マウスのドラッグで画像の位置を動かす procedure TForm1.ImageViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if ssLeft in Shift then begin //左ボタンなら X0 :=X; Y0 :=Y; DFlg :=255; end; end; procedure TForm1.ImageViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); begin var x2 :Single; var y2 :Single; if DFlg =255 then begin x2 :=X-X0; Y2 :=Y-Y0; ImageViewer1.ScrollBy(x2,y2); x0 :=X; Y0 :=Y; end; end; procedure TForm1.ImageViewer1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin DFlg :=0; end; procedure TForm1.ImageViewer1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); begin var i: Single; i := ImageViewer1.BitmapScale ; var s :string; s :=FloatToStr(i); s := Copy(s,1,5); //表示を４桁にする label1.Text :=s; //拡大率の表示 end; procedure TForm1.MenuItem2Click(Sender: TObject); //File Open begin if OpenDialog1.Execute then ImageViewer1.Bitmap.LoadfromFile(OpenDialog1.FileName); label3.Text := OpenDialog1.FileName; end; procedure TForm1.MenuItem3Click(Sender: TObject); //ClipBoardから読み込み　 begin var Clipboard: IFMXExtendedClipboardService; if not TPlatformServices.Current.SupportsPlatformService(IFMXExtendedClipboardService, Clipboard) then exit; if Clipboard.HasImage then ImageViewer1.Bitmap.Assign(Clipboard.GetImage); label3.Text := 'ClipBoard'; end; procedure TForm1.MenuItem4Click(Sender: TObject); //file 保存 begin var fname :string; fname := takefilename(); if(fname<>'') then ImageViewer1.Bitmap.SaveToFile(fname); end; procedure TForm1.MenuItem6Click(Sender: TObject); begin Close; end; procedure TForm1.MenuItem9Click(Sender: TObject); //screen 保存 begin var bmp :TBitmap; var fname :string; bmp :=TBitMap.Create(); fname := takefilename(); if(fname<>'') then ImageViewer1.ShowScrollBars :=false; bmp :=ImageViewer1.MakeScreenshot(); bmp.SaveToFile(fname); bmp.Free; ImageViewer1.ShowScrollBars :=true; {* ImageViewer1.Bitmap :=ImageViewer1.MakeScreenshot(); ImageViewer1.Bitmap.SaveToFile('D:\SCREEN.JPG'); *} end; procedure TForm1.MenuItem11Click(Sender: TObject); //Screen->Clipbord var VClipboard: IFMXClipboardService; var bmp :TBitmap; begin if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, VClipboard) then begin ImageViewer1.ShowScrollBars :=false; bmp :=ImageViewer1.MakeScreenshot(); VClipboard.SetClipboard(bmp); ImageViewer1.ShowScrollBars :=true; bmp.Free; end; end; end.