有人用过TSimpleGraph图形库吗？Delphi

Question

怎么让线上的文字与线平行呢？

Answer 1

一个类TSimpleGraph:
然后在该类中可以承载很多其他类:包含很多TGraphObject
TGraphObject就好比可以放在CAD上面的很多图元系统基于TGraphObject继承了很多图元类：
如下：
引用TGraphObject
  TGraphLink
  TGraphNode
    TPolygonalNode
      TTriangularNode
      TRhomboidalNode
      TPentagonalNode
    TRectangularNode
    TRoundRectangularNode
    TEllipticNode上面是结构图另外使用了TGraphObjectList类来存放所有的TGraphObject对象，该类是一个List的继承下面让我们来分析最重要的类：
TSimpleGraph：
该类从TCustomControl继承而来
另外注意下如下的声明：
TGraphNodeClass = class of TGraphNode;
TGraphLinkClass = class of TGraphLink;他的public方法值得我们注意分析一下：
public
    class procedure Register(ANodeClass: TGraphNodeClass); overload;
    class procedure Unregister(ANodeClass: TGraphNodeClass); overload;
    class function NodeClassCount: Integer;
    class function NodeClasses(Index: Integer): TGraphNodeClass;
    class procedure Register(ALinkClass: TGraphLinkClass); overload;
    class procedure Unregister(ALinkClass: TGraphLinkClass); overload;
    class function LinkClassCount: Integer;
    class function LinkClasses(Index: Integer): TGraphLinkClass;还有他的很重要的特性：
property Objects: TGraphObjectList read fObjects;
property SelectedObjects: TGraphObjectList read fSelectedObjects;上面说明了两个东西：
一：TSimpleGraph是一个List的存储TGraphObject对象的队列
二：对于已经选择的队列也是TGraphObject对象
TGraphCommandMode = (cmViewOnly, cmEdit, cmInsertNode, cmLinkNodes);是对TSimpleGraph对象的操作方法
property CommandMode: TGraphCommandMode read fCommandMode write SetCommandMode;TGraphNotifyEvent = procedure(Graph: TSimpleGraph;
    GraphObject: TGraphObject) of object;
这是方法的申明下面使用：
property OnObjectInsert: TGraphNotifyEvent read fOnObjectInsert write fOnObjectInsert;
property OnObjectRemove: TGraphNotifyEvent read fOnObjectRemove write fOnObjectRemove;
property OnObjectSelect: TGraphNotifyEvent read fOnObjectSelect write fOnObjectSelect;
property OnObjectDblClick: TGraphNotifyEvent read fOnObjectDblClick write fOnObjectDblClick;对于TGraphObject属性，我们看一个很重要的方法：procedure TGraphObject.Draw(Canvas: TCanvas);
begin
  if IsVisibleOn(Canvas) then
  begin
    Canvas.Brush := Brush;
    Canvas.Pen := Pen;
    DrawBody(Canvas);
    if Text  '' then
    begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font := Font;
      DrawText(Canvas);
    end;
  end;
end;对于某个特殊的对象，我们以TGraphLink为例子，可以看出在这里画出来了两个对象
procedure TGraphLink.DrawText(Canvas: TCanvas);
var
  LogFont: TLogFont;
  FontHandle: THandle;
  TextAlign, TextFlags: Integer;
begin
  if TextToShow  '' then
  begin
    GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
    if Abs(Angle) > Pi / 2 then
      LogFont.lfEscapement := Round(-1800 * (Angle - Pi) / Pi)
    else
      LogFont.lfEscapement := Round(-1800 * Angle / Pi);
    LogFont.lfOrientation := LogFont.lfEscapement;
    LogFont.lfQuality := PROOF_QUALITY;
    FontHandle := SelectObject(Canvas.Handle, CreateFontIndirect(LogFont));
    TextAlign := SetTextAlign(Canvas.Handle, TA_BOTTOM or TA_CENTER);
    TextFlags := Canvas.TextFlags;
    if Owner.UseRightToLeftReading then
      Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
    else
      Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
    Canvas.TextOut(TextCenter.X, TextCenter.Y, TextToShow);
    Canvas.TextFlags := TextFlags;
    SetTextAlign(Canvas.Handle, TextAlign);
    DeleteObject(SelectObject(Canvas.Handle, FontHandle));
  end;
