mmoutline.pas

一套及时通讯的原码

  begin
    Result := ocSame;
    Exit;
  end;

  Value1ParentNode := Value1;
  Value2ParentNode := Value2;

  Level1 := Value1.GetLevel;
  Level2 := Value2.GetLevel;

  if Level1 > Level2 then
    Value1ParentNode := GetParentNodeAtLevel(Value1, Level1 - Level2)
  else if Level2 > Level1 then
    Value2ParentNode := GetParentNodeAtLevel(Value2, Level2 - Level1);

  while Value1ParentNode.Parent <> Value2ParentNode.Parent do
  begin
    Value1ParentNode := Value1ParentNode.Parent;
    Value2ParentNode := Value2ParentNode.Parent;
  end;

  CommonNode := Value1ParentNode.Parent;
  if CommonNode <> nil then
  begin
    Index1 := CommonNode.List.IndexOf(Value1ParentNode);
    Index2 := CommonNode.List.IndexOf(Value2ParentNode);
    if Index1 < Index2 then Result := ocLess
    else if Index2 < Index1 then Result := ocGreater
    else begin
      if Level1 > Level2 then Result := ocGreater
      else if Level1 = Level2 then Result := ocSame
      else Result := ocLess;
    end
  end
  else
    Result := ocInvalid;
end;

function TMMCustomOutline.GetDataItem(Value: Pointer): Longint;
begin
  Result := FRootNode.GetDataItem(Value);
end;

function TMMCustomOutline.GetItem(X, Y: Integer): LongInt;
var
  Value: TGridCoord;
begin
  Result := -1;
  Value := MouseCoord(X, Y);
  with Value do
   if (Y > 0) or (FRootNode.List.Count > 0) then
     Result := FRootNode.GetVisibleNode(Y + 1).Index;
end;

function TMMCustomOutline.GetTextItem(const Value: string): Longint;
begin
  Result := FRootNode.GetTextItem(Value);
end;

procedure TMMCustomOutline.SetCurItem(Value: LongInt);
begin
  if Value < 0 then Error(SInvalidCurrentItem);
  if not IsCurItem(Value) then
    try
      FCurItem := FRootNode.GetNodeAtIndex(Value);
    except
      on OutlineError do Error(SOutlineIndexError);
    end;
end;

procedure TMMCustomOutline.SetOutlineStyle(Value: TOutlineStyle);
begin
  if FOutlineStyle <> Value then
  begin
    FOutlineStyle := Value;
    SetHorzScrollBar;
    Invalidate;
  end;
end;

procedure TMMCustomOutline.CMFontChanged(var Message: TMessage);
begin
  inherited;
  SetRowHeight;
  SetHorzScrollBar;
end;

procedure TMMCustomOutline.SetDisplayWidth(Value: Integer);
begin
  FSettingWidth := True;
  try
    if DefaultColWidth <> Value then DefaultColWidth := Value;
  finally
    FSettingWidth := False;
  end;
end;

function TMMCustomOutline.GetNodeDisplayWidth(Node: TOutlineNode): Integer;
var
  Delta: Integer;
  TextLength: Integer;
begin
  Result := 0;
  Delta := (DefaultRowHeight - FFontSize) div 2;

  with Canvas do
  begin
    Font := Self.Font;
    TextLength := TextWidth(Node.Text) + 1;
  end;

  case OutlineStyle of
    osText: Inc(Result, DefaultRowHeight * (Node.Level - 1));
    osPlusMinusPictureText: Inc(Result, DefaultRowHeight * (Node.Level + 1));
    osPlusMinusText,
    osPictureText: Inc(Result, DefaultRowHeight * Node.Level);
    osTreeText:
      begin
        Inc(Result, DefaultRowHeight * (Node.Level - 1) - Delta);
        if ooDrawTreeRoot in Options then Inc(Result, DefaultRowHeight);
      end;
    osTreePictureText:
      begin
        Inc(Result, DefaultRowHeight * (Node.Level) - Delta);
        if ooDrawTreeRoot in Options then Inc(Result, DefaultRowHeight);
      end;
  end;
  Inc(Result, TextLength+2);
  if Result < 0 then Result := 0;
end;

function TMMCustomOutline.GetVisibleNode(Index: LongInt): TOutlineNode;
begin
  Result := FRootNode.GetVisibleNode(Index + 1);
end;

