DLLの引数にVCLを渡すには？ (ID:40854)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

環境: Delphi2007, Windows XP Professional

DLLの引数にVCLを渡す方法を教えてください。
プログラムはListViewの内容をExcelへ出力するプログラムです。

DLLは今回初めて使用します。
色んなサイトを参考になんとかやってみましたが
最後の最後で分からなくなってしまいました。

問題無く動作していると思ったら
確認メッセージダイアログを閉じた後に
アドレスエラーが出ます。
実装方法が間違っていますでしょうか？

以下がソースです。
宜しくお願い致します。

//DLL側プロジェクトソース
library Project1;

uses
  SysUtils,
  Classes,
  xlscmd in 'sor\xlscmd.pas';

{$R *.res}

exports ExcelProc;

begin
end.

//DLL側メインユニット
unit xlscmd;

interface

uses
  SysUtils, Variants, Classes, Dialogs, ComCtrls, ComObj, Clipbrd, ActiveX;

//Excelへ出力する
procedure ExcelProc(ListView: TListView);

implementation

const
  //VBA Excel定数
  //位置
  xlLeft   = -4131; //左寄せ
  xlCenter = -4108; //中央寄せ
  xlRight  = -4152; //右寄せ
  xlBottom = -4107; //下寄せ
  xlNone   = -4142;
  xlAutomatic = -4105;
  //罫線線種
  xlContinuous = 1;
  //罫線幅
  xlHairline = 1;
  xlThin     = 2;
  xlThick    = 4;
  //罫線位置
  xlDiagonalDown     = 5;
  xlDiagonalUp       = 6;
  xlEdgeLeft         = 7;
  xlEdgeRight        = 10;
  xlEdgeTop          = 8;
  xlEdgeBottom       = 9;
  xlInsideVertical   = 11;
  xlInsideHorizontal = 12;
  //用紙向き
  xlPortrait  = 1; //縦向き
  xlLandscape = 2; //横向き
  //頁方向
  xlDownThenOver = 1; //下→上
  xlOverThenDown = 2; //上→下

//ListViewのデータをクリップボードへコピー
function CopyToClipBoard(ListView: TListView): string;
var
  i, k: Integer;
  S: string;
begin
  S := '';
  //タイトル
  for i:=0 to ListView.Columns.Count-1 do
    S := S + ListView.Column[i].Caption + #9;
  Result := S + #13#10;

//データ
  for i:=0 to ListView.Items.Count-1 do begin
    S := Trim(ListView.Items[i].Caption) + #9;
    for k:=0 to ListView.Columns.Count-2 do
      S := S + Trim(ListView.Items[i].SubItems[k]) + #9;
    Result := Result + S + #13#10;
  end;
end;

//Excelへ出力する
procedure ExcelProc(ListView: TListView);
var
  V: OleVariant;

//数字を英字に変換
  function NumToAlph(N: Integer): string;
  begin
    Result := '';
    if (N > 26) then Result := Chr(Ord('A') + ((N-27) div 26));
    Result := Result + Chr(Ord('A') + ((N-1) mod 26));
  end;

//枠線を引く
  procedure DrawRectangle(R: string);
  begin
    V.ActiveSheet.Range[R].Borders[xlDiagonalDown].LineStyle := xlNone;
    V.ActiveSheet.Range[R].Borders[xlDiagonalUp].LineStyle   := xlNone;
    V.ActiveSheet.Range[R].Borders[xlEdgeLeft].LineStyle     := xlContinuous;
    V.ActiveSheet.Range[R].Borders[xlEdgeLeft].Weight        := xlThin;
    V.ActiveSheet.Range[R].Borders[xlEdgeLeft].ColorIndex    := xlAutomatic;
    V.ActiveSheet.Range[R].Borders[xlEdgeTop].LineStyle      := xlContinuous;
    V.ActiveSheet.Range[R].Borders[xlEdgeTop].Weight         := xlThin;
    V.ActiveSheet.Range[R].Borders[xlEdgeTop].ColorIndex     := xlAutomatic;
    V.ActiveSheet.Range[R].Borders[xlEdgeBottom].LineStyle   := xlContinuous;
    V.ActiveSheet.Range[R].Borders[xlEdgeBottom].Weight      := xlThin;
    V.ActiveSheet.Range[R].Borders[xlEdgeBottom].ColorIndex  := xlAutomatic;
    V.ActiveSheet.Range[R].Borders[xlEdgeRight].LineStyle    := xlContinuous;
    V.ActiveSheet.Range[R].Borders[xlEdgeRight].Weight       := xlThin;
    V.ActiveSheet.Range[R].Borders[xlEdgeRight].ColorIndex   := xlAutomatic;
  end;

var
  Sheet: Variant;
  S, KeepClipBrd: string;
  i, RecCnt, ColCnt: Integer;
begin
  RecCnt := ListView.Items.Count;
  ColCnt := ListView.Columns.Count;

try
    V := CreateOleObject('Excel.Application');
  except
    MessageDlg('Excel起動に失敗しました。', mtError, [mbOK], 0);
//  VarClear(V);
    {V変数の破棄は VarClear or Unassignedのどっちを使うのが正解？}
    V := Unassigned;
    Exit;
  end;

//クリップボードの内容を退避
  KeepClipBrd := ClipBoard.AsText;
  try
    V.Visible := True;
    //画面更新の抑制
    V.Application.ScreenUpdating := False;
    V.WorkBooks.Add;
    V.WorkBooks[1].Activate;
    V.WorkSheets[1].Activate;

