main.pas

矢量绘图组件（开源版）

procedure TMainForm.OptionsConfirmDeletionExecute(Sender: TObject);
begin
  OptionsConfirmDeletion.Checked := not OptionsConfirmDeletion.Checked;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
begin
  if IsGraphSaved then
  begin
    SimpleGraph.Clear;
    CanClose := True;
  end;
end;

procedure TMainForm.cbxFontSizeChange(Sender: TObject);
begin
  cbxFontSize.Tag := StrToIntDef(cbxFontSize.Text, cbxFontSize.Tag);
  SimpleGraph.ForEachObject(ForEachCallback, FEO_SETFONTSIZE, True);
end;

procedure TMainForm.cbxFontNameChange(Sender: TObject);
begin
  cbxFontName.Text := cbxFontName.Items[cbxFontName.ItemIndex];
  SimpleGraph.ForEachObject(ForEachCallback, FEO_SETFONTFACE, True);
end;

procedure TMainForm.LinkRemovePointExecute(Sender: TObject);
begin
  with TGraphLink(SimpleGraph.SelectedObjects[0]) do
    RemovePoint(LinkRemovePoint.Tag);
end;

procedure TMainForm.LinkAddPointExecute(Sender: TObject);
begin
  with TGraphLink(SimpleGraph.SelectedObjects[0]) do
    AddBreakPoint(TargetPt);
end;

procedure TMainForm.LinkGrowExecute(Sender: TObject);
begin
  SimpleGraph.ForEachObject(ForEachCallback, FEO_GROW25, True);
end;

procedure TMainForm.LinkShrinkExecute(Sender: TObject);
begin
  SimpleGraph.ForEachObject(ForEachCallback, FEO_SHRINK25, True);
end;

procedure TMainForm.LinkRotateCWExecute(Sender: TObject);
begin
  SimpleGraph.ForEachObject(ForEachCallback, FEO_ROTATE90CW, True);
end;

procedure TMainForm.LinkRotateCCWExecute(Sender: TObject);
begin
  SimpleGraph.ForEachObject(ForEachCallback, FEO_ROTATE90CCW, True);
end;

procedure TMainForm.LinkReverseExecute(Sender: TObject);
begin
  SimpleGraph.ForEachObject(ForEachCallback, FEO_REVERSEDIRECTION, True);
end;

procedure TMainForm.ObjectsPopupPopup(Sender: TObject);
var
  HT: DWORD;
  Index: Integer;
  Link: TGraphLink;
begin
  if (SimpleGraph.SelectedObjects.Count = 1) and
     (SimpleGraph.SelectedObjects[0] is TGraphLink) then
  begin
    LinkRemovePoint.Visible := True;
    LinkAddPoint.Visible := True;
    LinkGrow.Visible := True;
    LinkShrink.Visible := True;
    LinkRotateCW.Visible := True;
    LinkRotateCCW.Visible := True;
    LinkReverse.Visible := True;
    TargetPt := SimpleGraph.CursorPos;
    Link := TGraphLink(SimpleGraph.SelectedObjects[0]);
    HT := Link.HitTest(TargetPt);
    Index := HiWord(HT);
    LinkRemovePoint.Enabled := ((HT and GHT_POINT) <> 0) and not Link.IsFixedPoint(Index, False);
    LinkRemovePoint.Tag := Index;
    LinkAddPoint.Enabled := ((HT and GHT_LINE) <> 0) and not (gloFixedBreakPoints in Link.LinkOptions);
    LinkGrow.Enabled := Link.CanMove;
    LinkShrink.Enabled := Link.CanMove;
    LinkRotateCW.Enabled := Link.CanMove;
    LinkRotateCCW.Enabled := Link.CanMove;
  end
  else
  begin
    LinkRemovePoint.Visible := False;
    LinkAddPoint.Visible := False;
    LinkGrow.Visible := False;
    LinkShrink.Visible := False;
    LinkRotateCW.Visible := False;
    LinkRotateCCW.Visible := False;
    LinkReverse.Visible := False;
  end;
end;

procedure TMainForm.SimpleGraphDblClick(Sender: TObject);
begin
  EditProperties.Execute;
end;

procedure TMainForm.SimpleGraphNodeDblClick(Graph: TSimpleGraph;
  Node: TGraphNode);
begin
  EditProperties.Execute;
end;

procedure TMainForm.SimpleGraphLinkDblClick(Graph: TSimpleGraph;
  Link: TGraphLink);
begin
  EditProperties.Execute;
end;

procedure TMainForm.SimpleGraphObjectDblClick(Graph: TSimpleGraph;
  GraphObject: TGraphObject);
begin
  EditProperties.Execute;
end;

procedure TMainForm.SimpleGraphGraphChange(Sender: TObject);
begin
  if SimpleGraph.Modified then
    StatusBar.Panels[4].Text := SModified
  else
    StatusBar.Panels[4].Text := '';
