リストボックス間のアイテムを線でつなぐには？

わんこ 2012-03-24 11:51:09 No: 41809

こんばんは。
MS-Accessのクエリデザインのような、２つのリストボックス間の
アイテム同士を結びつけるような表示は、どのように扱えばよいでしょうか？
アイテムの管理方法や描画などについてアドバイスをいただけると嬉しいです。

Nov 2012-03-24 23:54:43 No: 41810

もし、適切なコンポーネントなどの情報をお探しの場合は無視してください。
以下は、自前で何とかしようとする場合の方法の一つです。
MS-Accessのクエリデザインは分かりませんが、
(1)TListBoxのアイテムの座標は、ItemRect関数を使って取得できます。クライアント座標なので変換が必要だと思いますが。
(2)Itemsプロパティはオブジェクトのポインタを持てるので、結びつける相手のItemIndexを保存しておくのはどうでしょうか。相手が複数の場合はリストを保存するなどの工夫が必要かもしれません。
(3)描画は、FormのOnPaintイベントで描画すれば良いと思いますが、アイテム選択時のイベントでもFormのRefreshが必要かもです。

わんこ 2012-03-27 09:56:17 No: 41811

Novさん、レスありがとうです。
私は、できれば自前でなんとかしたいと思っていますが、スキルが足りない気がします。
クエリのなんたら〜というのは、↓のようなものです。
ttp://ms-access.up.seesaa.net/image/access-query247.gif
ItemRectで検索してみましたが、↓の応用といった感じでしょうか…
ttp://d.hatena.ne.jp/au2010/20110627/1309177414
ポインタも使ったことがないので、ちょっと勉強してみます。
（^がつくやつですよね？）

Nov 2012-03-27 11:05:21 No: 41812

(2)のオブジェクトのポインタとういうのは語弊があったかも知れません。
単純に、何らかの値を保存することもできるということが言いたかったのです。
自分もスキルは足りてないですが、試しに書いてみました。
リストボックスを２つ配置しただけの簡単なものなので、どこまで要求に
答えられているかわかりませんが...

// メインフォームのOnCreateイベント
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;
  for i := 0 to 9 do begin
    ListBox1.Items.AddObject('Item1-'+IntToStr(i), TObject(9-i));
    ListBox2.Items.Add('Item1-'+IntToStr(i));
  end;
  ListBox1.Height := (ListBox1.ItemHeight)*5+4;
  ListBox2.Height := (ListBox2.ItemHeight)*5+4;
  ListBox1.ItemIndex := 0;
  ListBox2.ItemIndex := 0;
end;

// メインフォームのOnPaintイベント
procedure TForm1.FormPaint(Sender: TObject);
var
  rc: TRect;
  pt0, pt1, pt: TPoint;
begin
  rc := ListBox1.ItemRect(ListBox1.ItemIndex);
  pt := ListBox1.ClientToScreen(rc.TopLeft);
  pt := ScreenToClient(pt);
  pt0.X := ListBox1.Left+ListBox1.Width;
  pt0.Y := pt.Y+rc.Height div 2;
  ListBox2.ItemIndex := Integer(ListBox1.Items.Objects[ListBox1.ItemIndex]);
  rc := ListBox2.ItemRect(Integer(ListBox1.Items.Objects[ListBox1.ItemIndex]));
  pt := ListBox1.ClientToScreen(rc.TopLeft);
  pt := ScreenToClient(pt);
  pt1.X := ListBox2.Left;
  pt1.Y := pt.Y+rc.Height div 2;
//  Canvas.Lock;  <= OnPaintでも必要なのか、教えてほしい...
  Canvas.Pen.Color := clBlack;
  Canvas.PenPos := pt0;
  Canvas.LineTo(pt1.X, pt1.Y);
//  Canvas.Unlock;
end;

// リストボックス１のOnClickイベント
procedure TForm1.ListBox1Click(Sender: TObject);
begin
Form1.Refresh;
end;

// リストボックス２のOnClickイベント
procedure TForm1.ListBox2Click(Sender: TObject);
begin
Form1.Refresh;
end;

Nov 2012-03-27 11:13:10 No: 41813

あぁ、また間違えた... メインフォームのOnCreateイベントがだめですね。
発言のプレビューがあればいいなぁ。

