main.pas

很不错的绘制矢量图的控件。还有一个使用控件的例子。delphi7以上才可安装

procedure TMainForm.EditPropertiesExecute(Sender: TObject);
var
  LinkCount: Integer;
begin
  if SimpleGraph.SelectedObjects.Count = 0 then
    TDesignerProperties.Execute(SimpleGraph)
  else
  begin
    LinkCount := SimpleGraph.SelectedObjectsCount(TGraphLink);
    if LinkCount = 0 then
      TNodeProperties.Execute(SimpleGraph.SelectedObjects)
    else if LinkCount = SimpleGraph.SelectedObjects.Count then
      TLinkProperties.Execute(SimpleGraph.SelectedObjects)
    else
      TObjectProperties.Execute(SimpleGraph.SelectedObjects);
  end;
end;

procedure TMainForm.FormatBoldExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        with SelectedObjects[I].Font do
          if FormatBold.Checked then
            Style := Style + [fsBold]
          else
            Style := Style - [fsBold];
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.FormatItalicExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        with SelectedObjects[I].Font do
          if FormatItalic.Checked then
            Style := Style + [fsItalic]
          else
            Style := Style - [fsItalic];
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.FormatUnderlineExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        with SelectedObjects[I].Font do
          if FormatUnderline.Checked then
            Style := Style + [fsUnderLine]
          else
            Style := Style - [fsUnderline];
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.FormatAlignLeftExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        if SelectedObjects[I] is TGraphNode then
          TGraphNode(SelectedObjects[I]).Alignment := taLeftJustify;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.FormatCenterExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        if SelectedObjects[I] is TGraphNode then
          TGraphNode(SelectedObjects[I]).Alignment := taCenter;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.FormatAlignRightExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        if SelectedObjects[I] is TGraphNode then
          TGraphNode(SelectedObjects[I]).Alignment := taRightJustify;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.HelpAboutExecute(Sender: TObject);
begin
  with TAbout.Create(Application) do
    try
      ShowModal;
    finally
      Free;
    end;
end;

procedure TMainForm.ObjectsNoneExecute(Sender: TObject);
begin
  SimpleGraph.CommandMode := cmEdit;
end;

procedure TMainForm.ObjectsRectangleExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TRectangularNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsRoundRectExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TRoundRectangularNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsEllipseExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TEllipticNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsTriangleExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TTriangularNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsRhomboidExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TRhomboidalNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsPentagonExecute(Sender: TObject);
begin
  SimpleGraph.DefaultNodeClass := TPentagonalNode;
  SimpleGraph.CommandMode := cmInsertNode;
end;

procedure TMainForm.ObjectsLinkExecute(Sender: TObject);
begin
  SimpleGraph.CommandMode := cmLinkNodes;
end;

procedure TMainForm.ViewZoomInExecute(Sender: TObject);
begin
  SimpleGraph.Zoom := SimpleGraph.Zoom + SimpleGraph.ZoomStep;
end;

procedure TMainForm.ViewZoomOutExecute(Sender: TObject);
begin
  SimpleGraph.Zoom := SimpleGraph.Zoom - SimpleGraph.ZoomStep;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
begin
  CanClose := IsGraphSaved;
end;

procedure TMainForm.ActionListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  Handled := True;
  FileSave.Enabled := SimpleGraph.Modified;
  FileSaveAs.Enabled := (SimpleGraph.Objects.Count > 0);
  FileExport.Enabled := (SimpleGraph.Objects.Count > 0);
  FilePrint.Enabled :=(Printer.Printers.Count > 0) and
   (SimpleGraph.Objects.Count > 0);
  EditCut.Enabled :=(SimpleGraph.SelectedObjects.Count > 0);
  EditCopy.Enabled :=(SimpleGraph.SelectedObjects.Count > 0);
  EditPaste.Enabled := Clipboard.HasFormat(CF_SIMPLEGRAPH);
  EditDelete.Enabled :=(SimpleGraph.SelectedObjects.Count > 0);
  EditBringToFront.Enabled :=(SimpleGraph.SelectedObjects.Count > 0);
  EditSendToBack.Enabled :=(SimpleGraph.SelectedObjects.Count > 0);
  EditSelectAll.Enabled :=
   (SimpleGraph.Objects.Count > SimpleGraph.SelectedObjects.Count);
  EditLockNodes.Checked := SimpleGraph.LockNodes;
  ObjectsNone.Checked :=(SimpleGraph.CommandMode = cmEdit);
  ObjectsRectangle.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TRectangularNode);
  ObjectsRoundRect.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TRoundRectangularNode);
  ObjectsEllipse.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TEllipticNode);
  ObjectsTriangle.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TTriangularNode);
  ObjectsRhomboid.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TRhomboidalNode);
  ObjectsPentagon.Checked :=(SimpleGraph.CommandMode = cmInsertNode) and
   (SimpleGraph.DefaultNodeClass = TPentagonalNode);
  ObjectsLink.Enabled :=(SimpleGraph.ObjectsCount(TGraphNode) >= 2);
  ObjectsLink.Checked :=(SimpleGraph.CommandMode = cmLinkNodes);
  ViewZoomOut.Enabled := (SimpleGraph.Zoom > SimpleGraph.ZoomMin);
  ViewZoomIn.Enabled := (SimpleGraph.Zoom < SimpleGraph.ZoomMax);
  if SimpleGraph.Modified then
    StatusBar.Panels[4].Text := SModified
  else
    StatusBar.Panels[4].Text := SNotModified;
  StatusBar.Panels[5].Text := Format('%d%%', [SimpleGraph.Zoom]);