//先頭以外のシートを消す
    V.DisplayAlerts := False;
    for i:=V.WorkBooks[1].Sheets.Count downto 2 do V.Sheets[i].Delete;
    V.DisplayAlerts := True;

V.ActiveSheet.Name := 'データ一覧'; //表題
    V.ActiveWindow.Zoom        := 75;   //ズーム 75%
    V.ActiveWindow.SplitColumn := 0;    //行ウインドウ枠設定
    V.ActiveWindow.SplitRow    := 3;    //列ウインドウ枠設定
    V.ActiveWindow.FreezePanes := True; //ウインドウ枠固定

Sheet := V.Sheets[1];
    Sheet.Activate;

Sheet.PageSetUp.Orientation := xlLandscape; //用紙方向(横)
    Sheet.PageSetUp.PrintTitleRows := '$1:$3';  //行タイトルの設定
    Sheet.PageSetUp.RightHeader  := '&11 ' + FormatDateTime('yyyy/mm/dd hh:nn:ss', Now) + ' 発行'; //日付を設定する
    Sheet.PageSetUp.CenterFooter := '&9&P/&N ページ'; //頁数/総頁数の設定
    Sheet.PageSetUp.Order := xlOverThenDown;         //頁方向(上から下)
    //余白の設定
    Sheet.PageSetUp.LeftMargin   := V.InchesToPoints(05/25.4);//左余白
    Sheet.PageSetUp.TopMargin    := V.InchesToPoints(10/25.4);//上余白
    Sheet.PageSetUp.RightMargin  := V.InchesToPoints(05/25.4);//右余白
    Sheet.PageSetUp.BottomMargin := V.InchesToPoints(10/25.4);//下余白
    Sheet.PageSetUp.HeaderMargin := V.InchesToPoints(10/25.4);//ヘッダー幅
    Sheet.PageSetUp.FooterMargin := V.InchesToPoints(05/25.4);//フッター幅
    //フォント設定
    Sheet.Cells.Font.Size := 9;
    //タイトル設定
    Sheet.Cells[1,1].Font.Size := 20;
    Sheet.Cells[1,1].Font.Name := 'ＭＳ Ｐゴシック';
    Sheet.Cells[1,1].Font.Bold := True;
    Sheet.Rows[3].Font.Size := 10;
    Sheet.Rows[3].HorizontalAlignment := xlCenter;
    Sheet.Rows[3].Font.Name := 'ＭＳ Ｐゴシック';
    Sheet.Rows[3].Font.Bold := True;
    //書式設定
    Sheet.Columns[1].NumberFormatLocal := '@';
    Sheet.Columns[2].NumberFormatLocal := '@';
    Sheet.Columns[3].NumberFormatLocal := '@';
    //罫線を引く
    S := 'A3:'+ NumToAlph(ColCnt) + IntToStr(RecCnt+3);
    DrawRectangle(S);
    Sheet.Range[S].Borders[xlInsideVertical].LineStyle  := xlContinuous;
    Sheet.Range[S].Borders[xlInsideVertical].Weight     := xlHairline;
    Sheet.Range[S].Borders[xlInsideVertical].ColorIndex := xlAutomatic;
    Sheet.Range[S].Borders[xlInsideHorizontal].LineStyle  := xlContinuous;
    Sheet.Range[S].Borders[xlInsideHorizontal].Weight     := xlHairline;
    Sheet.Range[S].Borders[xlInsideHorizontal].ColorIndex := xlAutomatic;
    S := 'A3:'+ NumToAlph(ColCnt) + '3';
    DrawRectangle(S);
    //クリップボードからデータの貼り付け
    V.Application.StatusBar := 'データ作成中...';
    ClipBoard.AsText := CopyToClipBoard(ListView);
    V.Application.StatusBar := 'データ出力中...';
    Sheet.Cells[3,1].PasteSpecial; //貼り付け
    Sheet.Cells[3,1].Select;
    //カラム幅の設定
    Sheet.Columns['A:' + NumToAlph(ColCnt)].EntireColumn.AutoFit;
    //オートフィルタの設定
    Sheet.Range[S].Select;
    V.Selection.AutoFilter;

Sheet.Cells[1,1] := 'データ一覧';
    Sheet.Cells[4,1].Select;
    //画面更新の抑制解除
    V.Application.ScreenUpdating := True;
    V.Application.StatusBar := False;
//  Sheet := Unassigned; {Sheet変数も破棄する？}
//  VarClear(V);
    {V変数の破棄は VarClear or Unassignedのどっちを使うのが正解？}
    V := Unassigned;
  finally
    //退避したクリップボードの内容を戻す
    ClipBoard.AsText := KeepClipBrd;
  end;
end;

//「CoInitializeが呼び出されていません」のエラー回避策

initialization
  CoInitialize(nil); //COM初期化

finalization
  CoUnInitialize;    //COM解放

end.

//呼び出しEXE
unit main;

interface

uses
  SysUtils, Classes, Controls, Forms, ComCtrls, StdCtrls, Dialogs;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure SetData;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure ExcelProc(ListView: TListView); stdcall; external 'project1.dll';

procedure TfrmMain.SetData;
var
  Item: TListItem;
  i: Integer;
begin
  for i:=0 to 9 do begin
    Item := ListView1.Items.Add;
    Item.Caption   := Format('A%d', [i+1]);
    Item.SubItems.Add(Format('B%d', [i+1]));
    Item.SubItems.Add(Format('C%d', [i+1]));
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  SetData;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  ExcelProc(ListView1);
  ShowMessage('呼び出し完了');
  //ダイアログボタンの[OK]ボタンの後にアドレスエラーが出ます
end;

←解決時は質問者本人がここをチェックしてください。

戻る