wfeditorui.pas

Delphi开发的一款流程图处理软件

    mniSelAllObj: TMenuItem;
    mniSelAllCon: TMenuItem;
    mniSelAllObj1: TMenuItem;
    mniSelAllCon1: TMenuItem;
    procedure btnCreateConnectClick(Sender: TObject);
    procedure btnCreateObjectClick(Sender: TObject);
    procedure ViewChange(Sender: TdxCustomFlowChart; Item: TdxFcItem);
    procedure ViewDblClick(Sender: TObject);
    procedure ViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ViewMouseDown(Sender: TObject; Button: TMouseButton; Shift:
            TShiftState; X, Y: Integer);
    procedure ViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
            Integer);
    procedure ViewMouseUp(Sender: TObject; Button: TMouseButton; Shift:
            TShiftState; X, Y: Integer);
    procedure ChartPopupMenuPopup(Sender: TObject);
    procedure ViewSelected(Sender: TdxCustomFlowChart; Item: TdxFcItem);
    procedure ViewSelection(Sender: TdxCustomFlowChart; Item: TdxFcItem; var
            Allow: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure iRectangleClick(Sender: TObject);
    procedure pBlackMouseDown(Sender: TObject; Button: TMouseButton; Shift:
            TShiftState; X, Y: Integer);
    procedure pColorClick(Sender: TObject);
    procedure pColorDblClick(Sender: TObject);
    procedure sbConnectFontClick(Sender: TObject);
    procedure sbFitClick(Sender: TObject);
    procedure sbObjectFontClick(Sender: TObject);
    procedure sbShapeClick(Sender: TObject);
    procedure sbZoomClick(Sender: TObject);
    procedure pBkColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure actOpenExecute(Sender: TObject);
    procedure actSaveAsExecute(Sender: TObject);
    procedure actUndoExecute(Sender: TObject);
    procedure actCutExecute(Sender: TObject);
    procedure actCopyExecute(Sender: TObject);
    procedure actPasteExecute(Sender: TObject);
    procedure actDeleteExecute(Sender: TObject);
    procedure actSelAllExecute(Sender: TObject);
    procedure actClearSelectionExecute(Sender: TObject);
    procedure actBringToFrontExecute(Sender: TObject);
    procedure actSendToBackExecute(Sender: TObject);
    procedure actZoomInExecute(Sender: TObject);
    procedure actZoomOutExecute(Sender: TObject);
    procedure actFitExecute(Sender: TObject);
    procedure actActualSizeExecute(Sender: TObject);
    procedure actNewUnionExecute(Sender: TObject);
    procedure actAddToUnionExecute(Sender: TObject);
    procedure actRemoveFromUnionExecute(Sender: TObject);
    procedure actClearUnionExecute(Sender: TObject);
    procedure actClearAllUnionsExecute(Sender: TObject);
    procedure actContensExecute(Sender: TObject);
    procedure actPropExecute(Sender: TObject);
    procedure actRemovePointExecute(Sender: TObject);
    procedure actAlignLeftExecute(Sender: TObject);
    procedure actAlignRightExecute(Sender: TObject);
    procedure actAlignHCenterExecute(Sender: TObject);
    procedure actSpaceEquHExecute(Sender: TObject);
    procedure actSpaceEquHXExecute(Sender: TObject);
    procedure actIncWidthExecute(Sender: TObject);
    procedure actDecWidthExecute(Sender: TObject);
    procedure actMakeMaxWidthExecute(Sender: TObject);
    procedure actMakeMinWidthExecute(Sender: TObject);
    procedure actMakeSameWidthExecute(Sender: TObject);
    procedure actSpaceDecHExecute(Sender: TObject);
    procedure actSpaceIncHExecute(Sender: TObject);
    procedure actAlignTopExecute(Sender: TObject);
    procedure actAlignBottomExecute(Sender: TObject);
    procedure actAlignVCenterExecute(Sender: TObject);
    procedure actSpaceEquVExecute(Sender: TObject);
    procedure actSpaceEquVYExecute(Sender: TObject);
    procedure actIncHeightExecute(Sender: TObject);
    procedure actDecHeightExecute(Sender: TObject);
    procedure actMakeMaxHeightExecute(Sender: TObject);
    procedure actMakeMinHeightExecute(Sender: TObject);
    procedure actMakeSameHeightExecute(Sender: TObject);
    procedure actSpaceDecVExecute(Sender: TObject);
    procedure actSpaceIncVExecute(Sender: TObject);
    procedure actlstLayoutUpdate(Action: TBasicAction;
      var Handled: Boolean);
    procedure actlstWfEditorUpdate(Action: TBasicAction;
      var Handled: Boolean);
    procedure actFindExecute(Sender: TObject);
    procedure actFindNextExecute(Sender: TObject);
    procedure dlgFindFind(Sender: TObject);
    procedure dlgReplaceFind(Sender: TObject);
    procedure dlgReplaceClose(Sender: TObject);
    procedure dlgReplaceShow(Sender: TObject);
    procedure actReplaceExecute(Sender: TObject);
    procedure dlgReplaceReplace(Sender: TObject);
    procedure actSetPointExecute(Sender: TObject);
    procedure actViewSizeExecute(Sender: TObject);
    procedure actSelAllObjExecute(Sender: TObject);
    procedure actSelAllConExecute(Sender: TObject);
  private
    BitmapList: TList;
    Buf: TList;
    BufChart: TdxFlowChart;
    DownPoint: TPoint;
    FChange: Boolean;
    FNewObject: Boolean;
    FPE: Boolean;
    FSelect: Boolean;
    FStore: Boolean;
    FUndo: TWfEditorUndo;
    LastObj: TdxFcObject;
    OldPoint: TPoint;
    FView: TWfView;
    FFindStr: string;
    FFindPos: Integer;
    FFindRep: Boolean;
    procedure ChangeConnections(Mode : Integer);
    procedure ChangeObjects(Mode : Integer);
    procedure ClearBuf;
    procedure ConAssign(Source, Dest : TdxFcConnection);
    procedure CopyToBuf;
    procedure Layout(lt:TLayoutType);
    function FindObj(iStart:Integer):Boolean;
    function FindCon(iStart:Integer):Boolean;
    procedure DrawDrag(P1, P2 : TPoint; Mode : Integer);
    function GetImageIndexByMenuItem(Item : TmenuItem): Integer;
    procedure MultiSelect(ResetOldSelected : Boolean; SelectRect : TRect);
    procedure ObjAssign(Source, Dest : TdxFcObject);
    procedure PasteFromBuf;
    procedure SelectLastConnect;
    procedure SelectLastObject;
    procedure SetGlyph(SB : TSpeedButton; PM : TPopupMenu);
    procedure Find;
  public
    function CanKeyEnter(Edit : TEdit; Key : Char; MinValue, MaxValue :
            Integer): Boolean;
    function ChartHasUnions(AView : TdxFlowChart): Boolean;
    function FindAllUnions(AView : TdxFlowChart; FromUnion : TdxFcObject):
            TdxFcObject;
    function FindUnions(AView : TdxFlowChart; FromUnion, Obj : TdxFcObject):
            TdxFcObject;
    function GetMainItemInUnion(AView : TdxFlowChart; Obj : TdxFcObject):
            TdxFcObject;
    function GetNumberByUnion(AView : TdxFlowChart; Obj : TdxFcObject):
            Integer;
    function GetUnionByNumber(AView : TdxFlowChart; Number : Integer):
            TdxFcObject;
    function IntegerToStr(S : String): Integer;
    function IsChildItemInUnion(AView : TdxFlowChart; Obj : TdxFcObject):
            Boolean;
    function IsMainItemInUnion(Obj : TdxFcObject): Boolean;
    property View:TWfView read FView write FView;
  end;

var
  fWfEditorUI: TfWfEditorUI;
  OldHintHidePause : Integer;

const
  crFlChartZoomIn = 2001;
  crFlChartZoomOut = 2002;

implementation

uses WfActiUI, WfConnUI, WfUnionUI, WfXyUI;

{$R *.DFM}

{TWfBuferItem}

procedure TWfEditorBuferItem.SetObject(Value: TObject);
begin
  FObject := Value;
end;

procedure TWfEditorBuferItem.SetObjectType(Value: TItemType);
begin
  FObjectType := Value;
end;

{TWfUndo}

constructor TWfEditorUndo.Create;
begin
  FStream := TMemoryStream.Create;
  FStep := 0;
  FUndoSteps := 10;
  FCanUndo := False;
end;

destructor TWfEditorUndo.Destroy;
begin
  FStream.Free;
  inherited;
end;

procedure TWfEditorUndo.SetChart(Value: TWfView);
begin
  FChart := Value;
end;

procedure TWfEditorUndo.SetUndoSteps(Value: Integer);
begin
  FUndoSteps := Value;
  if FUndoSteps > 200 then FUndoSteps := 200;
end;

procedure TWfEditorUndo.Store;
var
  Stream1, Stream2: TMemoryStream;
  i, StartPos: Integer;
  F: Boolean;
begin
  Stream1 := TMemoryStream.Create;
  Stream2 := TMemoryStream.Create;
  FChart.SaveToStream(Stream1);
  if FStep > 0 then begin
    StartPos := 0;
    for i := 1 to FStep - 1 do StartPos := StartPos + FLength[i];
    FStream.Position := StartPos;
    Stream2.Position := 0;
    Stream2.CopyFrom(FStream, FLength[FStep]);
  end;
  if Stream2.Size <> 0 then
    F := CompareMem(Stream1.Memory, Stream2.Memory, Stream1.Size)
  else F := False;
  if not ( F and (Stream1.Size = Stream2.Size)) then begin
    if FStep >= FUndoSteps then begin
      Stream2.Clear;
      FStream.Position := FLength[1];
      Stream2.Position := 0;
      Stream2.CopyFrom(FStream, FStream.Size - FLength[1]);
      FStream.Clear;
      Stream2.Position := 0;
      FStream.Position := 0;
      FStream.CopyFrom(Stream2, 0);
      dec(FStep);
      for i := 1 to FStep do FLength[i] := FLength[i+1];
    end;
    StartPos := 0;
    for i := 1 to FStep do StartPos := StartPos + FLength[i];
    FStream.Position := StartPos;
    FStream.CopyFrom(Stream1, 0);
    inc(FStep);
    FLength[FStep] := Stream1.Size;
  end;
  Stream1.Free;
  Stream2.Free;
  FCanUndo := FStep > 1;
end;

procedure TWfEditorUndo.Undo;
var
  Stream: TMemoryStream;
  StartPos, i: Integer;
begin
  if not FCanUndo then exit;
  Stream := TMemoryStream.Create;
  StartPos := 0;
  for i := 1 to FStep - 2 do StartPos := StartPos + FLength[i];
  FStream.Position := StartPos;
  Stream.CopyFrom(FStream, FLength[FStep - 1]);
  Stream.Position := 0;
  FChart.LoadFromStream(Stream);
  dec(FStep);
  if FStep <= 1 then FCanUndo := False;
  StartPos := 0;
  for i := 1 to FStep do StartPos := StartPos + FLength[i];
  FStream.Size := StartPos;
  Stream.Free;
end;

{ TfWfEditor }

procedure TfWfEditorUI.btnCreateConnectClick(Sender: TObject);
begin
  if (View.SelectedObjectCount=2) and (View.SelectedConnectionCount=0) then begin
    with View do begin
      FStore := False;
      CreateConnection(SelectedObjects[0],SelectedObjects[1], 0, 0);
      Connections[ConnectionCount - 1].Style := TdxFclStyle(sbStyle.Tag - 1);
      SelectLastConnect;
      ChangeConnections(0);
      FStore := True;
      ViewChange(View, nil);
    end;
    btnCreateConnect.Down := False;
  end else
    if TSpeedButton(Sender).Down then View.ClearSelection;
  if btnS.Down then
    btnS.Down:=False;
  if btnE.Down then
    btnE.Down:=False;
  if btnT.Down then
    btnT.Down:=False;
end;

procedure TfWfEditorUI.btnCreateObjectClick(Sender: TObject);
begin
  if TSpeedButton(Sender).Down then
  begin
    View.ClearSelection;
    if (TSpeedButton(Sender).Name='btnS') and View.HasTyp(atStart) then
    begin
      btnS.Down:=False;
      Exit;
    end;
    if (TSpeedButton(Sender).Name='btnE') and View.HasTyp(atEnd) then
    begin
      btnE.Down:=False;
      Exit;
    end;
    if (TSpeedButton(Sender).Name='btnS') or
       (TSpeedButton(Sender).Name='btnE') or
       (TSpeedButton(Sender).Name='btnT') then
      btnCreateObject.Down:=True;
  end else
    if btnCreateObject.Down then
      btnCreateObject.Down:=False;
end;

function TfWfEditorUI.CanKeyEnter(Edit : TEdit; Key : Char; MinValue, MaxValue
        : Integer): Boolean;
var
  Text: string;
  Value: Integer;
begin
  if Key >= #32 then begin
    if Edit.SelLength = 0 then Text := Edit.Text + Key
    else Text := Copy(Edit.Text, 1, Edit.SelStart - 1) + Key + Copy(Edit.Text, Edit.SelStart+Edit.SelLength, Length(Edit.Text) - Edit.SelStart - Edit.SelLength + 1);
  end else Text := Edit.Text;
  try
    if Text = '' then Value := 1
    else Value := StrToInt(Text);
    if (Value >= MinValue) and (Value <= MaxValue) then Result := True else Result := False;
  except
    Result := False;
  end;
end;

procedure TfWfEditorUI.ChangeConnections(Mode : Integer);
var
  i: Integer;
  AStore, AChange: Boolean;
begin
  if not FStore then AStore := False else AStore := True;
  if AStore then FStore := False;
  AChange := False;
  for i := 0 to View.SelectedConnectionCount-1 do
  begin
    if Mode in [0,11] then TWfConnG(View.SelectedConnections[i]).LineWidth:=btnLine.Tag;
    with View.SelectedConnections[i] do begin
      if Mode in [0,1] then Style := TdxFclStyle(sbStyle.Tag - 1);
      if Mode in [0,2] then Color := pColor.Brush.Color;
      if Mode in [0,3] then ArrowSource.ArrowType := TdxFcaType(sbSourceArrow.Tag);
      if Mode in [0,4] then ArrowDest.ArrowType := TdxFcaType(sbDestArrow.Tag);
      if Mode in [0,5] then ArrowSource.Width := sbSArrowSize.Tag * 5 + 5;
      if Mode in [0,5] then ArrowSource.Height := sbSArrowSize.Tag * 5 + 5;
      if Mode in [0,6] then ArrowDest.Width := sbDArrowSize.Tag * 5 + 5;
      if Mode in [0,6] then ArrowDest.Height := sbDArrowSize.Tag * 5 + 5;
      if Mode in [0,7] then SetObjectSource(ObjectSource,sbSPoint.Tag);
      if Mode in [0,8] then SetObjectDest(ObjectDest, sbDPoint.Tag);
      if Mode in [0,9] then Font.Assign(sbConnectFont.Font);
      if Mode in [0,10] then ArrowSource.Color := pBkColor.Brush.Color;
      if Mode in [0,10] then ArrowDest.Color := pBkColor.Brush.Color;
      AChange := True;
    end;
  end;
  if AStore then begin
    FStore := True;
    if AChange then ViewChange(View, nil);
  end;
end;

procedure TfWfEditorUI.ChangeObjects(Mode : Integer);
var
  i, Position: Integer;
  AStore, AChange: Boolean;
begin
  if not FStore then AStore := False else AStore := True;
  if AStore then FStore := False;
  AChange := False;
  for i := 0 to View.SelectedObjectCount-1 do begin
    with View.SelectedObjects[i] do begin
      if Mode in [0,1] then ShapeType := TdxFcShapeType(sbShape.Tag);
      if Mode in [0,2] then ShapeWidth := sbLine.Tag;
      if Mode in [0,3] then ShapeColor := pColor.Brush.Color;
      if Mode in [0,4] then BkColor := pBkColor.Brush.Color;
      if Mode in [0,5] then begin
        Position := sbTextPosition.Tag;