// メインフォームのOnCreateイベント
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;
  for i := 0 to 9 do begin
    ListBox1.Items.AddObject('Item1-'+IntToStr(i), TObject(9-i));
    ListBox2.Items.Add('Item1-'+IntToStr(i));
  end;
  ListBox1.Height := (ListBox1.ItemHeight)*10+4;  // アイテムが隠れると、座標がはみ出るので、アイテム数に応じた高さが必要
  ListBox2.Height := (ListBox2.ItemHeight)*10+4;
  ListBox1.ItemIndex := 0;
  ListBox2.ItemIndex := 0;
end;

ぽむぽむ 2012-03-27 23:48:24 No: 41814

別のアプローチで
<<宣言部その１>>

type
  TListBox      =class(StdCtrls.TListBox)
  private
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoUpdateLink;
  public
    property Caption;
  end;

  TListItemLinkObject=class(TCollectionItem)
  protected
    //ここでのTListBoxは↑のTListBox
    FLinkFromListBox: TListBox;
    FLinkFromIndex: Integer;
    FLinkToListBox: TListBox;
    FLinkToIndex: Integer;
  protected
    procedure DrawLinkLine(aCanvas: TCanvas);
  end;

  TListItemLinkList=class(TCollection)
  public
    constructor Create;
    procedure AddItem(aFromList, aToList: TListBox;
                aFromIndex, aToIndex: Integer);
    procedure DrawLinkLine(aCanvas: TCanvas);
  end;

ぽむぽむ 2012-03-27 23:49:06 No: 41815

<<実装部その１>>

{ TFloatListBox }
procedure TListBox.WMSize(var Message: TWMSize);
begin
  inherited;
  DoUpdateLink;
end;
procedure TListBox.WMMove(var Message: TWMMove);
begin
  inherited;
  DoUpdateLink;
end;
procedure TListBox.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  DoUpdateLink;
end;
procedure TListBox.WMMouseWheel(var Message: TWMMouseWheel);
begin
  inherited;
  DoUpdateLink;
end;

procedure TListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_THICKFRAME or WS_CAPTION;
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW;
end;

procedure TListBox.DoUpdateLink;
begin
Parent.RePaint;
end;

{ TListItemLinkObject }
procedure TListItemLinkObject.DrawLinkLine(aCanvas: TCanvas);
  //ListBoxの指定インデックスに位置への描画開始座標取得
  function getListBoxLineStart(aListBox: TListBox; aIndex: Integer; aLeft: Boolean): TPoint;
  var
    topidx: Integer;
    ctrlEdge,
    titleHeight: Integer;
    visibleCount: Integer;
    scrollInfo: TScrollInfo;
  begin
    Result := Point(aListBox.Left,aListBox.Top);

    //スクロールバーの表示有無
    FillChar(scrollInfo, SizeOf(TScrollInfo), 0);
    scrollInfo.cbSize := SizeOf(TScrollInfo);
    scrollInfo.fMask := SIF_ALL;
    GetScrollInfo(aListBox.Handle, SB_VERT, scrollInfo);
    //コントロール幅とリスト幅（クライアント領域）の差が境界部分の幅として計算
    if scrollInfo.nMax >= scrollInfo.nPage then begin
      ctrlEdge := (aListBox.Width - aListBox.ClientWidth -
                   GetSystemMetrics(SM_CYVSCROLL)) div 2;
    end
    else begin
      ctrlEdge := (aListBox.Width - aListBox.ClientWidth) div 2;
    end;
    //コントロールの高さから、クライアント領域の高さ、下部境界を引いたものがタイトルバー部分
    titleHeight := aListBox.Height - aListBox.ClientHeight - ctrlEdge;
    //X座標
    if aLeft then begin
      //左側
    end
    else begin
      //右側
      Result.X := Result.X + aListBox.Width;
    end;

    //Y座標
    topidx := aListBox.TopIndex;
    if aIndex < topidx then begin
      //表示範囲の上方にリンクするインデックスがある場合
      Result.Y := Result.Y + titleHeight div 2;
    end
    else if aListBox.Style = lbOwnerDrawVariable then begin
      //めんどくさいので割愛
    end
    else begin
      //可視項目数
      visibleCount := Trunc(aListBox.ClientHeight / aListBox.ItemHeight);

      if (topidx + visibleCount - 1) < aIndex then begin
        //可視項目より下方にあり
        Result.Y := Result.Y + aListBox.Height - 1;
      end
      else begin
        Result.Y := Result.Y + titleHeight +
                        Round(aListBox.ItemHeight * (aIndex - topidx + 0.5));
      end;
    end;
  end;