end;

procedure TMainForm.SimpleGraphZoomChange(Sender: TObject);
begin
  StatusBar.Panels[5].Text := Format('%d%%', [SimpleGraph.Zoom]);
end;

procedure TMainForm.SimpleGraphCommandModeChange(Sender: TObject);
begin
  case SimpleGraph.CommandMode of
    cmViewOnly:
      StatusBar.Panels[0].Text := SViewOnly;
    cmPan:
      StatusBar.Panels[0].Text := SPan;
    cmEdit:
      StatusBar.Panels[0].Text := SEditing;
    cmInsertLink:
      StatusBar.Panels[0].Text := SInsertingLink;
    cmInsertNode:
      StatusBar.Panels[0].Text := SInsertingNode;
  end;
end;

procedure TMainForm.SimpleGraphNodeMoveResize(Graph: TSimpleGraph;
  Node: TGraphNode);
begin
  if Node.Selected and (SimpleGraph.SelectedObjects.Count = 1) then
  begin
    StatusBar.Panels[1].Text := Format('(%d, %d)', [Node.Left, Node.Top]);
    StatusBar.Panels[2].Text := Format('%d x %d', [Node.Width, Node.Height]);
  end;
end;

procedure TMainForm.SimpleGraphObjectSelect(Graph: TSimpleGraph;
  GraphObject: TGraphObject);
begin
  if SimpleGraph.SelectedObjects.Count = 1 then
    SimpleGraphObjectChange(Graph, SimpleGraph.SelectedObjects[0])
  else
  begin
    StatusBar.Panels[1].Text := '';
    StatusBar.Panels[2].Text := '';
    if SimpleGraph.SelectedObjects.Count > 1 then
      StatusBar.Panels[3].Text := Format(SMultiSelect, [SimpleGraph.SelectedObjects.Count])
    else
      StatusBar.Panels[3].Text := '';
  end;
end;

procedure TMainForm.SimpleGraphInfoTip(Graph: TSimpleGraph;
  GraphObject: TGraphObject; var InfoTip: String);
const
  Hooked: array[Boolean] of String = ('', SHooked);
begin
  if GraphObject.IsLink then
    with TGraphLink(GraphObject) do
    begin
      InfoTip := Format(SLinkInfo, [Text,
        Points[0].X, Points[0].Y, Hooked[Assigned(Source)],
        Points[PointCount - 1].X, Points[PointCount - 1].Y, Hooked[Assigned(Target)],
        PointCount - 2]);
    end
  else
    with TGraphNode(GraphObject) do
    begin
      InfoTip := Format(SNodeInfo, [PrettyNodeClassName(ClassName),
        Text, Left, Top, Width, Height]);
    end;
end;

procedure TMainForm.SimpleGraphCanHookLink(Graph: TSimpleGraph;
  GraphObject: TGraphObject; Link: TGraphLink; Index: Integer;
  var CanHook: Boolean);
const
  StartEndPoints: array[Boolean] of String = (SStartPoint, SEndPoint);
var
  MsgText: String;
  LinkName, ObjectName: String;
