« 2011年9月 | トップページ | 2011年11月 »

DBGridのPopupMenuで・・・。

Delphi2007で作ったDBGridから派生させた自作コンポーネントをDelphi XE2で動作確認していたところ、セルの編集時、設定したPopupMenuが表示されないことが確認されました。Delphi2007の時は、セル編集時、設定されたPopupMenuが表示されていましたが、Delphi XE2では、デフォルトのものが表示されてしまいます。


次のようなシンプルな構成でDBGridとStringGridにPopupMenuを割り当てて、Delphi2007、Delphi2009、Delphi XE2で試してみました。

Design2007




[Delphi2007] 
DBGrid、InplaceEditor共割り当てたPopupMenuが表示されています。

Delphi2007runtime


Delphi2007runtime2




[Delphi2009] 
セル編集時、デフォルトのPopupMenuが表示されてしまいます。

Delphi2009runtime


Delphi2009runtime2




[Delphi XE2] 
Delphi2009と同じく、デフォルトのPopupMenuが表示されています。

Delphixe2runtime




ということで、この動作は、Delphi2009から変わっていたようです。いつもながらスマートな方法とは言えないんですけど、下記の処理でInplaceEditorにもPopupMenuを割り当てることができました。
type
   TDummyDBG = class(TCustomDBGrid);
   TDummyCG  = class(TCustomGrid);
   TDummyCtl = class(TControl);

procedure TForm1.FormShow(Sender: TObject);
var
  Options1: TDBGridOptions;
  Options2: TGridOptions;
begin
  // DBGridの場合
  Options1 := DBGrid1.Options;
  try
    DBGrid1.Options := DBGrid1.Options + [dgEditing, dgAlwaysShowEditor];
    TDummyDBG(DBGrid1).ShowEditor;
    if Assigned(TDummyDBG(DBGrid1).InplaceEditor) then
      TDummyCtl(TDummyDBG(DBGrid1).InplaceEditor).PopupMenu := DBGrid1.PopupMenu;
  finally
    DBGrid1.Options := Options1;
  end;

  // StringGridの場合
  Options2 := StringGrid1.Options;
  try
    StringGrid1.Options := StringGrid1.Options + [goEditing, goAlwaysShowEditor];
    TDummyCG(StringGrid1).ShowEditor;
    if Assigned(TDummyCG(StringGrid1).InplaceEditor) then
      TDummyCtl(TDummyCG(StringGrid1).InplaceEditor).PopupMenu := StringGrid1.PopupMenu;
  finally
    StringGrid1.Options := Options2;
  end;
end;



Delphixe2runtimeok

|

MyBaseを試してみる。(フィルター編)

TClientDataSetは、SQLが使えないもののFilterプロパティを設定することで、フィルター処理ができます。このFilterプロパティ・・・昔は、ヘルプの通り動作しなかった記憶がありますが、今では問題なく動作しています。

特にMyBaseの場合、今までOnFilterRecordでごちゃごちゃ書いていた処理も、計算フィールドと組み合わせるとシンプルな処理にできます。今回のサンプルも、いつもように「コテコテなコード」で「コテコテなフィルター条件」ですが、MyBaseの性質上、数万のレコードであっても瞬時にフィルター処理されます。

使えるフィルター条件式は、ヘルプを参照して下さい。


Embarcadero Product Documentation Wikis
DBClient.TClientDataSet.Filter
http://docwiki.embarcadero.com/VCL/ja/DBClient.TClientDataSet.Filter


 
procedure MakeSample(CDS: TClientDataSet);
var
  F: Boolean;
begin
  F := CDS.Active;
  if not F then
    CDS.Open;
  try
    // サンプルデータの追加
    with CDS do
    begin
      Appendrecord([ 1,'基礎 普通コンクリート',150]);
      Appendrecord([ 2,'躯体 普通コンクリート',800]);
      Appendrecord([ 3,'AW-1 引違窓',30]);
      Appendrecord([ 4,'AW-2 2連外倒し排煙窓',10]);
      Appendrecord([ 5,'床 モルタル金鏝押エ t=30',400]);
      Appendrecord([ 6,'床 コンクリート金鏝押エ',300]);
      Appendrecord([ 7,'壁 ビニールクロス貼',1500]);
      Appendrecord([ 8,'柱 ビニールクロス貼',100]);
      Appendrecord([ 9,'梁 クロス貼',50]);
      Appendrecord([10,'天井 ビニールクロス貼',500]);
      Appendrecord([11,'土間 モルタル鏝押エ',100]);
      CheckBrowseMode;
    end;
  finally
    if not F then
      CDS.Close;
  end;
end;

// データベースの作成
procedure CreateDB(CDS: TClientDataSet);
var
  I: Integer;