end;procedure TGraphLink.DrawBody(Canvas: TCanvas);  procedure DrawArrow(const Pt: TPoint);
  var
    ArrowHeight: Integer;
    ArrowPts: array[1..4] of TPoint;
  begin
    if Owner.MarkerSize > Pen.Width then
      ArrowHeight := 4 * Owner.MarkerSize
    else
      ArrowHeight := 4 * Pen.Width;
    if (Pt.X = StartPt.X) and (Pt.Y = StartPt.Y) then
      ArrowHeight := -ArrowHeight;
    ArrowPts[1] := Pt;
    ArrowPts[2] := NextPointOfLine(Angle+Pi/6, Pt, ArrowHeight);
    ArrowPts[3] := NextPointOfLine(Angle, Pt, MulDiv(ArrowHeight, 2, 3));
    ArrowPts[4] := NextPointOfLine(Angle-Pi/6, Pt, ArrowHeight);
    Canvas.Polygon(ArrowPts);
  end;begin
  with StartPt do Canvas.MoveTo(X, Y);
  with EndPt do Canvas.LineTo(X, Y);
  if Kind in [lkDirected, lkBidirected] then
  begin
    DrawArrow(EndPt);
    if Kind = lkBidirected then
      DrawArrow(StartPt);
  end;
end;
    
再看TGraphNode
procedure TGraphNode.DrawText(Canvas: TCanvas);
var
  Rect: TRect;
  DrawTextFlags: Integer;
begin
  if not IsRectEmpty(TextRect) then
  begin
    Rect := TextRect;
    DrawTextFlags := DT_WORDBREAK or DT_NOPREFIX or DT_END_ELLIPSIS or
      DT_EDITCONTROL or TextAlignFlags[Alignment];
    Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect,
      Owner.DrawTextBiDiModeFlags(DrawTextFlags));
  end;
end;DrawBody方法应该在更下一层的类中实现，所以这里不需要实现。下面让我们来看下一层的实现方法：从上面的图元结构，我们可以看出：
TPolygonalNode
TRectangularNode
继承自 TGraphNode
他们的实现如下：procedure TPolygonalNode.DrawBody(Canvas: TCanvas);
begin
  DrawBackground(Canvas);
  Canvas.Polygon(Vertices);
end;procedure TRectangularNode.DrawBody(Canvas: TCanvas);
begin
  DrawBackground(Canvas);
  Canvas.Rectangle(Left, Top, Left + Width, Top + Height);
end;其中DrawBackground的实现如下：
procedure TGraphNode.DrawBackground(Canvas: TCanvas);
var
  Rgn: HRGN;
begin
  if Background.Graphic  nil then
  begin
    Rgn := CreateTargetRegion(Canvas);
    try
      SelectClipRgn(Canvas.Handle, Rgn);
      try
        Background.OnChange := nil;
        try
          Canvas.StretchDraw(BoundsRect, Background.Graphic);
        finally
          Background.OnChange := BackgroundChanged;
        end;
      finally
        SelectClipRgn(Canvas.Handle, 0);
      end;
    finally
      DeleteObject(Rgn);
    end;
    Canvas.Brush.Style := bsClear;
  end;
end;下面来分析一下TSimpleGraph里面的一个很重要的类 TGraphObjectListfunction TGraphObjectList.GetItems(Index: Integer): TGraphObject;
begin
  Result := TGraphObject(Get(Index));
end;procedure TGraphObjectList.Clear;
begin
  while Count > 0 do
    Delete(Count - 1);
  inherited Clear;
end;function TGraphObjectList.Add(Item: TGraphObject): Integer;
begin
  Result := IndexOf(Item);
  if Result < 0 then
  begin
    Result := inherited Add(Item);
    NotifyAction(Item, glAdded);
  end;