begin
  if OptionsConfirmHookLink.Checked and not Link.Dragging and CanHook then
  begin
    LinkName := Link.Text;
    if LinkName = '' then LinkName := SNoName;
    ObjectName := GraphObject.Text;
    if ObjectName = '' then ObjectName := SNoName;
    MsgText := Format(SCanHook, [StartEndPoints[Index <> 0], LinkName, ObjectName]);
    CanHook := (MessageDlg(MsgText, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  end;
end;

procedure TMainForm.SimpleGraphCanLinkObjects(Graph: TSimpleGraph;
  Link: TGraphLink; Source, Target: TGraphObject; var CanLink: Boolean);
var
  MsgText: String;
  LinkName, SourceName, TargetName: String;
begin
  if OptionsConfirmHookLink.Checked and not Link.Dragging and CanLink then
  begin
    LinkName := Link.Text;
    if LinkName = '' then LinkName := SNoName;
    SourceName := Source.Text;
    if SourceName = '' then SourceName := SNoName;
    TargetName := Target.Text;
    if TargetName = '' then TargetName := SNoName;
    MsgText := Format(SCanLink, [SourceName, TargetName, LinkName]);
    CanLink := (MessageDlg(MsgText, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  end;
end;

procedure TMainForm.SimpleGraphCanRemoveObject(Graph: TSimpleGraph;
  GraphObject: TGraphObject; var CanRemove: Boolean);
var
  MsgText: String;
  ObjectName: String;
begin
  if OptionsConfirmDeletion.Checked then
  begin
    ObjectName := GraphObject.Text;
    if ObjectName = '' then ObjectName := SNoName;
    ObjectName := GraphObject.ClassName + ': ' + ObjectName;
    MsgText := Format(SCanDelete, [ObjectName]);
    CanRemove := (MessageDlg(MsgText, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  end;
end;

procedure TMainForm.SimpleGraphObjectChange(Graph: TSimpleGraph; GraphObject: TGraphObject);
var
  PosFirstLine: Integer;
begin
  if (SimpleGraph.SelectedObjects.Count = 1) and (SimpleGraph.SelectedObjects[0] = GraphObject) then
  begin
    cbxFontName.Text := GraphObject.Font.Name;
    cbxFontSize.Text := IntToStr(GraphObject.Font.Size);
    FormatBold.Checked := (fsBold in GraphObject.Font.Style);
    FormatItalic.Checked := (fsItalic in GraphObject.Font.Style);
    FormatUnderline.Checked := (fsUnderline in GraphObject.Font.Style);
    if GraphObject is TGraphNode then
      with TGraphNode(GraphObject) do
      begin
        FormatAlignLeft.Checked := (Alignment = taLeftJustify);
        FormatCenter.Checked := (Alignment = taCenter);
        FormatAlignRight.Checked := (Alignment = taRightJustify);
        FormatAlignTop.Checked := (Layout = tlTop);
        FormatVCenter.Checked := (Layout = tlCenter);
        FormatAlignBottom.Checked := (Layout = tlBottom);
        StatusBar.Panels[1].Text := Format('(%d, %d)', [Left, Top]);
        StatusBar.Panels[2].Text := Format('%d x %d', [Width, Height]);
        PosFirstLine := Pos(#$D#$A, Text);
        if PosFirstLine <> 0 then
          StatusBar.Panels[3].Text := Copy(Text, 1, PosFirstLine)
        else
          StatusBar.Panels[3].Text := Text;
      end
    else
      with TGraphLink(GraphObject) do
      begin
        StatusBar.Panels[1].Text := '';
        StatusBar.Panels[2].Text := Format(SNumOfPoints, [PointCount]);
        StatusBar.Panels[3].Text := Text;
      end;
  end;
end;

procedure TMainForm.SimpleGraphObjectInitInstance(Graph: TSimpleGraph;
  GraphObject: TGraphObject);
var
  FontStyle: TFontStyles;
begin
  FontStyle := [];
  if FormatBold.Checked then
    Include(FontStyle, fsBold);
  if FormatItalic.Checked then
    Include(FontStyle, fsItalic);
  if FormatUnderline.Checked then
    Include(FontStyle, fsUnderline);
  with GraphObject.Font do
  begin
    if cbxFontName.Text <> '' then
      Name := cbxFontName.Text;
    Size := cbxFontSize.Tag;
    Style := FontStyle;
  end;
  if GraphObject is TGraphNode then
  begin
    if FormatAlignLeft.Checked then
      TGraphNode(GraphObject).Alignment := taLeftJustify
    else if FormatAlignRight.Checked then
      TGraphNode(GraphObject).Alignment := taRightJustify
    else
      TGraphNode(GraphObject).Alignment := taCenter;
    if FormatAlignTop.Checked then
      TGraphNode(GraphObject).Layout := tlTop
    else if FormatAlignBottom.Checked then
      TGraphNode(GraphObject).Layout := tlBottom
    else
      TGraphNode(GraphObject).Layout := tlCenter;
  end;
end;

procedure TMainForm.SimpleGraphMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  with SimpleGraph.ClientToGraph(X, Y) do
    StatusBar.Panels[6].Text := Format('(%d, %d)', [X, Y]);
end;

procedure TMainForm.SimpleGraphMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
  I: Integer;
begin
  MousePos := SimpleGraph.ScreenToClient(MousePos);
  if PtInRect(SimpleGraph.ClientRect, MousePos) then
  begin
    for I := 1 to 5 do
    begin
      SimpleGraph.ChangeZoomBy(-1, zoCursor);
      SimpleGraph.Update;
    end;
    Handled := True;
  end;
end;

procedure TMainForm.SimpleGraphMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
  I: Integer;
begin
  MousePos := SimpleGraph.ScreenToClient(MousePos);
  if PtInRect(SimpleGraph.ClientRect, MousePos) then
  begin
    for I := 1 to 5 do
    begin
      SimpleGraph.ChangeZoomBy(+1, zoCursor);
      SimpleGraph.Update;
    end;
    Handled := True;
  end;
end;

procedure TMainForm.SimpleGraphObjectAfterDraw(Graph: TSimpleGraph;
  GraphObject: TGraphObject; Canvas: TCanvas);
begin
{
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Pen.Width := 0;
  // Mark VisibleRect
  Canvas.Pen.Color := clLime;
  Canvas.Rectangle(GraphObject.VisualRect);
  // Mark SelectedVisibleRect
  Canvas.Pen.Color := clFuchsia;
  Canvas.Rectangle(GraphObject.SelectedVisualRect);
  // Mark BoundsRect
  Canvas.Pen.Color := clBlue;
  Canvas.Rectangle(GraphObject.BoundsRect);
}
end;

end.