begin
  // データベースの作成
  CDS.Close;
  CDS.FieldDefs.Add('ORD' ,ftInteger);
  CDS.FieldDefs.Add('ITEM',ftWideString,20);
  CDS.FieldDefs.Add('QTY' ,ftInteger);
  CDS.IndexDefs.Add('ORD_IDX','ORD', [ixPrimary]);
  CDS.CreateDataSet;
  CDS.Close;

  for I := 0 to CDS.FieldDefs.Count - 1 do
    CDS.FieldDefs[I].CreateField(CDS);

  // 計算フィールド
  with TWideStringField.Create(CDS) do
  begin
    FieldName := 'STRFORFILTER';
    Visible:=True;
    FieldKind := fkInternalCalc;
    DataSet := CDS;
  end;

  // インデックスの設定
  CDS.IndexName := 'ORD_IDX';

  // サンプルデータの作成
  MakeSample(CDS);
end;

// 文字列の比較用文字列を作成します。
// アルファベットは全角大文字、
// 半角カタカナ、全角カタカナは、全角ひらがなとします。
function MakeHikakuMoji(S: String): String;

  // 文字の変換
  function MapString(const Source: string; Flag: Integer): string;
  var
    Chr: array [0..255] of Char;
  begin
    LCMapString(GetUserDefaultLCID(), Flag, PChar(Source),
      Length(Source) + 1, Chr, Sizeof(Chr));
    Result  :=  chr;
  end;

begin
  Result := AnsiUpperCase(MapString(S, LCMAP_FULLWIDTH or LCMAP_HIRAGANA));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateDB(ClientDataSet1);
  ClientDataSet1.Open;
end;

// 計算フィールド
procedure TForm1.ClientDataSet1CalcFields(DataSet: TDataSet);
begin
  if DataSet.Active then
  begin
    DataSet.FieldByName('STRFORFILTER').AsString :=
      MakeHikakuMoji(DataSet.FieldByName('ITEM').AsString);
  end;
end;

// フィルター
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

  // フィルター用計算フィールド(STRFORFILTER)を使う場合
  function GetFilterStr(S: String): String;
  const
    M1 = 'STRFORFILTER LIKE ';
    L1 = 'NOT';
    L2 = 'OR';
  var
    SL: TStringList;
    I: Integer;
    S1,S2, S3: String;
  begin
    Result := '';
    // フィルター文字列の変換
    S := StringReplace(MakeHikakuMoji(S), ' ',' ', [rfReplaceAll]);

    SL := TStringList.Create;
    try
      SL.Delimiter := ' ';
      SL.StrictDelimiter := True;
      SL.DelimitedText := S;

      for I := 0 to SL.Count -1 do
      begin
        S1 := Trim(SL[I]);
        if S1 <> '' then
        begin
          if (S1 <> L1) and (S1 <> L2) then
          begin
            if S2 = L1 then
              S3 := Concat('( NOT (', M1, QuotedStr('%' + S1 +'%'), ')) ')
            else
              S3 := Concat('(', M1, QuotedStr('%' + S1 +'%'), ') ');

            if I = 0 then
              Result := S3
            else if (S2 = L2) then
              Result := Result + ' OR ' + S3
            else
              Result := Result + ' AND ' + S3;
            S2 := '';
          end
          else
            S2 := S1;
        end;
      end;
    finally
      SL.Free;
    end;
  end;

var
  S: String;
begin
  if Key = VK_RETURN then
  begin
    if CheckBox1.Checked then
      S := Edit1.Text
    else
      S := GetFilterStr(Trim(Edit1.Text));

    // フィルター処理をします。
    ClientDataSet1.Filter := S;
    ClientDataSet1.Filtered :=True;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientDataSet1.Filtered := False;
end;


起動時

1



QTYフィールドで、フィルター処理

2



ITEMフィールドでフィルター処理

3



フィルター用に作成した計算フィールドでフィルター処理

4


5


6

.

7

|

Oracle Database XEを使ってみる。(ADO接続編)

いよいよDelphiからアクセスできるか試してみます。ユーザー HR で、サンプルデータベース Employees に接続してみます。

次のように、DBGrid1, DataSource1, ADOConnection1, ADOTable1を貼り付け、それぞれを設定します。又、ADOTable1.TableNameには Employees と入力しておきます。

Delphi1_2


ADOConnection1.ConnectionStringを設定します。「ビルド」ボタンを押します。

Delphi2_2


Oracle Provider for OLE DB を選択し、「次へ」ボタンを押します。

Delphi3_2


データソースに Localhost 、ユーザー名 hr とそのパスワードを設定します。

Delphi4_2


「接続のテスト」ボタンを押して接続できるか確認します。

Delphi5_2


ADOConnection1.Connected を True にすると、データベースログインダイアログが表示されました。

Delphi6_2


ADOTable1.Active を True にすると、きちんとデータが表示されています(^o^)

Delphi7_2


そのまま実行させると、今度は英語のデータベースログインダイアログが表示されました。

Delphi8


そして・・・きちんとデータが表示されています(^o^)

Delphi9_2


接続文字列はこんな感じです。

Provider=OraOLEDB.Oracle.1;Password=delphifan;Persist Security Info=True;
User ID=hr;Data Source=Localhost

|

Oracle Database XEを使ってみる。(サンプルアカウント アンロック編)

次のガイドに沿って、サンプルアカウントを使えるようにします。