const
  LINE_COLOR=clBlue;
  PALSIZE:array[Boolean] of Integer = (12, -12);
var
  startPos: array[0..1] of TPoint;
  leftPos: array[0..1] of Boolean;
  i: Integer;
begin
  //それぞれのListBoxの描画開始位置を計算する
  //左右判定
  leftPos[0] := (FLinkFromListBox.Left + FLinkFromListBox.Width / 2) >= FLinkToListBox.Left;
  leftPos[1] := (FLinkToListBox.Left + FLinkToListBox.Width / 2) >= FLinkFromListBox.Left;
  //描画開始位置の計算
  startPos[0] := getListBoxLineStart(FLinkFromListBox, FLinkFromIndex, leftPos[0]);
  startPos[1] := getListBoxLineStart(FLinkToListBox, FLinkToIndex, leftPos[1]);
  //線描画
  aCanvas.Pen.Color := LINE_COLOR;
  aCanvas.Pen.Mode := pmCopy;
  //リストボックスから横に延びる線
  aCanvas.Pen.Width := 3;
  for i := 0 to 1 do begin
    aCanvas.MoveTo(startPos[i].X + PALSIZE[leftPos[i]], startPos[i].Y);
    aCanvas.LineTo(startPos[i].X, startPos[i].Y);
    startPos[i].X := startPos[i].X + PALSIZE[leftPos[i]];
  end;
  //横に延ばした線同士の結線
  aCanvas.Pen.Width := 1;
  aCanvas.MoveTo(startPos[0].X, startPos[0].Y);
  aCanvas.LineTo(startPos[1].X, startPos[1].Y);
end;

{ TListItemLinkList }
constructor TListItemLinkList.Create;
begin
inherited Create(TListItemLinkObject);
end;

procedure TListItemLinkList.AddItem(aFromList, aToList: TListBox;
                aFromIndex, aToIndex: Integer);
var
  itm: TListItemLinkObject;
begin
  itm := TListItemLinkObject(Add);
  itm.FLinkFromListBox := aFromList;
  itm.FLinkFromIndex := aFromIndex;
  itm.FLinkToListBox := aToList;
  itm.FLinkToIndex := aToIndex;
end;

procedure TListItemLinkList.DrawLinkLine(aCanvas: TCanvas);
var
  i: Integer;
begin
  for i := 0 to Count -1 do begin
    TListItemLinkObject(Items[i]).DrawLinkLine(aCanvas);
  end;
end;

ぽむぽむ 2012-03-27 23:54:41 No: 41816

使用例
フォームにPaintBoxを全面に配置、ListBoxを２つ用意して適当に
項目を追加しておく。
表示はAccessのリレーションシップ作成済みの項目風になる・・・はず

作成環境 Delphi5
−−−−−−−−−−−−−−−−−−−
unit HogeHoge;

<<宣言部その１>>

type
  TFormListBoxTest = class(TForm)
    ListBoxFloat1: TListBox;
    ListBoxFloat2: TListBox;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ListItemLinkList  :TListItemLinkList;
  private

end;

implementation

<<実装部その１>>

{ TFormListBoxTest }
procedure TFormListBoxTest.PaintBox1Paint(Sender: TObject);
begin
ListItemLinkList.DrawLinkLine(PaintBox1.Canvas);
end;

procedure TFormListBoxTest.FormCreate(Sender: TObject);
begin
  ListItemLinkList := TListItemLinkList.Create;
  ListItemLinkList.AddItem(ListBoxFloat1, ListBoxFloat2, 2, 0);
  ListItemLinkList.AddItem(ListBoxFloat1, ListBoxFloat2, 1, 4);
  ListBoxFloat1.Caption := 'ListBoxFloat1';
  ListBoxFloat2.Caption := 'ListBoxFloat2';
end;

procedure TFormListBoxTest.FormDestroy(Sender: TObject);
begin
FreeAndNil(ListItemLinkList);
end;

わんこ 2012-03-29 10:53:11 No: 41817

こんばんは。いつの間にか色々レスをありがとうございます。
期末の折、多忙につき時間がとれません。
来月にでも、時間ができたら色々と試したいと思います。