[ エクセル操作フォームEx ] [ 図形と画像の挿入テスト ]

Delphi Programming / Object Pascal

[掲載 2009年05月24日] [更新 2013年12月12日]　エクセル操作フォームEx

エクセル操作フォームEx テストプログラム　Shape
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Excel 2010

図形の挿入テスト
画像の明るさやコントラストの設定

図形と画像の挿入テスト

図形を挿入するメソッド，xlfInsertPicture, xlfInsertPictureFitCell のテストプログラムです．

図1
実行結果

リスト1
メインフォームのコード

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShapeUnit;

{$R *.dfm}

//=============================================================================
//  エクセル操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //グリッドライン等の表示
  plExcelFormEx2.xlfDisplayGridLines := True;
  plExcelFormEx2.xlfDisplayHeadings  := True;

  //表示した時の選択セル
  plExcelFormEx2.xlfActiveCell := 'A2';
  //スクロールエリア
  plExcelFormEx2.xlfScrollArea := 'A1:H70';
  //ブックファイル名
  plExcelFormEx2.xlfBookFullPath := 'ShapeTest.xls';

  //エクセル操作フォームEx(の継承フォーム)を表示
  plExcelFormEx2.ShowModal;
end;

end.

リスト2
表示する継承フォームのコード

unit ShapeUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, plExcelEx, ToolWin, ComCtrls, ExtCtrls;

type
  TplExcelFormEx2 = class(TplExcelFormEx)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  plExcelFormEx2: TplExcelFormEx2;

implementation

uses JPEG, Excel2000;

{$R *.dfm}

//=============================================================================
//  終了時にはブック変更なしにして保存しない
//=============================================================================
procedure TplExcelFormEx2.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  xlfBookSaved := True;

  //元のCloseQueryを実行
  inherited;
end;

//=============================================================================
//  セルB3の左上を図の左上に合わて挿入
//  挿入後にフリー移動形式にしているので行挿入でも位置変化なし
//  図のサイズを取得するために図の読込みも実行
//
//  xlFreeFloatingの定数値の使用にはusesにExcel2000が必要
//=============================================================================
procedure TplExcelFormEx2.Button1Click(Sender: TObject);
var
  FileName : String;
  AJpeg    : TJpegImage;
  AWidth   : Integer;
  AHeight  : Integer;
  AShape   : Txlf2000Shape;
begin
  //描画更新の停止
  xlfExcelApp.ScreenUpdating[0] := False;

  FileName := ExtractFilePath(Application.ExeName) + 'TESTIMG.JPG';
  //サイズを知るためにTJpegImageにも読込む
  AJpeg := TJpegImage.Create;
  try
    AJpeg.LoadFromFile(FileName);
    AWidth  := AJpeg.Width;
    AHeight := AJpeg.Height;
    AShape  := xlfInsertPicture(FileName, 'B3', AWidth, AHeight, 0, 0);
    if AShape<>nil then begin
      AShape.Placement := xlFreeFloating;
    end;
  finally
    AJpeg.Free;
  end;

  //描画更新の再開
  xlfExcelApp.ScreenUpdating[0] := True;
end;

//=============================================================================
//  セルB15:F26の領域に図を縦横比を変えずに挿入
//  上下左右に2pointの余白を設定
//=============================================================================
procedure TplExcelFormEx2.Button2Click(Sender: TObject);
var
  FileName : String;
  ARange   : Txlf2000Range;
begin
  //描画更新の停止
  LockWindowUpdate(Handle);

  FileName := ExtractFilePath(Application.ExeName) + 'E_frog.wmf';
  xlfInsertPictureFitCell(FileName, 'B15', 'D20', 2, 2);

  //確認のため,図形挿入の範囲の外周に罫線を引く
  //範囲のRangeオブジェクト
  ARange := xlfExcelSheet.Range['B15', 'D20'];
  //枠罫線
  ARange.BorderAround(xlContinuous, xlMedium, 16, EmptyParam);

  //描画更新の再開
  LockWindowUpdate(0);
end;

end.

画像の明るさやコントラストの設定

図 (画像) のコントラストや透明度の設定には，次のリストのように，PictureFormat オブジェクトを使用します．設定可能なプロパティは，VBA のヘルプで PictureFormat を調べてください．
以下にも参考となるコードがあります．

参考リンク
[オートシェイプの描画]

図2
実行結果

リスト3
画像の明るさやコントラストの設定

procedure TplExcelFormEx2.Button3Click(Sender: TObject);
var
  FileName       : String;
  AJpeg          : TJpegImage;
  AWidth         : Integer;
  AHeight        : Integer;
  AShape         : Txlf2000Shape;
  APictureFormat : Excel2000.PictureFormat;
begin
  //描画更新の停止
  xlfExcelApp.ScreenUpdating[0] := False;

  FileName := ExtractFilePath(Application.ExeName) + 'TESTIMG.JPG';

  //サイズを知るためにTJpegImageにも読込む
  AJpeg := TJpegImage.Create;

  try
    AJpeg.LoadFromFile(FileName);

    AWidth  := AJpeg.Width;
    AHeight := AJpeg.Height;
    AShape  := xlfInsertPicture(FileName, 'B3', AWidth, AHeight, 0, 0);

    if AShape <> nil then begin
      AShape.Placement := xlFreeFloating;
      APictureFormat   := AShape.PictureFormat as Excel2000.PictureFormat;
      APictureFormat.Contrast   := 0.5;
      APictureFormat.Brightness := 0.75;
    end;
  finally
    AJpeg.Free;
  end;

  //描画更新の再開
  xlfExcelApp.ScreenUpdating[0] := True;
end;