Oracle® Database Express Edition Getting Started Guide(英語)
http://download.oracle.com/docs/cd/E17781_01/admin.112/e18585/toc.htm


1.サンプルアカウントを使えるようにします。
スタートメニューより、「SQLコマンドラインの実行」をクリックし、次のように処理します。
(文の最後に ; をつけないとエラーになりますので気をつけて下さい。又、delphifanとある部分は、適当なパスワードとして下さい。)

Unlock_hr




2.サンプルアカウントで、サンプルデータ(EMPLOYEES)を作成します。

Web管理メニューを起動して、ユーザー:systemでログインします。ログイン後、Application Expressをクリックします。

Login


Application Expressユーザー名は、ここで適当につけました。下図のように入力し、ワークスペースの作成ボタンを押します。

Login1


「ワークスペースHRが正常に作成されました。」と表示されます。「開始するにはここをクリック・・・」と書いてある部分をクリックします。

Login2


先ほど入力したユーザー名、パスワードでログインします。

Applicationexpress1


アプリケーション・ビルダーをクリックします。

Applicationexpress2


「作成」ボタンを押します。

Applicationexpress3


データベースを選択し、「次へ」ボタンを押します。

Applicationexpress4


「最初から」を選択し、「次へ」ボタンを押します。

Applicationexpress5


おそらく下図のように入力されているので、そのまま「次へ」ボタンを押します。

Applicationexpress6


レポートとフォームを選択し、「ページの追加」ボタンを押します。

Applicationexpress8


「作成」ボタンを押します。

Applicationexpress9


1レベルのタブを選択し、「次へ」ボタンを押します。

Applicationexpress10


いいえを選択し、「次へ」ボタンを押します。

Applicationexpress11


Application Expressを選択し、「次へ」ボタンを押します。

Applicationexpress12


テーマを適当に選択し、「次へ」ボタンを押します。

Applicationexpress13


「作成」ボタンを押します。

Applicationexpress14


アプリケーションは正常に作成されました。

Applicationexpress15


以上で、サンプルアカウント hr のアンロックとサンプルデータ Employees の設定が終わりました。

|

Oracle Database XEを使ってみる。(インストール編)

今度、会社のデータベースをOracle 10gから11gにするらしく、入れ替えが終わったら私の部署にも使わせてもらえるらしいです。ということなので、本格的にOracleの勉強でもしようかなと思っていましたが、設定さえしてもらえれば、あとはADOとSQLでなんとかなるかなと甘く考えています(^-^)

そこで、今回は、先月に正式リリースになったOracle Database Express Edition 11g Release 2をインストールしてみます。

ORACLE JAPAN
http://www.oracle.com/jp/index.html



まず次のリンクからダウンロードします。 ダウンロードには、無償のオラクルWebアカウントが必要になります。

Oracle Database Express Edition 11g Release 2
http://www.oracle.com/technetwork/database/express-edition/overview/index.html


表示されたページのDownloadsタブをクリックします。

Download1


次のページで、OTN License Agreement for Oracle Database Express Edition 11g Release 2(英語)を読んでからAccept License Agreementをクリックします。その後、Oracle Database Express Edition 11g Release 2 for Windows x32をクリックしてインストールファイル(OracleXE112_Win32.zip)をダウンロードします。

Download2



ダウンロードしたファイルを解凍し、Setup.exeを実行します。

1_2


2


3


4

ここで指定したパスワードはデータベースの管理ユーザーとして用意されているSYSTEMユーザーのパスワードとなります。

5


6


7


8



インストールが終わるとデスクトップに「Oracle Database 11g Express Editionのスタート・ガイド」というリンクファイルが作成されます。

Icon2



WEB型の管理ツールでも起動するのかなと思いながらクリックするとなんとエラーになりました。

Error



このメッセージの %HTTPPORT% 部分をインストール時にサマリーとして表示された「'Oracle HTTPリスナー'のポート: 8080」の8080に変えて入力すると、次のようなページが表示されました。

Web1



日本語にも対応しています。

Web2

|

Excel 2010を操作してみる。

Delphi XE2でも、ServersのTExcelApplicationは、Office 2000かOffice XPとなっているので、Excel2010のタイプライブラリを読み込んで試してみました。
次の処理で新規にブックを作成して、セルにデータ、罫線、スパークライン、データバーを設定し、そのシートをPDFにしています。手元にあるExcel VBAの本によるとスパークラインは、2010しか使えないようです。古いExcel+スパークラインアドインの場合は・・・知りません(^_^)


コンポーネントのインストールから、Microsoft Excel 14.0 Object Libraryを取り込みます。

Import_2



uses
  ComObj,
  Excel_TLB; // Microsoft Excel 14.0 Object Library ver1.7

const
  LCID: DWORD = LOCALE_SYSTEM_DEFAULT;

var
  ExcelApp : Excel_TLB.ExcelApplication;
  WorkBook : Excel_TLB.ExcelWorkbook;
  WorkSheet: Excel_TLB.ExcelWorksheet;