end;procedure TGraphObjectList.Insert(Index: Integer; Item: TGraphObject);
var
  CurIndex: Integer;
begin
  CurIndex := IndexOf(Item);
  if CurIndex < 0 then
  begin
    inherited Insert(Index, Item);
    NotifyAction(Item, glAdded);
  end
  else
    Move(CurIndex, Index);
end;procedure TGraphObjectList.Extract(Item: TGraphObject);
begin
  Remove(Item);
end;procedure TGraphObjectList.Exchange(Index1, Index2: Integer);
begin
  inherited Exchange(Index1, Index2);
  NotifyAction(nil, glReordered);
end;procedure TGraphObjectList.Move(CurIndex, NewIndex: Integer);
begin
  inherited Move(CurIndex, NewIndex);
  NotifyAction(TGraphObject(Get(NewIndex)), glReordered);
end;procedure TGraphObjectList.Delete(Index: Integer);
begin
  Remove(TGraphObject(Get(Index)));
end;function TGraphObjectList.Remove(Item: TGraphObject): Integer;
begin
  Result := inherited Remove(Item);
  if Result >= 0 then NotifyAction(Item, glRemoved);
end;function TGraphObjectList.Replace(OldItem, NewItem: TGraphObject): Integer;
begin
  Result := IndexOf(OldItem);
  if Result >= 0 then Put(Result, NewItem);
end;procedure TGraphObjectList.NotifyAction(GraphObject: TGraphObject;
  Action: TGraphObjectListAction);
begin
  if Assigned(OnChange) then
    OnChange(Self, GraphObject, Action);
end;

Answer 2

     该类是在TSimpleGraph中用来存储图元对象的类，非常有用，其实就是一个List.继续分析主类TSimpleGraph，构造函数如下：
constructor TSimpleGraph.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fObjects := TGraphObjectList.Create;
  fObjects.OnChange := ObjectListChanged;
  fSelectedObjects := TGraphObjectList.Create;
  fSelectedObjects.OnChange := SelectionListChanged;
  fGridSize := 8;
  fGridColor := clGray;
  fShowGrid := True;
  fSnapToGrid := True;
  fLockNodes := False;
  fMarkerColor := clBlack;
  fMarkerSize := 3;
  fZoom := 100;
  fZoomMin := Low(TZoom);
  fZoomMax := High(TZoom);
  fZoomStep := 25;
  fDefaultKeyMap := True;
  fState := gsNone;
  fCommandMode := cmEdit;
  fModified := False;
  fHorzScrollBar := TGraphScrollBar.Create(Self, sbHorizontal);
  fVertScrollBar := TGraphScrollBar.Create(Self, sbVertical);
  Grid := TBitmap.Create;
  Grid.Width := 8;
  Grid.Height := 8;
  SetRect(SelectionRect, -1, -1, -1, -1);
  if NodeClassCount > 0 then fDefaultNodeClass := NodeClasses(0);
  if LinkClassCount > 0 then fDefaultLinkClass := LinkClasses(0);
end;
TSimpleGraph中的WMPaint方法也是一个十分重要的方法，必要的时候重绘整个对象。
procedure TSimpleGraph.WMPaint(var Msg: TWMPaint);
var
  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
  SavedDC: Integer;
begin
  if Msg.DC  0 then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Msg);
  end
  else
  begin
    DC := GetDC(0);
    try
      with ClientRect do
        MemBitmap := CreateCompatibleBitmap(DC,
          Right + HorzScrollBar.Position,
          Bottom + VertScrollBar.Position);
    finally
      ReleaseDC(0, DC);
    end;
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      SavedDC := SaveDC(MemDC);
      try
        SetMapMode(MemDC, MM_ANISOTROPIC);
        SetWindowExtEx(MemDC, 100, 100, nil);
        SetViewPortExtEx(MemDC, Zoom, Zoom, nil);
        Msg.DC := MemDC;
        try
          WMPaint(Msg);
        finally
          Msg.DC := 0;
        end;
      finally
        RestoreDC(MemDC, SavedDC);
      end;
      DC := BeginPaint(WindowHandle, PS);
      try
        BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC,
          HorzScrollBar.Position, VertScrollBar.Position, SRCCOPY);
      finally
        EndPaint(WindowHandle, PS);
      end;
    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;插入图元的方法如下：
