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

名前

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

本文

<<実装部その１>>

{ 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;

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

戻る