main.pas

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

{------------------------------------------------------------------------------}
{                                                                              }
{  TSimpleGraph Demonstration Program                                          }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  SimpleGraph {$IFDEF DELPHI7_UP}, XPMan {$ENDIF}, Dialogs, ExtDlgs,
  Menus, ActnList, ImgList, StdCtrls, ComCtrls, ToolWin, JPEG;

type
  TMainForm = class(TForm)
    SimpleGraph: TSimpleGraph;
    ToolBar: TToolBar;
    StatusBar: TStatusBar;
    ImageList: TImageList;
    ActionList: TActionList;
    FileNew: TAction;
    FileOpen: TAction;
    FileSave: TAction;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    FileExit: TAction;
    N1: TMenuItem;
    Exit1: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    EditCut: TAction;
    EditCopy: TAction;
    EditPaste: TAction;
    EditDelete: TAction;
    EditSelectAll: TAction;
    EditLockNodes: TAction;
    Edit1: TMenuItem;
    EditCut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Delete1: TMenuItem;
    N2: TMenuItem;
    SelectAll1: TMenuItem;
    N3: TMenuItem;
    LockNodes1: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ObjectsNone: TAction;
    ObjectsRectangle: TAction;
    ObjectsRoundRect: TAction;
    ObjectsEllipse: TAction;
    ObjectsLink: TAction;
    Opjects1: TMenuItem;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    EditBringToFront: TAction;
    EditSendToBack: TAction;
    N6: TMenuItem;
    BringToFront1: TMenuItem;
    SendToBack1: TMenuItem;
    EditProperties: TAction;
    N7: TMenuItem;
    Properties1: TMenuItem;
    DesignerPopup: TPopupMenu;
    ObjectsPopup: TPopupMenu;
    Properties2: TMenuItem;
    Cut1: TMenuItem;
    Copy2: TMenuItem;
    Paste2: TMenuItem;
    Delete2: TMenuItem;
    N8: TMenuItem;
    Properties3: TMenuItem;
    N10: TMenuItem;
    N12: TMenuItem;
    SelectAllNodes1: TMenuItem;
    ToolButton18: TToolButton;
    Paste5: TMenuItem;
    EditMode1: TMenuItem;
    N4: TMenuItem;
    InsertRectangle1: TMenuItem;
    InsertRoundRectangle1: TMenuItem;
    InsertEllipse1: TMenuItem;
    N5: TMenuItem;
    LinkObjects1: TMenuItem;
    N9: TMenuItem;
    InsertRectangle2: TMenuItem;
    InsertRoundRectangle2: TMenuItem;
    InsertEllipse2: TMenuItem;
    N14: TMenuItem;
    LinkObjects2: TMenuItem;
    N15: TMenuItem;
    BringToFront2: TMenuItem;
    SendToBack2: TMenuItem;
    FilePrint: TAction;
    N16: TMenuItem;
    Print1: TMenuItem;
    PrinterSetupDialog: TPrinterSetupDialog;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    btnSaveAs: TToolButton;
    FileSaveAs: TAction;
    FileSaveAs1: TMenuItem;
    HelpAbout: TAction;
    Help1: TMenuItem;
    About2: TMenuItem;
    FormatToolBar: TToolBar;
    cbxFontName: TComboBox;
    cbxFontSize: TComboBox;
    btnBoldface: TToolButton;
    btnItalic: TToolButton;
    btnUnderline: TToolButton;
    FormatBold: TAction;
    FormatItalic: TAction;
    FormatUnderline: TAction;
    FormatAlignLeft: TAction;
    FormatCenter: TAction;
    FormatAlignRight: TAction;
    ToolButton27: TToolButton;
    ToolButton28: TToolButton;
    ToolButton29: TToolButton;
    FileExport: TAction;
    SavePictureDialog: TSavePictureDialog;
    ToolButton30: TToolButton;
    Export1: TMenuItem;
    ToolButton17: TToolButton;
    ToolButton25: TToolButton;
    ViewZoomIn: TAction;
    ViewZoomOut: TAction;
    ToolButton26: TToolButton;
    ToolButton31: TToolButton;
    ToolButton32: TToolButton;
    ObjectsTriangle: TAction;
    ToolButton33: TToolButton;
    ObjectsRhomboid: TAction;
    ToolButton34: TToolButton;
    ObjectsPentagon: TAction;
    ToolButton35: TToolButton;
    procedure FileNewExecute(Sender: TObject);
    procedure FileOpenExecute(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure FileSaveAsExecute(Sender: TObject);
    procedure FileExportExecute(Sender: TObject);
    procedure FilePrintExecute(Sender: TObject);
    procedure FileExitExecute(Sender: TObject);
    procedure EditCutExecute(Sender: TObject);
    procedure EditCopyExecute(Sender: TObject);
    procedure EditPasteExecute(Sender: TObject);
    procedure EditDeleteExecute(Sender: TObject);
    procedure EditSelectAllExecute(Sender: TObject);
    procedure EditSendToBackExecute(Sender: TObject);
    procedure EditBringToFrontExecute(Sender: TObject);
    procedure EditLockNodesExecute(Sender: TObject);
    procedure EditPropertiesExecute(Sender: TObject);
    procedure FormatBoldExecute(Sender: TObject);
    procedure FormatItalicExecute(Sender: TObject);
    procedure FormatUnderlineExecute(Sender: TObject);
    procedure FormatAlignLeftExecute(Sender: TObject);
    procedure FormatCenterExecute(Sender: TObject);
    procedure FormatAlignRightExecute(Sender: TObject);
    procedure HelpAboutExecute(Sender: TObject);
    procedure ObjectsNoneExecute(Sender: TObject);
    procedure ObjectsRectangleExecute(Sender: TObject);
    procedure ObjectsRoundRectExecute(Sender: TObject);
    procedure ObjectsEllipseExecute(Sender: TObject);
    procedure ObjectsTriangleExecute(Sender: TObject);
    procedure ObjectsLinkExecute(Sender: TObject);
    procedure ObjectsRhomboidExecute(Sender: TObject);
    procedure ObjectsPentagonExecute(Sender: TObject);
    procedure ViewZoomInExecute(Sender: TObject);
    procedure ViewZoomOutExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject;var CanClose: Boolean);
    procedure ActionListUpdate(Action: TBasicAction;var Handled: Boolean);
    procedure cbxFontSizeChange(Sender: TObject);
    procedure cbxFontNameChange(Sender: TObject);
    procedure SimpleGraphDblClick(Sender: TObject);
    procedure SimpleGraphNodeDblClick(Graph: TSimpleGraph;
      Node: TGraphNode);
    procedure SimpleGraphLinkDblClick(Graph: TSimpleGraph;
      Link: TGraphLink);
    procedure FormCreate(Sender: TObject);
    procedure SimpleGraphCommandModeChange(Sender: TObject);
    procedure SimpleGraphCanMoveResizeNode(Graph: TSimpleGraph;
      Node: TGraphNode;var NewLeft, NewTop, NewWidth, NewHeight: Integer;
      var CanMove, CanResize: Boolean);
    procedure SimpleGraphObjectSelect(Graph: TSimpleGraph;
      GraphObject: TGraphObject);
    procedure SimpleGraphObjectDblClick(Graph: TSimpleGraph;
      GraphObject: TGraphObject);
    procedure SimpleGraphObjectInsert(Graph: TSimpleGraph;
      GraphObject: TGraphObject);
  private
    function IsGraphSaved: Boolean;
    procedure ShowHint(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  Clipbrd, Printers, DesignProp, NodeProp, LinkProp, ObjectProp,
  AboutDelphiArea;

resourcestring
  SSaveChanges   = 'Graph has been changed, would you like to save changes?';
  SViewOnly      = 'View Only';
  SEditing       = 'Editing';
  SLinkingNodes  = 'Linking Nodes';
  SInsertingNode = 'Inserting Node';
  SModified      = 'Modified';
  SNotModified   = '';
  SUntitled      = 'Untitled';

function TMainForm.IsGraphSaved: Boolean;
begin
  Result := True;
  if SimpleGraph.Modified then
    case MessageDlg(SSaveChanges, mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
      mrYes:
        begin
          FileSave.Execute;
          Result := not SimpleGraph.Modified;
        end;
      mrCancel:
        Result := False;
    end;
end;

procedure TMainForm.ShowHint(Sender: TObject);
begin
  StatusBar.Panels[6].Text := Application.Hint;
end;

procedure TMainForm.FileNewExecute(Sender: TObject);
begin
  if IsGraphSaved then
  begin
    SimpleGraph.Clear;
    SaveDialog.FileName := SUntitled;
    Caption := SaveDialog.FileName + ' - ' + Application.Title;
  end;
end;

procedure TMainForm.FileOpenExecute(Sender: TObject);
begin
  if IsGraphSaved and OpenDialog.Execute then
  begin
    SimpleGraph.LoadFromFile(OpenDialog.FileName);
    SaveDialog.FileName := OpenDialog.FileName;
    Caption := SaveDialog.FileName + ' - ' + Application.Title;
  end;
end;

procedure TMainForm.FileSaveExecute(Sender: TObject);
begin
  if SaveDialog.FileName <> SUntitled then
  begin
    SimpleGraph.SaveToFile(SaveDialog.FileName);
    Caption := SaveDialog.FileName + ' - ' + Application.Title;
  end
  else
  begin
    if SaveDialog.Execute then
      SimpleGraph.SaveToFile(SaveDialog.FileName);
  end;
  Caption := SaveDialog.FileName + ' - ' + Application.Title;
end;

procedure TMainForm.FileSaveAsExecute(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    SimpleGraph.SaveToFile(SaveDialog.FileName);
    Caption := SaveDialog.FileName + ' - ' + Application.Title;
  end;
end;

procedure TMainForm.FileExportExecute(Sender: TObject);
begin
  SavePictureDialog.FileName := ChangeFileExt(SaveDialog.FileName, '.' + SavePictureDialog.DefaultExt);
  if SavePictureDialog.Execute then
    SimpleGraph.SaveAsMetafile(SavePictureDialog.FileName);
end;

procedure TMainForm.FilePrintExecute(Sender: TObject);
var
  Rect: TRect;
begin
  if PrinterSetupDialog.Execute then
  begin
    SetRect(Rect, 0, 0, Printer.PageWidth, Printer.PageHeight);
    InflateRect(Rect, -50, -50);
    Printer.BeginDoc;
    SimpleGraph.Print(Printer.Canvas, Rect);
    Printer.EndDoc;
  end;
end;

procedure TMainForm.FileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.EditCutExecute(Sender: TObject);
begin
  EditCopy.Execute;
  EditDelete.Execute;
end;

procedure TMainForm.EditCopyExecute(Sender: TObject);
begin
  SimpleGraph.CopyToClipboard(True);
end;

procedure TMainForm.EditPasteExecute(Sender: TObject);
begin
  SimpleGraph.PasteFromClipboard;
end;

procedure TMainForm.EditDeleteExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        SelectedObjects[I].Free;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.EditSelectAllExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      // SelectedObjects.Assign(Objects, laOr);
      for I := 0 to Objects.Count - 1 do
        Objects[I].Selected := True;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.EditSendToBackExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        SelectedObjects[I].SendToBack;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.EditBringToFrontExecute(Sender: TObject);
var
  I: Integer;
begin
  with SimpleGraph do
  begin
    BeginUpdate;
    try
      for I := SelectedObjects.Count - 1 downto 0 do
        SelectedObjects[I].BringToFront;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TMainForm.EditLockNodesExecute(Sender: TObject);
begin
  SimpleGraph.LockNodes := not SimpleGraph.LockNodes;
end;