end;

procedure TMainForm.cbxFontSizeChange(Sender: TObject);
var
  I: Integer;
  FontSize: Integer;
begin
  try
    FontSize := StrToInt(cbxFontSize.Text);
  except
    Exit;
  end;
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        SelectedObjects[I].Font.Size := FontSize;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.cbxFontNameChange(Sender: TObject);
var
  I: Integer;
  FontName: String;
begin
  FontName := cbxFontName.Items[cbxFontName.ItemIndex];
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        SelectedObjects[I].Font.Name := FontName;
    finally
      EndUpdate;
    end;
  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.FormCreate(Sender: TObject);
begin
  {$IFDEF DELPHI7_UP}
  TXPManifest.Create(Self);
  {$ENDIF}
  Application.OnHint := ShowHint;
  SimpleGraphCommandModeChange(nil);
  cbxFontName.Items := Screen.Fonts;
  if ParamCount > 0 then
  begin
    SimpleGraph.LoadFromFile(ParamStr(1));
    SaveDialog.FileName := ExpandFileName(ParamStr(1));
    Caption := SaveDialog.FileName + ' - ' + Application.Title;
  end;
end;

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

procedure TMainForm.SimpleGraphCanMoveResizeNode(Graph: TSimpleGraph;
  Node: TGraphNode;var NewLeft, NewTop, NewWidth, NewHeight: Integer;
  var CanMove, CanResize: Boolean);
begin
  if SimpleGraph.SelectedObjects.Count = 1 then
  begin
    StatusBar.Panels[1].Text := Format('(%d, %d)', [NewLeft, NewTop]);
    StatusBar.Panels[2].Text := Format('%d x %d', [NewWidth, NewHeight]);
  end;
end;

procedure TMainForm.SimpleGraphObjectSelect(Graph: TSimpleGraph;
  GraphObject: TGraphObject);
var
  Node: TGraphNode;
  PosFirstLine: integer;
begin
  if (SimpleGraph.SelectedObjects.Count > 0) then
  begin
    GraphObject := SimpleGraph.SelectedObjects[0];
    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);
  end;
  if (SimpleGraph.SelectedObjects.Count = 1) and
     (SimpleGraph.SelectedObjects[0] is TGraphNode) then
  begin
    Node := TGraphNode(SimpleGraph.SelectedObjects[0]);
    case Node.Alignment of
      taCenter: FormatCenter.Checked := True;
      taLeftJustify: FormatAlignLeft.Checked := True;
      taRightJustify: FormatAlignRight.Checked := True;
    end;
    StatusBar.Panels[1].Text := Format('(%d, %d)', [Node.Left, Node.Top]);
    StatusBar.Panels[2].Text := Format('%d x %d', [Node.Width, Node.Height]);
    PosFirstLine := Pos(#$D#$A, Node.Text);
    if PosFirstLine <> 0 then
      StatusBar.Panels[3].Text := Copy(Node.Text, 1, PosFirstLine)
    else
      StatusBar.Panels[3].Text := Node.Text;
  end
  else
  begin
    StatusBar.Panels[1].Text := '';
    StatusBar.Panels[2].Text := '';
    StatusBar.Panels[3].Text := '';
  end;
end;

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

procedure TMainForm.SimpleGraphObjectInsert(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
    Size := StrToIntDef(cbxFontSize.Text, Size);
    Name := cbxFontName.Text;
    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;
  end;
end;

end.