function TSimpleGraph.InsertNode(pBounds: PRect; ANodeClass: TGraphNodeClass): TGraphNode;
begin
  BeginUpdate;
  try
    SelectedObjects.Clear;
    if ANodeClass = nil then
      ANodeClass := DefaultNodeClass;
    Result := ANodeClass.Create(Self);
    if pBounds  nil then
      Result.BoundsRect := pBounds^;
    Result.State := osNone;
    Result.Selected := True;
  finally
    EndUpdate;
  end;
end;
上面的方法使用了如下函数：procedure TSimpleGraph.BeginUpdate;
begin
  Inc(UpdateCount);
end;procedure TSimpleGraph.EndUpdate;
begin
  Dec(UpdateCount);
  if UpdateCount = 0 then
    ObjectChanged(nil, GraphModified);
end;
类的几个辅助方法：procedure TSimpleGraph.LoadFromFile(const Filename: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;procedure TSimpleGraph.SaveToFile(const Filename: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(Filename, fmCreate or fmShareExclusive);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;几个注册类函数：
class procedure TSimpleGraph.Register(ANodeClass: TGraphNodeClass);
begin
  if RegisteredNodeClasses = nil then
    RegisteredNodeClasses := TList.Create;
  if RegisteredNodeClasses.IndexOf(ANodeClass) < 0 then
  begin
    RegisteredNodeClasses.Add(ANodeClass);
    RegisterClass(ANodeClass);
  end;
end;class procedure TSimpleGraph.Unregister(ANodeClass: TGraphNodeClass);
begin
  if RegisteredNodeClasses  nil then
  begin
    RegisteredNodeClasses.Remove(ANodeClass);
    UnregisterClass(ANodeClass);
  end;
end;class procedure TSimpleGraph.Register(ALinkClass: TGraphLinkClass);
begin
  if RegisteredLinkClasses = nil then
    RegisteredLinkClasses := TList.Create;
  if RegisteredLinkClasses.IndexOf(ALinkClass) < 0 then
  begin
    RegisteredLinkClasses.Add(ALinkClass);
    RegisterClass(ALinkClass);
  end;
end;class procedure TSimpleGraph.Unregister(ALinkClass: TGraphLinkClass);
begin
  if RegisteredLinkClasses  nil then
  begin
    RegisteredLinkClasses.Remove(ALinkClass);
    UnregisterClass(ALinkClass);
  end;
end;下面的方法注册类图元：procedure Register;
begin
  RegisterComponents('Delphi Area', [TSimpleGraph]);
end;initialization
  // Clipboard Format
  CF_SIMPLEGRAPH := RegisterClipboardFormat('Simple Graph Format');
  // Custom Cursors
  Screen.Cursors[crHandFlat] := LoadCursor(HInstance, 'SG_HANDFLAT');
  Screen.Cursors[crHandGrab] := LoadCursor(HInstance, 'SG_HANDGRAB');
  Screen.Cursors[crHandPnt] := LoadCursor(HInstance, 'SG_HANDPNT');
  Screen.Cursors[crXHair1] := LoadCursor(HInstance, 'SG_XHAIR1');
  Screen.Cursors[crXHair2] := LoadCursor(HInstance, 'SG_XHAIR2');
  // Link and Node class types
  TSimpleGraph.Register(TGraphLink);
  TSimpleGraph.Register(TRectangularNode);
  TSimpleGraph.Register(TRoundRectangularNode);
  TSimpleGraph.Register(TEllipticNode);
  TSimpleGraph.Register(TTriangularNode);
  TSimpleGraph.Register(TRhomboidalNode);
  TSimpleGraph.Register(TPentagonalNode);
finalization
  if RegisteredNodeClasses  nil then
    RegisteredNodeClasses.Free;
  if RegisteredLinkClasses  nil then
    RegisteredLinkClasses.Free;
end.