// ブック(ファイル)を閉じます。
procedure WorkBook_Close;
begin
  if ExcelApp.Visible[LCID] then
  begin
    Workbook.Close(
      False,        // SaveChanges  : OleVariant
      EmptyParam,   // FileName     : OleVariant
      False,        // RouteWorkBook: OleVariant
      LCID          // lcid         : Integer;
    );

    WorkSheet := nil;
    WorkBook  := nil;

    Sleep(50); // おまじない
  end;
end;

// ExcelApplicationを開始します。
procedure ExcelApplication_Create;
begin
  ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;
  ExcelApp.DisplayAlerts[LCID] := False;
end;

// ExcelApplicationを終了します。
procedure ExcelApplication_Close;
begin
  WorkBook_Close;

  if Assigned(ExcelApp) then
  begin
    ExcelApp.Quit;
    ExcelApp := nil;
  end;
end;

// PDF作成 WorkSheet
procedure WorkSheet_MakePDF(Open: Boolean);
var
  FileName: String;
begin
  FileName := IncludeTrailingPathDelimiter(Workbook.Path[LCID])+
    WorkSheet.Name+'.PDF';

  WorkSheet.ExportAsFixedFormat(
    xlTypePDF,         // Type_                 : XlFixedFormatType(xlTypePDF,xlTypeXPS)
    FileName,          // Filename              : OleVariant
    xlQualityStandard, // Quality               : OleVariant XlFixedFormatQuality(xlQualityStandard, xlQualityMinimum)
    True,              // IncludeDocProperties  : OleVariant
    True ,             // IgnorePrintAreas      : OleVariant
    EmptyParam,        // From                  : OleVariant
    EmptyParam,        // To_                   : OleVariant
    Open,              // OpenAfterPublish      : OleVariant // True:ODF作成後表示
    EmptyParam         // FixedFormatExtClassPtr: OleVariant
  );
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  DBar: Databar;
begin
  ExcelApplication_Create;
  try
    // ブックの新規作成
    WorkBook := ExcelApp.Workbooks.Add(EmptyParam, LCID);
    try
      // WorkSheetの設定
      WorkSheet := WorkBook.Worksheets['Sheet1'] as ExcelWorksheet;
      WorkSheet.Activate(LCID);

      // サンプルデータの設定
      WorkSheet.Range['C1',EmptyParam].Value2 := 'Period1';
      WorkSheet.Range['D1',EmptyParam].Value2 := 'Period2';
      WorkSheet.Range['E1',EmptyParam].Value2 := 'Period3';
      WorkSheet.Range['F1',EmptyParam].Value2 := 'Sparklines1';
      WorkSheet.Range['G1',EmptyParam].Value2 := 'Sparklines2';

      WorkSheet.Range['B2',EmptyParam].Value2 := 'Item1';
      WorkSheet.Range['B3',EmptyParam].Value2 := 'Item2';
      WorkSheet.Range['B4',EmptyParam].Value2 := 'Item3';

      WorkSheet.Range['C2',EmptyParam].Value2 := '120';
      WorkSheet.Range['C3',EmptyParam].Value2 := ' 50';
      WorkSheet.Range['C4',EmptyParam].Value2 := '200';

      WorkSheet.Range['D2',EmptyParam].Value2 := '130';
      WorkSheet.Range['D3',EmptyParam].Value2 := '180';
      WorkSheet.Range['D4',EmptyParam].Value2 := ' 80';

      WorkSheet.Range['E2',EmptyParam].Value2 := '200';
      WorkSheet.Range['E3',EmptyParam].Value2 := ' 30';
      WorkSheet.Range['E4',EmptyParam].Value2 := '230';

      // 列幅の設定
      WorkSheet.Range['C1','G1'].EntireColumn.AutoFit;

      // 罫線の設定
      WorkSheet.Range['B1','G4'].Borders.LineStyle := xlContinuous;

      // 外枠罫線
      WorkSheet.Range['B1','G4'].BorderAround(xlContinuous,xlMedium,
        0, EmptyParam, xlThemeColorAccent1);

      // スパークライン
      WorkSheet.Range['F2','F4'].SparklineGroups.Add(xlSparkLine,'C2:E4' );
      WorkSheet.Range['G2','G4'].SparklineGroups.Add(xlSparkColumn,'C2:E4' );

      // データバー
      DBar := (WorkSheet.Range['C2','E4'].FormatConditions.AddDatabar as Databar);
      DBar.BarFillType := xlDataBarFillGradient;
      // Excel2010では、BarColorでテーマの色が選べるみたいけど、タイプライブラリでは
      // property BarColor: IDispatch readonly dispid 2722;
      // と読み取り専用になっていますね。
      DBar.MinPoint.Modify(xlConditionValueNumber, WorkSheet.Range['E3',EmptyParam]);
      DBar.MaxPoint.Modify(xlConditionValueNumber, WorkSheet.Range['E4',EmptyParam]);

      // PDFの作成
      WorkSheet_MakePDF(True);
    finally
      WorkBook_Close;
    end;
  finally
    ExcelApplication_Close;
  end;
end;


実行すると次のようなPDFが作成されます。

1