procedure TMMCustomOutline.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  Node: TOutlineNode;
  Expanded: Boolean;
  HasChildren: Boolean;
  IndentLevel: Word;
  Bitmap1, Bitmap2: TBitmap;
  TextLength: Integer;
  Delta: Integer;
  InitialLeft: Integer;

  function GetBitmap(Value: TOutlineBitmap): TBitmap;
  begin
    Result := FPictures[Ord(Value)];
  end;

  procedure DrawFocusCell;
  begin
    Inc(ARect.Right, TextLength);
    if (Row = ARow) and (Node.Text <> '') then
      Canvas.FillRect(ARect);
  end;

  procedure DrawTheText;
  begin
    Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
    ARect.Right := ARect.Left;
    DrawFocusCell;
    DrawText(Node, ARect);
  end;

  procedure DrawPlusMinusPicture;
  begin
    Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
    if HasChildren then
    begin
      if Expanded then
      begin
        Bitmap1 := GetBitmap(obMinus);
        Bitmap2 := GetBitmap(obOpen);
      end
      else begin
        Bitmap1 := GetBitmap(obPlus);
        Bitmap2 := GetBitmap(obClose);
      end;
    end
    else begin
      Bitmap1 := nil;
      Bitmap2 := GetBitmap(obLeaf);
    end;
    ARect.Left := ARect.Left + DefaultRowHeight * 2;
    ARect.Right := ARect.Left;
    DrawFocusCell;
    DrawText(Node, ARect);
    Dec(ARect.Left, DefaultRowHeight * 2);
    DrawPictures([Bitmap1, Bitmap2], ARect);
  end;

  procedure DrawPictureText;
  var
    Style: TOutlineBitmap;
  begin
    Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
    if HasChildren then
    begin
      if Expanded then Style := obOpen
      else Style := obClose
    end
    else Style := obLeaf;
    Bitmap1 := GetBitmap(Style);
    ARect.Left := ARect.Left + DefaultRowHeight;
    ARect.Right := ARect.Left;
    DrawFocusCell;
    DrawText(Node, ARect);
    Dec(ARect.Left, DefaultRowHeight);
    DrawPictures([Bitmap1], ARect);
  end;

  procedure DrawPlusMinusText;
  var
    Style: TOutlineBitmap;
  begin
    Inc(ARect.Left, DefaultRowHeight * IndentLevel);
    ARect.Right := ARect.Left;
    DrawFocusCell;
    DrawText(Node, ARect);
    if HasChildren then
    begin
      if Expanded then Style := obMinus
      else Style := obPlus;
      Bitmap1 := GetBitmap(Style);
      Dec(ARect.Left, DefaultRowHeight);
      DrawPictures([Bitmap1], ARect);
    end;
  end;

  procedure DrawTheTree;
  begin
    DrawTree(ARect, Node);
    Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1) - Delta);
    if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);
    ARect.Right := ARect.Left + Delta;
    DrawFocusCell;
    Inc(ARect.Left, Delta);
    DrawText(Node, ARect);
  end;

  procedure DrawTreePicture;
  var
    Style: TOutlineBitmap;
  begin
    //DrawTree(ARect, Node);
    Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1) - Delta);
    if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);

    ARect.Left := 2+ARect.Left + DefaultRowHeight;
    ARect.Right := ARect.Left + Delta;
    DrawFocusCell;
    DrawText(Node, ARect);

    ARect.Left := ARect.Left-2;
    Dec(ARect.Left, DefaultRowHeight - Delta);

    if HasChildren then
    begin
      if Expanded then Style := obOpen
      else Style := obClose;
    end
    else Style := obLeaf;
    Bitmap1 := GetBitmap(Style);
//    Canvas.Brush.Color := clRed;
//    Canvas.FillRect(aRect);
    DrawPictures([Bitmap1], ARect);
  end;

begin
  if FRootNode.List.Count = 0 then
  begin
    with Canvas do
    begin
      Brush.Color := Color;
      FillRect(ARect);
    end;
    Exit;
  end;

  if (Style = otOwnerDraw) and Assigned(FOnDrawItem) then
  begin
    if Row = ARow then
    begin
      if GetFocus = Self.Handle then
      begin
        FOnDrawItem(Self, ARow, ARect, [odFocused, odSelected]);
        if ooDrawFocusRect in Options then
          DrawFocusRect(Canvas.Handle, ARect);
      end
      else FOnDrawItem(Self, ARow, ARect, [odSelected])
    end
    else OnDrawItem(Self, ARow, ARect, []);
    Exit;
  end;

  InitialLeft := ARect.Left;
  Node := GetVisibleNode(ARow);
  Delta := (ARect.Bottom - ARect.Top - FFontSize) div 2;

  with Canvas do
  begin
    {!!!!!!!!!!!!!!!!!!}
    (*
    InflateRect(ARect,-1,-1);
    Brush.Color := clRed;
    FillRect(ARect);
    exit;*)

    Font := Self.Font;
    Brush.Color := Color;
    FillRect(ARect);
    TextLength := TextWidth(Node.Text) + 1;
    if Row = ARow then
    begin
      Brush.Color := clHighlight;
      Font.Color := clHighlightText;
    end;
  end;

  Expanded := Node.Expanded;
  HasChildren := Node.HasItems;
  IndentLevel := Node.GetLevel;
  case OutlineStyle of
    osText: DrawTheText;
    osPlusMinusText: DrawPlusMinusText;
    osPlusMinusPictureText: DrawPlusMinusPicture;
    osPictureText: DrawPictureText;
    osTreeText: DrawTheTree;
    osTreePictureText: DrawTreePicture;
  end;
  exit;

  if (Row = ARow) and (Node.Text <> '') then
  begin
    ARect.Left := InitialLeft + DefaultRowHeight * (IndentLevel - 1);
    if OutlineStyle >= osTreeText then
    begin
      Dec(ARect.Left, Delta);
      if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);
    end;
    if (OutlineStyle <> osText) and (OutlineStyle <> osTreeText) then
      Inc(ARect.Left, DefaultRowHeight);
    if OutlineStyle = osPlusMinusPictureText then
      Inc(ARect.Left, DefaultRowHeight);
    if (GetFocus = Self.Handle) and (ooDrawFocusRect in Options) then
      DrawFocusRect(Canvas.Handle, ARect);
  end;
