☆TOutlookApplicationを使ってみる。

Outlookから予定を取り出して、ガシェット風？に表示できないかなと思い、いままで一度も使ったことのないServersのTOutlookApplicationを試してみることにしました。

一応取得できるんですが、次のような問題があります。
１．パスワードが設定されている場合、パスワード入力ダイアログが表示される。
２．「アクセスを許可する時間」とかいうダイアログが出てきます。

１．については、Outlookが起動済みの場合は、NameSpace1.Logonにパスワードを設定すれば問題ないのですが、起動していない場合にはエラーになります。
２．については、Zaurusのリンクソフトでは表示されないので、何か方法があるはずだと思うのですが、Windowを監視してメッセージでボタンを押すぐらいのことしか思いつきませんでした。

※私の環境は、Delphi2006、Windows XP Pro SP2、Office XP Personalです。 又、このプログラムを会社のWindows XP Pro SP2、Office2003という環境でも試してみましたが、きちんと動作しました。

フォームに、OutlookApplication1、NameSpace1、Items1、Items2、Memo1を配置します。

uses DateUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  Appo: AppointmentItem;
  MF: MAPIFolder;
  Filter, S1, S2, S3, S4: String;
  SDate, EDate: TDateTime;
begin
  OutlookApplication1.Connect;
  try
    NameSpace1.ConnectTo(OutlookApplication1.GetNamespace('MAPI'));

    // OutLookが起動しているときには、次の処理は正常に動作しますが、
    // 起動していないときには、エラーになります。なんで？？
    // パスワードが設定されている場合
    // NameSpace1.Logon('個人用フォルダ', pw, False, False);

    NameSpace1.Logon('', '', False, False);
    try
      MF := NameSpace1.GetDefaultFolder(olFolderCalendar);
      if Assigned(MF) then
      begin
        Items1.ConnectTo(MF.Items);
        Items1.Sort('[START]', OleVariant(False));
        Items1.IncludeRecurrences := WordBool(True);

        // 検索開始日
        SDate := IncDay(Now, -3);

        // 検索終了日
        EDate := IncDay(Now, 90);

        // フィルター文字列の作成
        Filter := '([Start] > "' +
                  FormatDateTime('yyyy/mm/dd hh:nn',SDate) +
                  '") and ([Start] < "' +
                  FormatDateTime('yyyy/mm/dd hh:nn',EDate) + '")';

        // フィルター処理後のアポイントメントを設定します。
        Items2.ConnectTo(Items1.Restrict(Filter));

        // 先頭からnilになるまで、順番に取得していきます。
        Appo := (Items2.GetFirst as _AppointmentItem);
        Memo1.Lines.Clear;
        Memo1.Lines.BeginUpdate;
        try
          while Appo <> nil do
          begin
            S1 := FormatDateTime('yyyy/mm/dd hh:nn', Appo.Start);
            S2 := FormatDateTime('yyyy/mm/dd hh:nn', Appo.End_);
            S3 := Appo.Subject;
            S4 := Appo.Body;
            Memo1.Lines.Add(Concat(S1,#9,S2,#9,S3,#9,S4));
            Appo := (Items2.GetNext as _AppointmentItem);
          end;
        finally
          Memo1.Lines.EndUpdate;
        end;
      end;
    finally
      NameSpace1.Logoff;
    end;
  finally
    // OutlookApplication1.Quit; ←Outlookが起動していた場合、閉じてしまう。
    OutlookApplication1.Disconnect;
  end;
end;

borland.public.delphi.oleautomationの
Re: Problems with reading outlook calander
Darren Guy [Apr 22 2004, 16:37]
を参考にさせて頂きました。

☆JWWファイルの超簡易表示

JWWファイルとは、言わずと知れたJW_CAD(JW_WIN)のデータファイルです。
Peter's Roomで公開されているjww data read & save unit Ver1.2βを使って、簡単に線と文字を描画するサンプルです。座標系の処理をしないと描画できないので、AFsoftさんの「CAD作ろ」！のコードを使わせて頂きました。マウスのホイールによる拡大縮小と、右左同時クリックで範囲指定して拡大ができます。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    ox, oy: Integer;                   // 原点
    ImageWidth,ImageHeight: Integer;   // 画面ドットサイズ=Image1のサイズ
    PaperWidth, PaperHeight: Double;   // 用紙サイズ
    mm_dot: Double;                    // mm_dot比
    view_x1, view_y1, view_x2, view_y2: Double;  //ビューエリア
    DragStart_X, DragStart_Y: Integer; // ドラッグ開始点
    DragEnd_X, DragEnd_Y: Integer;     // ドラッグ終了点
    DragModeKind : Integer;            // ドラッグモード 0:移動 1:拡大 2:縮小
    DraggingNow : Boolean;             // ドラッグ中かどうかのフラグ
    RubberBandShow : Boolean;          // ラバーバンド表示フラグ
    procedure Calc_mm_dot;             // mm_dot比の計算
    procedure Calc_ViewArea;           // ビューエリアの計算
    procedure CLS;                     // 画面を消す
    procedure Draw_Paper_Frame;        // 用紙枠の描画
    procedure Drawdata;                // 図面の描画
    procedure RubberBand(x1, y1, x2, y2:Integer); // ラバーバンドの描画
    procedure SetPaperSize(PaperSize: Integer);   // 用紙サイズの設定
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses jwwunit; // jww data read & save unit Ver1.2β

procedure TForm1.FormCreate(Sender: TObject);
var
  FileName: String;
begin
  // 初期化
  DraggingNow := False;
  RubberBandShow := False;

  // ファイルの読み込み
  FileName := 'c:\jww\Ａﾏﾝｼｮﾝ平面例.jww';

  JWWBlockList := TJWWBlockList.Create;

  // JWWファイル読込み
  jwwRead(FileName);

  // 図面サイズの読み込み
  // A4～A0までしか扱えないようにする。いろいろあると面倒だから(^^;
  if not (JWWHd.m_nZumen in [0,1,2,3,4]) then
  begin
    ShowMessage('A0..A4の用紙サイズしか扱えません。');
    Exit;
  end;

  // 用紙サイズの設定
  SetPaperSize(JWWHd.m_nZumen);

  // mm_dot比の計算
  Calc_mm_dot;

  // ビューエリアの計算
  Calc_ViewArea;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  JWWBlockList.Free;
end;


procedure TForm1.FormResize(Sender: TObject);
begin
  // mm_dot比の計算
  Calc_mm_dot;

  // ビューエリアの計算
  Calc_ViewArea;
end;


// 用紙サイズの設定
{
  Paramater 用紙サイズ　
  0-A0
  1-A1
  2-A2
  3-A3
  4-A4
}
procedure TForm1.SetPaperSize(PaperSize: Integer); // 用紙サイズの設定
begin
  case PaperSize of
    0: begin //A0
         PaperWidth  :=1189;
         PaperHeight := 841;
       end;
    1: begin //A1
         PaperWidth  := 841;
         PaperHeight := 594;
       end;
    2: begin //A2
         PaperWidth  := 594;
         PaperHeight := 420;
       end;
    3: begin //A3
         PaperWidth  := 420;
         PaperHeight := 297;
       end;
    4: begin //A4
         PaperWidth  := 297;
         PaperHeight := 210;
       end;
  end;
end;


// mm_dot比の計算
procedure TForm1.Calc_mm_dot;
var
  P1, P2: Double;
begin
  ImageWidth  := PaintBox1.Width;
  ImageHeight := PaintBox1.Height;
  P1 := ImageWidth  / PaperWidth;
  P2 := ImageHeight / PaperHeight;

  if (P1 < P2) then
    mm_dot := P1
  else
    mm_dot := P2;
end;


// ビューエリアの計算
procedure TForm1.Calc_ViewArea;
begin
  view_x1 := - (ImageWidth  / 2.0) / mm_dot;
  view_y1 := - (ImageHeight / 2.0) / mm_dot;
  view_x2 :=   (ImageWidth  / 2.0) / mm_dot;
  view_y2 :=   (ImageHeight / 2.0) / mm_dot;
end;


//画面の消去
procedure TForm1.CLS;
begin
  PaintBox1.Canvas.Pen.Mode  := pmCopy;
  PaintBox1.Canvas.Pen.Color := clWhite;
  PaintBox1.Canvas.Pen.Style := psSolid;
  PaintBox1.Canvas.Pen.Width := 1;

  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.Rectangle(0, 0, ImageWidth, ImageHeight);
end;


//用紙枠の描画
procedure TForm1.Draw_Paper_Frame;
var
  x1, y1, x2, y2: Integer;
begin
  // 原点の計算
  ox := Round( (0.0 - view_x1) * mm_dot);
  oy := Round(-(0.0 - view_y2) * mm_dot);
  
  // 画面の消去
  CLS;

  // 用紙枠の描画
  x1 := Round( (-PaperWidth /2 - view_x1) * mm_dot);
  y1 := Round(-(-PaperHeight/2 - view_y2) * mm_dot);
  x2 := Round( ( PaperWidth /2 - view_x1) * mm_dot);
  y2 := Round(-( PaperHeight/2 - view_y2) * mm_dot);
  PaintBox1.Canvas.Pen.Color := clBlue;
  PaintBox1.Canvas.Brush.Style := bsClear;
  PaintBox1.Canvas.Rectangle(x1, y1, x2, y2);
end;


procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  cx, cy: Double;
  dx, dy: Double;
begin
  //2倍に拡大
  cx := (view_x1 + view_x2) / 2.0;  // ビュー中央のX座標
  cy := (view_y1 + view_y2) / 2.0;  // ビュー中央のY座標
  dx := Abs(view_x2 - view_x1);
  dy := Abs(view_y2 - view_y1);
  mm_dot := mm_dot * 2.0;
  view_x1 := cx - (dx / 4.0);
  view_y1 := cy - (dy / 4.0);
  view_x2 := cx + (dx / 4.0);
  view_y2 := cy + (dy / 4.0);
  Drawdata;
end;


procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  cx, cy: Double;
  dx, dy: Double;
begin
  // 1/2倍に縮小
  cx := (view_x1 + view_x2) / 2.0;  // ビュー中央のX座標
  cy := (view_y1 + view_y2) / 2.0;  // ビュー中央のY座標
  dx := Abs(view_x2 - view_x1);
  dy := Abs(view_y2 - view_y1);
  mm_dot := mm_dot * 0.5;
  view_x1 := cx - dx;
  view_y1 := cy - dy;
  view_x2 := cx + dx;
  view_y2 := cy + dy;
  Drawdata;
end;


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) or (ssRight in Shift) then
  begin
    DraggingNow := True;
    DragStart_X := X;
    DragStart_Y := Y;
    RubberBandShow := False;
    DragEnd_X := 0;
    DragEnd_Y := 0;

    if (ssLeft  in Shift) then
      DragEnd_X := 1;

    if (ssRight in Shift) then
      DragEnd_Y := 1;
  end;
end;


procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (DraggingNow) then
  begin
    if (RubberBandShow) then
      RubberBand(DragStart_X, DragStart_Y, DragEnd_X, DragEnd_Y);

    if (ssLeft in Shift) and (ssRight in Shift) then
    begin
      RubberBand(DragStart_X, DragStart_Y, X, Y);
      RubberBandShow := True;
      DragEnd_X := X;
      DragEnd_Y := Y;
    end;
  end;
end;


procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  x1, y1, x2, y2: Double;
  cx, cy: Double;
  dx, dy: Double;
  bx, by: Double;
  P1, P2: Double;
begin
  if (DraggingNow) then
  begin
    // ドラッグ処理の終了
    DraggingNow := False;
    if (RubberBandShow) then
      RubberBand(DragStart_X, DragStart_Y, DragEnd_X, DragEnd_Y);

    if (Abs(DragStart_X - X) <= 5) and (Abs(DragStart_Y - Y) <= 5) then
       DragModeKind := 0     // 移動
    else
      begin
        if (DragStart_X <= X) then
          DragModeKind := 1  // 拡大
        else
          DragModeKind := 2; // 縮小
      end;

    x1 := view_x1 + (DragStart_X / mm_dot);
    y1 := view_y2 - (DragStart_Y / mm_dot);
    x2 := view_x1 + (X / mm_dot);
    y2 := view_y2 - (Y / mm_dot);
    dx := Abs(view_x2 - view_x1);
    dy := Abs(view_y2 - view_y1);
    bx := Abs(x1 - x2);
    by := Abs(y1 - y2);
    cx := (x1 + x2) / 2.0;
    cy := (y1 + y2) / 2.0;

    case (DragModeKind) of
      0: begin    // 移動
           cx := (view_x1 +view_x2) / 2.0;
           cy := (view_y1 +view_y2) / 2.0;
           dx := x2 - cx;
           dy := y2 - cy;
           view_x1 := view_x1 + dx;
           view_y1 := view_y1 + dy;
           view_x2 := view_x2 + dx;
           view_y2 := view_y2 + dy;
         end;
      1: begin    // 拡大
           P1 := dx / bx;
           P2 := dy / by;

           if (P1 < P2) then
             mm_dot := mm_dot * P1
           else
             mm_dot := mm_dot * P2;

           view_x1 := cx - ((ImageWidth  / 2.0) / mm_dot);
           view_y1 := cy - ((ImageHeight / 2.0) / mm_dot);
           view_x2 := cx + ((ImageWidth  / 2.0) / mm_dot);
           view_y2 := cy + ((ImageHeight / 2.0) / mm_dot);
         end;
      2: begin    // 縮小
           P1 := bx / dx;
           P2 := by / dy;

           if (P1 > P2) then
             mm_dot := mm_dot * P1
           else
             mm_dot := mm_dot * P2;

           view_x1 := cx - ((ImageWidth  / 2.0) / mm_dot);
           view_y1 := cy - ((ImageHeight / 2.0) / mm_dot);
           view_x2 := cx + ((ImageWidth  / 2.0) / mm_dot);
           view_y2 := cy + ((ImageHeight / 2.0) / mm_dot);
         end;
    end;
    Drawdata;
  end
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Drawdata;
end;


// ラバーバンド長方形描画
procedure TForm1.RubberBand(x1, y1, x2, y2:Integer);
begin
  PaintBox1.Canvas.Pen.Mode := pmXor;
  PaintBox1.Canvas.Pen.Color := clAqua;
  PaintBox1.Canvas.Pen.Width := 0;
  PaintBox1.Canvas.Pen.Style := psSolid;
  PaintBox1.Canvas.Brush.Style := bsClear;
  PaintBox1.Canvas.Rectangle(x1,y1,x2,y2);
end;


// CADデータの描画
procedure TForm1.Drawdata;

  // 座標を変換
  procedure Change_mm_dot(x1, x2, y1, y2: Double;
    var ix1, ix2, iy1, iy2: Integer);
  begin
    ix1 := Round( x1 * mm_dot + ox );
    iy1 := Round(-y1 * mm_dot + oy );
    ix2 := Round( x2 * mm_dot + ox );
    iy2 := Round(-y2 * mm_dot + oy );
  end;

var
  I: Integer;
  x1, x2, y1, y2: Double;
  ix1, ix2, iy1, iy2: Integer;
  Moji: String;
begin
  // 一番肝心な部分ですが、とりあえず線と文字を
  // 単純に描画しています。

  // 用紙枠の描画
  Draw_Paper_Frame;

  PaintBox1.Canvas.Pen.Color := clBlack;
  for I := Low(JWWSen) to High(JWWSen)  do
  begin
    x1 := JWWSen[I].m_start_x;
    y1 := JWWSen[I].m_start_y;
    x2 := JWWSen[I].m_end_x;
    y2 := JWWSen[I].m_end_y;

    // mm→dot変換
    Change_mm_dot(x1, x2, y1, y2, ix1, ix2, iy1, iy2);

    //線の描画
    PaintBox1.Canvas.Pen.Width := 0;
    PaintBox1.Canvas.MoveTo(ix1, iy1);
    PaintBox1.Canvas.LineTo(ix2, iy2);
  end;

  PaintBox1.Canvas.Font.Size := 6;
  for I := Low(JWWMoji) to High(JWWMoji)  do
  begin
    x1 := JWWMoji[I].m_start_x;
    y1 := JWWMoji[I].m_start_y;
    x2 := JWWMoji[I].m_end_x;
    y2 := JWWMoji[I].m_end_y;
    Moji := JWWMoji[I].m_string;

    // mm→dot変換
    Change_mm_dot(x1, x2, y1, y2, ix1, ix2, iy1, iy2);

    //文字の描画
    PaintBox1.Canvas.TextOut(ix1, iy1, Moji);
  end;
end;

end.

☆Jw_cad

☆AFsoft
CADに必要な数学の解説からCADの具体的な実装まで、豊富なDelphiのサンプルと共に詳しく解説されています。 又、JWW用の便利なソフトをたくさん公開しておられます。

☆Peter's Room
jww data read & save unit Ver1.2β
MicroArtsさんが公開されていたJww読込みユニットをPeter.さんが拡張されたものだそうです。
利用に際しては、ユニットの記載内容をお読み下さい。

[20071109訂正]
for I := Low(JWWMoji) to High(JWWMoji) -1 do
for I := Low(JWWSen) to High(JWWSen) -1 do
上記のところ、High関数を使っているのに-1していましたので、-1を削除しました。

■カテゴリーを変更しました。

元々、Delphi8を購入したときにDelphi.NETの話題を書こうと立ち上げたブログなので、Delphi.NETかどうかという視点で分類するつもりでした。ところが、実際にはWin32の内容がほとんどとなってきて、カテゴリーがわけわかんない状態になって しまっていたので、カテゴリーを変更しました。

☆検索文字列の分解？

SQLで、複数の単語での検索ができるように、検索文字列を分解するコードを書いてみました。
ここでの検索文字列は、半角及び全角スペースをDelimiterと判断します。" "で括られたものはそのまま空白も取得します。

// 検索文字列Sを分解して、SLに設定します。
// Delimiterは、半角及び全角スペースです。
// ex)コンクリート "床　モルタル鏝押エ" t=
//  下記の３つに分けます。
//  コンクリート
//  床　モルタル鏝押エ
//  t=
function SearchStrPaser(const S: String; var SL: TStringList): Boolean;
var
  P: PChar;
  I, Len: Integer;
  Str: String;
  F: Boolean;
  wc: word;
begin
  try
    SL.Clear;
    Str := '';
    P := PChar(S);
    Len := Length(S);
    F := False;
    I := 1;
    repeat
      if IsDBCSLeadByte(Byte(P^)) then
        begin
          wc := (Byte(P^) shl 8) or Byte((P+1)^);
          if (not F) and (wc = $8140) then
            begin
              SL.Add(Str);
              Str := '';
              Inc(P);
              Inc(I);
            end
          else
            begin
              Str := Str + P^;
              Inc(P);
              Inc(I);
              Str := Str + P^;
            end;
          end
      else if (P^ = #34) then              { #34(") }
        F := not F
      else if (not F) and (P^ = #32) then  { #32(半角スペース) }
        begin
          SL.Add(Str);
          Str := '';
        end
      else
        Str := Str + P^;
      Inc(P);
      Inc(I);
    until I > Len;
    SL.Add(Str);
    Result := True;
  except
    Result := False;
  end;
end;

☆照合順序 COLLATE

これもDelphiの話ではなくSQL Serverの話です。
SQL Serverでは、文字列の照合時に COLLATE を使うと半角全角を無視したり、反対に厳格にしたりできます。

[Field1のデータ]
コンクリート
こんくりーと
ｺﾝｸﾘｰﾄ

（A）
SELECT FIELD1 FROM TABLE1 WHERE FIELD1 COLLATE
 Japanese_BIN LIKE '%こんくりーと%'

[表示結果]
こんくりーと

（B）
SELECT FIELD1 FROM TABLE1 WHERE FIELD1 COLLATE
 Japanese_CI_AS LIKE '%こんくりーと%'

[表示結果]
コンクリート
こんくりーと
ｺﾝｸﾘｰﾄ

上記の例については、いまさら説明は要らないかも知れませんね。
ただ、私がはまったのは次のようなものでした。

[FIELD1のデータ]
コンクリート
こんくりーと
ｺﾝｸﾘｰﾄ

[FIELD2のデータ]
null
null
fc=21

（A）
SELECT FIELD1 FROM TABLE1 WHERE (FIELD1+' '+FIELD2) COLLATE
 Japanese_BIN LIKE '%こんくりーと%'

[表示結果]
なし

（B）
SELECT FIELD1 FROM TABLE1 WHERE (FIELD1+' '+FIELD2) COLLATE
 Japanese_CI_AS LIKE '%こんくりーと%'

[表示結果]
ｺﾝｸﾘｰﾄ

FIELD2を足しただけなのになんで期待した結果にならないのだろう？とずっと悩んでしまいました。結局、文字列＋NULLになっていることに気づいたときには、なんでこんな初歩的なことで・・・とショックでした。
対応策としては、FIELD1とFIELD2を分けて、それぞれの照合をORで繋ぐか、テーブル作成時にNULLを許可しない等の工夫が必要になるようです。

☆XQuery 親ノードへのアクセス

再び、SQL Server 2005 Express Edition、XQueryの話です。
前回、XQUERYってややこしいっ！で使ったようなXMLを格納したフィールドで、あるノードの親ノードのIDを取得する処理を考えてみました。

//IDが456の親ノードのIDを取得する場合
// query, parent, returnは小文字でないと動きません。
SELECT CAST(TREEXML.query('
for $RESULT1 in //item[@id=456]/parent::item, 
$RESULT2 in (data($RESULT1/@id)) return $RESULT2
') as VARCHAR)
FROM dbo.KUBUN

上記の処理で親ノードのIDを取得できたので、これをストアドかユーザー定義関数内でループさせると、あるノードまでの パスを返すことができると思い試してみましたが、ここで問題が発生しました。というのもSQL Serverでの変数は、@node_idのように@を付ける必要があり、この仕様が、XMLのPATH式での属性を示す@(attribute)とかぶってしまうからです。結局、これを解決できずにADOQureyを使って次のように処理することにしました。

function TDataModule1.GetParentIDs(MyID: Integer): String;
const
  TopNodeID = 1; //一番上ノードのID
var
  SQL: String;
  I: Integer;
begin
  Result := '';
  while true do
  begin
    SQL := 'SELECT CAST(TREEXML.query(''for $RESULT1 in //item[@id=';
    SQL := SQL + IntToStr(MyID) + ']/parent::item, ';
    SQL := SQL + '$RESULT2 in (data($RESULT1/@id)) return $RESULT2'') ';
    SQL := SQL + 'AS VARCHAR) ';
    SQL := SQL + 'AS MyID FROM dbo.KUBUN';
    ADOQuery1.Close;
    ADOQuery1.SQL.Text := SQL;
    ADOQuery1.Open;

    // このSQLは指定IDを見つけてその親IDを返すため、
    // 一番上ノードのIDを与えるとエラーになります。
    // なので、そのIDになったときに処理を終了させます。
    if ADOQuery1.Eof then Break;
    I := ADOQuery1.FieldValues['MyID'];

    if I = TopNodeID then Break;

    Result := Result + '/' + IntToStr(I);
    MyID := ADOQuery1.FieldValues['MyID'];
  end;
  ADOQuery1.Close;
end;

☆WebBrowserでHTMLな文字列を直接表示させる。

WebBrowserで、一時ファイルを使わずに、HTMLを直接表示させるには、次のような処理をしていました。 CSSを指定する必要もなく常に新規ウィンドウで表示させていたので、特に問題がなかったのですが、時々 target="_blank"を書き忘れたりして、OLEエラーが発生していました。

//HTMLのリンク先が同じウィンドウで開くときに問題のあるコード
//って、使ってたんですけど(^^;

uses ActiveX, MSHTML;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate('about:blank');
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  (WebBrowser1.Document as IHTMLDocument2).body.innerHTML :=
  '<a href="http://hiderin.air-nifty.com/delphi/"' + 
  ' target="_blank">delphi-fan</a>';
end;

フラグを立てて、プログラム側から設定した文字列以外は読み込まないようにすれば問題ないかも知れませんが、次のリンク先にあるコードを使って解決しました。

about.com Delphi Programming
How to load HTML directly to a WebBrowser

☆ADOQueryを使ってImage型を読み書きする。

今までADOでImage型を扱ったことがなく、かなり試行錯誤した結果です(笑) ネット上でもサンプルがあまりないんですよね。 データベースは、例によって、SQL Server 2005 Express Editionです。

procedure TForm1.FormCreate(Sender: TObject);
begin
  ADOQuery1.Close;
  ADOQuery1.SQL.Text := 'SELECT IMG FROM dbo.DETAIL';
  ADOQuery1.Open;
end;

// Image型フィールドに書き込みます。
procedure TForm1.Button1Click(Sender: TObject);
var
  Stream : TADOBlobStream;
begin
  ADOQuery1.Edit;
  Stream := TADOBlobStream.Create(
    TBlobField(ADOQuery1.FieldByName('IMG')), bmWrite);
  Stream.LoadFromFile('c:\aa.jpg'); // BitmapかJpegしか保存しない仕様
  Stream.Free; //Postする前に開放しないとエラーになります。
  ADOQuery1.Post;
end;

// Image型フィールドから読み込みます。
procedure TForm1.Button2Click(Sender: TObject);

  // Bitmapかどうかを判定します。
  function IsBitmap(var Stream: TStream): Boolean;
  var
    Bmfh: TBitmapFileHeader;
  begin
    Stream.ReadBuffer(Bmfh, sizeof(Bmfh));
    Result := (Bmfh.bfType = $4D42);
    Stream.Position := 0; // 先頭に戻しておきます。
  end;

var
  Stream : TADOBlobStream;
  Pic : TPicture;
  Jpeg : TJpegImage;
begin
  Stream := TADOBlobStream.Create(
    TBlobField(ADOQuery1.FieldByName('IMG')), bmRead);
  Pic:=TPicture.Create;
  Jpeg := TJpegImage.Create;
  try
    Stream.Position := 0;
    if IsBitmap(TStream(Stream)) then
        Pic.Bitmap.LoadFromStream(Stream)
    else
      begin
        Jpeg.LoadFromStream(Stream);
        Pic.Assign(Jpeg);
      end;
    Image1.Picture.Assign(Pic);
  finally
    Jpeg.Free;
    Pic.Free;
    Stream.Free
  end;
end;

■Delphiの入門書

今日、本屋で「Turbo DelphiではじめるWindowsプログラミング」という本を見つけました。 いまどきDelphiの入門書なんて珍しいなと思いながら、パラパラと見てたんですけど、フックとかCOMとかのサンプルもあって、入門書にしては少しレベルが高いかなと感じました。
こういう本が出版されることによって、少しでもユーザーが増えるといいんですけどね。あっ、でもちょっと試してみようかなという人にとっては、2,520円は高すぎると思うんですけど・・・。

日経BP
Turbo DelphiではじめるWindowsプログラミング

■同期編集モード

Delphi 2006のエディタで、マウスでコードを選択していくと左側にアイコンが現れます。
（このアイコン、双眼鏡だと思っていたら、どうやら２本のペンをイメージしているようです）
そしてこのアイコンをクリックすると、同期編集モードというものになります。これは、ある変数を書き換えると、その選択範囲内の同じ変数も書き換わるという機能です。マウスを使うと選択範囲が解除されるので、タブキーで移動が正しい使い方のようですね。
（って、書きましたが、選択範囲内であればマウスも使えますね）
今まで、名前の書き換えは、置換やリファクタリングを使っていましたが、これも使えそうです。またまだ知らないというか使っていない機能がたくさんあるんですね。
（コメントアウトにするのに、CRTL+/ で切り替えられるのも今知りました。）

■XQUERYってややこしいっ！

XQUERYのサンプルって、階層がきちんと揃ったものは、結構あるのですが、 次のような階層が自由なものについては、なかなか見つけられないですね。
（こういうのは、XMLデータとしてふさわしくないのかな）

<?xml version="1.0" ?>
<koumoku>
  <item text="AAA" id="1">
    <item text="BBB" id="2">
      <item text="CCC" id="3" />
      <item text="DDD" id="4" />
    </item>
    <item text="EEE" id="5">
      <item text="FFF" id="6">
        <item text="GGG" id="7" />
        <item text="HHH" id="8" />
      </item>
    </item>
  </item>
</koumoku>

このXMLから、属性idを検索して、属性textの値を取得するのに丸一日悩んでました。 Delphiとはあまり関係ないのですが、せっかくなので書いておきますね。
(Microsoft SQL Server: SQL Server 2005 Express EditionのXML型に格納)

SELECT TREEXML.query('
for $RESULT1 in //item[@id=8], 
$RESULT2 in (data($RESULT1/@text)) return $RESULT2')
FROM dbo.KUBUN

結果として 属性ｉｄ 8を持つアイテムの属性text HHH を取得できます。

アプリケーションからデータベースを操作する上で、親ノードを調べたり、更新等を考えるとXML型のメリットってなんだろうと疑問に思ってしまいます。今までも、再帰処理により階層データを扱ってきたんだし、１００歩譲ってXML型にしても、文字型にそのまま出し入れするだけでもいいような気になってます。もっともっと、基本から勉強しないといけないですね。


XQUERYについて
XQuery 1.0: An XML Query Language
W3C Recommendation 23 January 2007
XQuery Update Facility
W3C Working Draft 11 July 2006

☆XML型フィールドとXQUERY

一つのフィールドにXMLを入れて処理するなんて・・・と古い考えの私ですが、Microsoft SQL Server 2005 Express Editonを使って試してみました。

※1200アイテム程のXMLをXQUERYで取り出し、TreeViewに設定しています。

procedure TForm1.Button1Click(Sender: TObject);
const
   Header = '<?xml version="1.0" encoding="shift_jis"?>';
var
  S: String;
begin
  ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.Add(
    'SELECT EST.query(''//koumoku'') AS XML_SAMPLE FROM SEKISAN.dbo.EST_KOU');
  ADOQuery1.Open;
  try
    S := Header + ADOQuery1.FieldValues['XML_SAMPLE'];
    XMLDocument1.XML.Text := S;
    XMLDocument1.Active := True;
    //TreeViewに設定
    XML2Tree(TreeView1,XMLDocument1);
  finally
    ADOQuery1.Close;
  end;
end;

※ADOの接続文字列に、DataTypeCompatibility=80を設定する必要があります。
※XMLの一部だけ取得するクエリの場合、XMLDocumentで
　「ドキュメント内では最上位の要素に限り、使用できます」というエラーが発生します。
　この場合には、<dummy>+取得した文字列+</dummy>とすれば、解決します。

テーブル内を再帰的に検索しながら、TreeViewに設定するよりもプログラムがすっきりします。 しかし、ノードの入れ替え等が発生した場合には、どうすればいいんでしょうね。 全部書き直すか、順番コードをつけるか・・・うーん、これってXMLじゃない場合と同じ悩みですね。 更新や削除処理は、まだ試していませんが、表示を中心につかう場合には、とても効果的だと感じました。

参考にしたサイト
about.com
Exporting a TreeView to XML. Populating a TreeView from XML

SQL Server 2005 Books Online
アプリケーションでの xml データ型の操作