Excelの操作については、Mr.XRAYさんのところにExcelに関するいろいろな処理がわかりやすくまとめられています。


Delphi Library [Mr.XRAY]
http://mrxray.on.coocan.jp/

|

JWWファイルの超簡易表示用コンポーネント for Delphi 2007(zipファイル)

[Delphi 2007]
今までの超簡易表示シリーズ?をコンポーネントにしたものがあったので、アップしておきますね。素人が試行錯誤の結果をまとめているものなので、(おられないとは思いますが)CAD処理の基本をこのソースで学ばないで下さい(笑)CAD作成に興味がある方は、AFSoftさんの「CAD作ろ!」をぜひご覧下さい。


AFSoft
http://afsoft.jp/index.html
左側のCADをクリックすると右側に「CAD作ろ!」のリンクが表示されます。




JWWファイルの超簡易表示用コンポーネント for Delphi 2007
「TJwwPanel.zip」をダウンロード

※JwwPanel.pasとJwwDraw.pasの2つのユニットからなります。 ※今回は、ソースが長いのでZIPファイルとしました。


このコンポーネントには、下記のユニットが必要になりますので、事前に用意して下さい。

[1] jww data read & save unit Ver1.40β

Peter's Room
http://be-sp.com/petrm/index.html
softwareのページからダウンロードできます。


[2] Delphi zlib

base2 technologies
http://www.base2ti.com/
現在のバージョンは、1.2.5です。



1.JWWファイルに同梱された画像は、「年月日-時分秒」フォルダ内に解凍します。
2.レイヤーは、レイヤ名を表示するのみです。
3.ブロックツリーも同様に名前を表示するのみで表示を切り替えません。
4.いろいろな部分がとにかく適当です。(^-^)



デザイン時(JWWPanelは、動的に作成します)

Design_2


テスト用コード
 

uses JwwPanel;

procedure TForm1.FormCreate(Sender: TObject);
var
  FileName: String;
begin
  JwwPanel1 := TJwwPanel.Create(Self);
  JwwPanel1.Parent := Self;
  JwwPanel1.Align := alClient;

  FileName := 'c:\jww\Aマンション平面例.jww';
  if FileExists(FileName) then
  begin
    JwwPanel1.FileName := FileName;
    JwwPanel1.BlockListTreeView := TreeView1;
    JwwPanel1.LayerTreeView := TreeView2;
    JwwPanel1.Active := True;
  end;
end;


実行時

Runtime_2



いくつかのファイルを試してみると、ファイルによっては、JwwUnitで、「ファイルの末尾以降を読み込みました」というエラーが表示されました。 私の場合、次のようにすることで読み込めたのですが、JWWファイルが壊れている可能性もあり、実際のところはよくわからないです。とりあえず参考までに載せておきますね。
 
1201-1215行
if JWWHd.JW_DATA_VERSION >= 700 then
begin
    // hiderin
    // Img: Integerとして宣言済み
    BlockRead(F,wd,2);
    if wd > 0 then
    begin
      Img := wd;
      BlockRead(F,wd,2);
      jwwRead_BundleImage(Img);
    end; 
    //次の2行がオリジナルです。
    // BlockRead(F,dw,4);
    // jwwRead_BundleImage(dw);
end;

|

Evernoteへメモを追加する。(添付ファイル付)

今回は、添付ファイルと共にメモを追加してみます。前回のソースにListView1, ImageList1, Splitter1を追加します。添付ファイルは、ExplorerからのDrag&Dropで取得します。ExplorerからのターゲットをMemo1としているため、Mr.XRAYさんところのSubClassコンポーネントを使わせて頂いています。(フォームをターゲットとして、WM_DROPFILESで処理するとサブクラスは必要はないです。)

Design


unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.ToolWin, Vcl.ComCtrls, Vcl.ImgList, SubClassUnit;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Title: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    Splitter1: TSplitter;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    SubClass1: TSubClass;
    procedure SubClass1MessageAfter(Sender: TObject;
      var Message: TMessage);
    procedure DropFiles(H: THandle);
    procedure MakeTempFile(FileName: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI,
     EncdDecd,            // BASE64 Encording
     IdHashMessageDigest; // MD5値

const
  Temp = 'Evernote.enex';
  S1 = '<?xml version="1.0" encoding="UTF-8"?>'+
       '<!DOCTYPE en-export SYSTEM "http://xml.evernote.com/pub/evernote-export.dtd">'+
       '<en-export>';  // エクスポートしたファイルには、その時の日時や
                       // EverNoteのバージョンが入っていますが、
                       // なくても動作しましたので、消しました。

  // 複数ある場合は、<note></note>までを繰り返す。
  S2 = '<note>';

  // ここにタイトル <title>タイトル</title>

  S3 = '<content>' +
       '<![CDATA[' +
       '<?xml version="1.0" encoding="UTF-8"?>' +
       '<!DOCTYPE en-note SYSTEM "http://xml.evernote.com/pub/enml2.dtd">'+
       '<en-note style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;">';

  // ここに本文・添付ファイル

  // e.g.)
  // 1行目文字-ファイル1-2行目文字-ファイル2、ファイル3-3行目文字の場合
  // <div>1行目文字</div>
  // <en-media hash="ファイル1のMD5値" style="cursor: default; vertical-align: middle;" type="application/octet-stream"/>
  // <div>2行目文字</div>
  // <div>
  // <en-media hash="ファイル2のMD5値" style="cursor: default; vertical-align: middle;" type="application/octet-stream"/>
  // <en-media hash="ファイル3のMD5値" style="cursor: default; vertical-align: middle;" type="application/octet-stream"/>
  // <div>3行目文字</div>
  // </div>
  F1 = '<en-media hash=';
  F2 = ' style="cursor: default; vertical-align: middle;" type="application/octet-stream"/>';

  S4 = '</en-note>' +
       ']]>' +
       '</content>';

  // ここに作成日時 <created>20111001T042516Z</created>
  // ここにタグ <tag>タグ1</tag> <tag>タグ2</tag>

  S5 = '<note-attributes>';

  // ここにURL <source-url>http://delphi-fan</source-url>

  S6 = '</note-attributes>';

  // ここに添付ファイル本体 - 複数ある場合は、<resource></resource>の繰り返し
  // <resource><data encoding="base64">
  //  ファイルデータ(BASE64でエンコード)
  // </data>
  // <mime>application/octet-stream</mime>
  // <resource-attributes>
  // <source-url>file://ファイル名(パス付)</source-url>
  // <file-name>ファイル名(パス無)</file-name>
  // </resource-attributes>
  // </resource>

  F3 = '<resource><data encoding="base64">';

  // ここにデータ

  F4 = '</data>';
  F5 = '<mime>application/octet-stream</mime>';
  F6 = '<resource-attributes>';
  F7 = '<source-url>file://';

  // ここにファイル名(パス付)

  F8 = '</source-url>';

  F9 = '<file-name>';

  // ここにファイル名(パス無)

  F10 = '</file-name>';
  F11 = '</resource-attributes>';
  F12 = '</resource>';

  S7 = '</note>';
  S8 = '</en-export>';


// Evernoteエクスポートファイル (ENEX)の作成
procedure TForm1.MakeTempFile(FileName: String);

  // UTCの日時-「年月日T時分秒Z」という文字列にします。
  function GetCreateDateTime: String;
  var
    UTC: TSystemTime;
  begin
    GetSystemTime(UTC);
  with UTC do
    Result := Format('%.2d%.2d%.2dT%.2d%.2d%.2dZ',
      [wYear,wMonth,wDay,wHour,wMinute,wSecond]);
  end;

  // ファイルをBASE64文字列で返します。
  function GetBody(const FileName: String): String;
  var
    MS: TMemoryStream;
  begin
    MS := TMemoryStream.Create;
    try
      MS.LoadFromFile(FileName);
      Result := EncodeBase64(MS.Memory, MS.Size);
    finally
      MS.Free;
    end;
  end;

  // ファイルのMD5値を取得します。
  function GetMD5(const FileName : String) : String;
  var
    idHMD5 : TIdHashMessageDigest5;
    FS : TFileStream;
  begin
    idHMD5 := TIdHashMessageDigest5.Create;
    FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    try
      // Evernoteエクスポートファイル (ENEX)では小文字が使われています。
      // 大文字のままで動作しましたが、一応元ファイルに合わせています。
      Result := AnsiLowerCase(idHMD5.HashStreamAsHex(FS));
    finally
      FS.Free;
      idHMD5.Free;
    end;
  end;

var
  SL1, SL2: TStringList;
  I: Integer;
  S: String;
begin
  SL1 := TStringList.Create;
  SL2 := TStringList.Create;
  try
    SL2.Delimiter := ',';
    SL2.StrictDelimiter := True;

    SL1.Add(S1);
    SL1.Add(S2);

    // タイトル
    SL1.Add('<title>'+Edit1.Text+'</title>');
    SL1.Add(S3);

    // 本文 1行目から<div></div>でいいみたい
    for I := 0 to Memo1.Lines.Count -1 do
      SL1.Add('<div>'+Memo1.Lines[I]+'</div>');

    // 添付ファイル - このサンプルでは、本文の最後にまとめて追加します。
    for I := 0 to ListView1.Items.Count -1 do
    begin
      S := ListView1.Items[I].SubItems[0]; // ファイル名
      SL1.Add(F1+'"'+GetMD5(S)+'"'+F2); // MD5
    end;

    SL1.Add(S4);

    // 作成日時
    SL1.Add('<created>'+GetCreateDateTime+'</created>');

    // タグ
    SL2.CommaText := Edit2.Text;
    for I := 0 to SL2.Count -1 do
      SL1.Add('<tag>'+SL2[I]+'</tag>');
    SL1.Add(S5);

    // URL
    if Trim(Edit3.Text) <> '' then
      SL1.Add('<source-url>' + Edit3.Text + '</source-url>');
    SL1.Add(S6);

    // ファイルデータ
    for I := 0 to ListView1.Items.Count -1 do
    begin
      S := ListView1.Items[I].SubItems[0]; // ファイル名
      SL1.Add(F3+GetBody(S)+F4+F5+F6);     // ファイルデータ
      SL1.Add(F7+S+F8);
      SL1.Add(F9+ExtractFileName(S)+F10+F11+F12);
    end;

    SL1.Add(S7);
    SL1.Add(S8);
    SL1.SaveToFile(FileName, TEncoding.UTF8);
    Sleep(50); // おまじない
  finally
    SL2.Free;
    SL1.Free;
  end;
end;

// ファイルを作成してEvernoteに読み込ませます。
procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: String;
  Param1, Param2: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + Temp;
  MakeTempFile(FileName);
  if FileExists(FileName) then
  begin
    Param1 := 'C:\Program Files\Evernote\Evernote\ENScript';
    Param2 := 'importNotes /s ' + FileName + ' /n ' + Edit4.Text;
    ShellExecute(Handle, 'OPEN', PWideChar(Param1), PWideChar(Param2), nil, SW_HIDE);
  end;
end;

// 同期
procedure TForm1.Button2Click(Sender: TObject);
var
  Param1, Param2: String;
begin
  Param1 := 'C:\Program Files\Evernote\Evernote\ENScript';
  Param2 := 'syncDatabase';
  ShellExecute(Handle, 'OPEN', PWideChar(Param1), PWideChar(Param2), nil, SW_HIDE);
end;

// 添付ファイルは、ExplorerからのDrag&Dropにて取得します。
procedure TForm1.FormCreate(Sender: TObject);
begin
  //ListView1.
  // サブクラスの設定
  SubClass1:= TSubClass.Create(Self);
  SubClass1.TargetControl := Memo1;
  SubClass1.OnMessageAfter := SubClass1MessageAfter;
  DragAcceptFiles(Memo1.Handle, True);
end;

procedure TForm1.SubClass1MessageAfter(Sender: TObject; var Message: TMessage);
begin
  case Message.Msg of
    WM_DROPFILES: DropFiles(Message.WParam);
  end;
end;

// 添付ファイル
procedure TForm1.DropFiles(H: THandle);

  // ファイルに関連付けられたアイコンを取出し、ImageListに追加します。
  function GetIconToImageList(FileName: String): Integer;
  var
    Icon : TIcon;
    SHFileInfo: TSHFileInfo;
  begin
     Icon:= TIcon.Create;
     try
       SHGetFileInfo(PChar(FileName), 0, SHFileInfo, SizeOf(SHFileInfo),
         SHGFI_SMALLICON or SHGFI_ICON);
       Icon.Handle := SHFileInfo.hIcon;
       Result := ImageList1.AddIcon(Icon);
     finally
       Icon.Free;
     end;
  end;

 // 実行ファイル、リンクファイルとフォルダは、添付ファイルにしない。
 function IsCorrectFileAsAttachment(FileName: String): Boolean;
 var
   S: String;
 begin
   S := UpperCase(ExtractFileExt(FileName));
   Result := (S <> '.LNK') or (S <> '.EXE') or (not FileExists(FileName));
 end;

var
  I, Count: Integer;
  FileName: array [0..255] of Char;
  Files: TStringList;
  S: String;
  LI: TListItem;
begin
  Files := TStringList.Create;
  try
    // ドロップされたファイルの取得
    Count := DragQueryFile(H, Cardinal(-1), nil, 0);
    for I:=0 to Count-1 do
    begin
      DragQueryFile(H, I, FileName, SizeOf(FileName)-1);
      Files.Add(FileName);
    end;
    DragFinish(H);

    // ListViewに追加します。
    for I := 0 to Files.Count - 1 do
    begin
      S := Files[I];
      if IsCorrectFileAsAttachment(S) then
      begin
        LI := ListView1.Items.Add;
        LI.Caption := ExtractFileName(S);
        LI.SubItems.Add(S);
        LI.ImageIndex := GetIconToImageList(S);
      end;
    end;
  finally
    Files.Free;
  end;
end;

end.


実行するとこんな感じ

Runtime



Evernoteではこんな感じ

Evernote




サブクラス用コンポーネント
Delphi Library [Mr.XRAY]
SubClassUnit
http://homepage2.nifty.com/Mr_XRAY/Halbow/Notes/N004.html

|

Evernoteへメモを追加する。

Evernoteに自分で作成したメモを簡単に追加できればいいなと思っていたのですが、EvernoteのAPIは、ThriftなのでDelphiから直接扱うことはできません。だからずっとあきらめていたのですが、先ほどENScriptというものを見つけました。

Evernote
Windowsでの開発
http://www.evernote.com/about/intl/jp/developer/windows.php


Evernoteがインストールされていることが前提条件なのですが、Evernote.exeをパラメーター付でわざわざ起動させるのなら、そのままEvernote使えばいいと思います。しかしENScriptならDelphiから直接メモを追加できそうな感じなので試してみました。

今回createNoteではなく、importNotesを使っているのは、どちらにしても書き込んだメモをファイルとして渡すのであれば、パラメーターが少ないimportNotesの方がすっきりすると考えたからです。 Evernoteエクスポートファイル (ENEX) の仕様は、単純なメモを出力させて、それに基づいて作成していますので、必ずしも正しいとは言えないかも知れません。

実行するとこんな感じ

Memotoevernote1


const
  Temp = 'Evernote.enex';
  S1 = '<?xml version="1.0" encoding="UTF-8"?>'+
       '<!DOCTYPE en-export SYSTEM "http://xml.evernote.com/pub/evernote-export.dtd">'+
       '<en-export>';  // エクスポートしたファイルには、その時の日時や
                       // EverNoteのバージョンが入っていますが、
                       // なくても動作しましたので、消しました。

  // 複数ある場合は、<note></note>までを繰り返す。
  S2 = '<note>';

  // ここにタイトル <title>タイトル</title>

  S3 = '<content>' +
       '<![CDATA[' +
       '<?xml version="1.0" encoding="UTF-8"?>' +
       '<!DOCTYPE en-note SYSTEM "http://xml.evernote.com/pub/enml2.dtd">'+
       '<en-note style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;">';

  // ここに本文

  S4 = '</en-note>' +
       ']]>' +
       '</content>';

  // ここに作成日時 <created>20111001T042516Z</created>
  // ここにタグ <tag>タグ1</tag> <tag>タグ2</tag>

  S5 = '<note-attributes>';

  // ここにURL <source-url>http://delphi-fan</source-url>

  S6 = '</note-attributes>' +
       '</note>';


  S7 = '</en-export>';


// Evernoteエクスポートファイル (ENEX)の作成
procedure TForm1.MakeTempFile(FileName: String);

  // UTCの日時-「年月日T時分秒Z」という文字列にします。
  function GetCreateDateTime: String;
  var
    UTC: TSystemTime;
  begin
    GetSystemTime(UTC);
  with UTC do
    Result := Format('%.2d%.2d%.2dT%.2d%.2d%.2dZ',
      [wYear,wMonth,wDay,wHour,wMinute,wSecond]);
  end;

var
  SL1, SL2: TStringList;
  I: Integer;
begin
  SL1 := TStringList.Create;
  SL2 := TStringList.Create;
  try
    SL2.Delimiter := ',';
    SL2.StrictDelimiter := True;

    SL1.Add(S1);
    SL1.Add(S2);

    // タイトル
    SL1.Add('<title>'+Edit1.Text+'</title>');
    SL1.Add(S3);

    // 本文
    for I := 0 to Memo1.Lines.Count -1 do
      if I = 0 then
        SL1.Add(Memo1.Lines[I])
      else
        SL1.Add('<div>'+Memo1.Lines[I]+'</div>');

    SL1.Add(S4);

    // 作成日時
    SL1.Add('<created>'+GetCreateDateTime+'</created>');

    // タグ
    SL2.CommaText := Edit2.Text;
    for I := 0 to SL2.Count -1 do
      SL1.Add('<tag>'+SL2[I]+'</tag>');
    SL1.Add(S5);

    // URL
    if Trim(Edit3.Text) <> '' then
      SL1.Add('<source-url>' + Edit3.Text + '</source-url>');
    SL1.Add(S6);
    SL1.Add(S7);
    SL1.SaveToFile(FileName, TEncoding.UTF8);
    Sleep(50); // おまじない
  finally
    SL2.Free;
    SL1.Free;
  end;
end;


// ファイルを作成してEvernoteに読み込ませます。
procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: String;
  Param1, Param2: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + Temp;
  MakeTempFile(FileName);
  if FileExists(FileName) then
  begin
    Param1 := 'C:\Program Files\Evernote\Evernote\ENScript';
    Param2 := 'importNotes /s ' + FileName + ' /n ' + Edit4.Text;
    ShellExecute(Handle, 'OPEN', PWideChar(Param1), PWideChar(Param2), nil, SW_HIDE);
  end;
end;

// 同期
procedure TForm1.Button2Click(Sender: TObject);
var
  FileName: String;
  Param1, Param2: String;
begin
  Param1 := 'C:\Program Files\Evernote\Evernote\ENScript';
  Param2 := 'syncDatabase';
  ShellExecute(Handle, 'OPEN', PWideChar(Param1), PWideChar(Param2), nil, SW_HIDE);
end;

Evernoteでは、こんな感じ

Memotoevernote2

ノートブックにないノートブックを指定した場合、ローカルノートブックとして新規作成されます。(Delphi_Newは、新規ノートブック)



Memotoevernote3

リストにあるノートブックの場合は、そこにメモが追加されています。(Delphi2は作成済みノートブック)



このサンプルのように、わざわざ入力用ボックスを分けるのであれば、Evernoteを使っているのと変わらないですが、メモの1行目はタイトル、2行目はタグというようにすれば入力も楽でメモとして使えるのではないかと思います。

※このプログラムでは、処理に失敗してもエラーメッセージが表示されません。ENScriptは、エラーを起こすと実行されたままになることがあり、その場合、タスクマネージャーから終了させて下さい。

|

« 2011年9月 | トップページ | 2011年11月 »