end;

procedure TMMCustomOutline.DrawTree(ARect: TRect; Node: TOutlineNode);
var
  Offset: Word;
  Height: Word;
  OldPen: TPen;
  I: Integer;
  ParentNode: TOutlineNode;
  IndentLevel: Integer;
begin
  Offset := DefaultRowHeight div 2;
  Height := ARect.Bottom;
  IndentLevel := Node.GetLevel;
  I := IndentLevel - 3;
  if ooDrawTreeRoot in Options then Inc(I);
  OldPen := TPen.Create;
  try
    OldPen.Assign(Canvas.Pen);
    with Canvas do
    begin
      Pen.Color := clBlack;
      Pen.Width := 1;
      try
        ParentNode := Node.Parent;
        while (ParentNode.Parent <> nil) and
          ((ooDrawTreeRoot in Options) or
          (ParentNode.Parent.Parent <> nil)) do
        begin
          with ParentNode.Parent do
          begin
            if List.IndexOf(ParentNode) < List.Count - 1 then
            begin
              Canvas.MoveTo(ARect.Left + DefaultRowHeight * I + Offset, ARect.Top);
              Canvas.LineTo(ARect.Left + DefaultRowHeight * I + Offset, Height);
            end;
          end;
          ParentNode := ParentNode.Parent;
          Dec(I);
        end;

        with Node.Parent do
          if List.IndexOf(Node) = List.Count - 1 then
            Height := ARect.Top + Offset;

        if (ooDrawTreeRoot in Options) or (IndentLevel > 1) then
        begin
          if not (ooDrawTreeRoot in Options) then Dec(IndentLevel);
          with ARect do
          begin
            Inc(Left, DefaultRowHeight * (IndentLevel - 1));
            MoveTo(Left + Offset, Top);
            LineTo(Left + Offset, Height);
            MoveTo(Left + Offset, Top + Offset);
            LineTo(Left + Offset + FFontSize div 2, Top + Offset);
          end;
        end;
      finally
        Pen.Assign(OldPen);
      end;
    end;
  finally
    OldPen.Destroy;
  end;
end;

procedure TMMCustomOutline.DrawPictures(BitMaps: array of TBitmap; ARect: TRect);
var
  I: Word;
  Rect: TRect;
  Value: TBitmap;
  Offset: Word;
  Delta: Integer;
  OldTop: Integer;
  OldColor: TColor;
begin
  OldColor := Canvas.Brush.Color;
  Canvas.Brush.Color := Color;
  Offset := (DefaultRowHeight - FFontSize) div 2;
  //Rect.Top := ARect.Top + Offset;
  //Rect.Bottom := Rect.Top + FFontSize;
  for I := Low(Bitmaps) to High(Bitmaps) do
  begin
    Value := BitMaps[I];
    Rect.Left := ARect.Left + Offset;
    Rect.Right := Rect.Left + Value.Width;
    Inc(ARect.Left, DefaultRowHeight);
    if Value <> nil then
    begin
      if not (ooStretchBitmaps in Options) then
      begin
        //if Rect.Top + Value.Height < Rect.Bottom then
        //  Rect.Bottom := Rect.Top + Value.Height;
        //if Rect.Left + Value.Width < Rect.Right then
        //  Rect.Right := Rect.Left + Value.Width;
        //Delta := (FFontSize - (Rect.Bottom - Rect.Top)) div 2;
        //if Delta > 0 then
        //begin
        //  Delta := (DefaultRowHeight - (Rect.Bottom - Rect.Top)) div 2;
        //  OldTop := Rect.Top;
        //  Rect.Top := ARect.Top + Delta;
        //  Rect.Bottom := Rect.Bottom - OldTop + Rect.Top;
        //end;
        Rect.Top := aREct.Top+((aRect.Bottom-aRect.Top)-Value.Height)div 2;
        Rect.Bottom := Rect.Top + Value.Height;

        Canvas.BrushCopy(Rect, Value,
          Bounds(0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top),
          Value.TransparentColor);
      end
      else
        Canvas.BrushCopy(Rect, Value,
          Bounds(0, 0, Value.Width, Value.Height),
          Value.TransparentColor);
    end;
  end;
  Canvas.Brush.Color := OldColor;
end;

procedure TMMCustomOutline.DrawText(Node: TOutlineNode; Rect: TRe