⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wfeditorui.pas

📁 工作流流程编辑器(含全部源码),别人的东西
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        HorzTextPos := TdxFcHorzPos(Position mod 3);
        VertTextPos := TdxFcVertPos(Position div 3);
      end;
      if Mode in [0,6] then begin
        Position := sbImagePosition.Tag;
        HorzImagePos := TdxFcHorzPos(Position mod 3);
        VertImagePos := TdxFcVertPos(Position div 3);
      end;
      if Mode in [0,7] then Font.Assign(sbObjectFont.Font);
      AChange := True;
    end;
  end;
  if AStore then begin
    FStore := True;
    if AChange then ViewChange(View, nil);
  end;
end;

procedure TfWfEditorUI.ViewChange(Sender: TdxCustomFlowChart; Item:
        TdxFcItem);
begin
  if Self.HandleAllocated then begin
    ViewSelected(View, nil);
    if FStore then begin
      FUndo.Store;
      actUndo.Enabled := FUndo.CanUndo;
    end;
  end;
end;

procedure TfWfEditorUI.ViewDblClick(Sender: TObject);
var
  hTest: TdxFcHitTest;
  Res: Boolean;
begin
  hTest := View.GetHitTestAt(DownPoint.X, DownPoint.Y);
  if (hTest * [htByObject,htOnObject]) <> [] then
    if View.SelectedObjectCount > 0 then begin
      FStore := False;
      Res := ObjectEditor(View, TWfActiG(View.SelectedObjects[0]), TWfActiG(View.SelectedObjects[0]).ActiType);
      FStore := True;
      FSelect := False;
      FPE := True; // Fix: by Kirill
      if Res then ViewChange(View, nil);
      ViewSelected(View, nil);
    end;
  if (hTest * [htOnConnection, htOnConLabel,htOnArrowSrc,htOnArrowDst]) <> [] then
    if View.SelectedConnectionCount > 0 then begin
      FStore := False;
      Res := ConnectEditor(View, TWfConnG(View.SelectedConnections[0])); // PropertForm
      FStore := True;
      FSelect := False;
      if Res then ViewChange(View, nil);
      ViewSelected(View, nil);
    end;
end;

function TfWfEditorUI.ChartHasUnions(AView : TdxFlowChart): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to AView.ObjectCount - 1 do
    if AView.Objects[i].IsUnion then begin
      Result := True;
      break;
    end;
end;

procedure TfWfEditorUI.ViewKeyDown(Sender: TObject; var Key: Word; Shift:
        TShiftState);
var
  P: TPoint;
begin

  if (Key = VK_MENU) and btnZoomIn.Down then View.Cursor := crFlChartZoomOut;
  if Key = VK_APPS then begin
    GetCursorPos(P);
    P := View.ScreenToClient(P);
    DownPoint := Point(P.X, P.Y);
    GetCursorPos(P);
    ChartPopupMenu.Popup(P.X, P.Y);
  end;
  if (Key = VK_INSERT) and (ssCtrl in Shift) and iCopy.Enabled then actCopy.ExecuteTarget(iCopy);
  if (Key = VK_INSERT) and (ssShift in Shift) and iPaste.Enabled then actPaste.ExecuteTarget(iPaste);
  if (Key = VK_DELETE) and (ssShift in Shift) and iCut.Enabled then actCut.ExecuteTarget(iCut);

  if FSelect and (Key <> VK_SHIFT) then
    if Key <> VK_ESCAPE then begin
      GetCursorPos(P);
      P := View.ScreenToClient(P);
      ViewMouseUp(View, mbLeft, [], P.X, P.Y);
    end else begin
      ClipCursor(nil);
      DrawDrag(DownPoint, OldPoint, 3);
      FSelect := False;
    end;

  if FNewObject then begin
    if btnCreateObject.Down then begin
      GetCursorPos(P);
      P := View.ScreenToClient(P);
      if (Abs(DownPoint.X - P.X) > 5) and (Abs(DownPoint.Y - P.Y) > 5) and (Key <> VK_ESCAPE)then
        ViewMouseUp(View, mbLeft, [], P.X, P.Y)
      else begin
        btnCreateObject.Down := False;
        DrawDrag(DownPoint, OldPoint, 1);
        FNewObject := False;
        ClipCursor(nil);
      end;
    end;
    if btnCreateConnect.Down then begin
      GetCursorPos(P);
      P := View.ScreenToClient(P);
      if ((Abs(DownPoint.X - P.X) > 5) or (Abs(DownPoint.Y - P.Y) > 5)) and (Key <> VK_ESCAPE) then
        ViewMouseUp(View, mbLeft, [], P.X, P.Y)
      else begin
        btnCreateConnect.Down := False;
        DrawDrag(DownPoint, OldPoint, 2);
        FNewObject := False;
        ClipCursor(nil);
      end;
    end;
  end;

end;

procedure TfWfEditorUI.ViewKeyUp(Sender: TObject; var Key: Word; Shift:
        TShiftState);
begin
  if Key = VK_MENU then begin
    if btnZoomIn.Down then View.Cursor := crFlChartZoomIn
    else View.Cursor := crDefault;
  end;
  if Key = VK_DELETE then ViewChange(View, nil);
end;

procedure TfWfEditorUI.ViewMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
var
  hTest: TdxFcHitTest;
  R: TRect;
  SObj: TdxFcObject;
begin
  if Button = mbLeft then begin
    DownPoint := Point(X, Y);
    OldPoint := DownPoint;
  end;

  if btnZoomIn.Down then begin
    if ssAlt in Shift then begin
      if View.Zoom > 20 then View.Zoom := View.Zoom - 10
    end else begin
      if View.Zoom < 490 then View.Zoom := View.Zoom + 10;
    end;
    actActualSize.Enabled := (View.Zoom <> 100) and (not btnFit.Down);
    exit;
  end;

  hTest := View.GetHitTestAt(X,Y);
  if (hTest = [dxflchrt.htNowhere]) and (Button = mbLeft) and (not (ssShift in Shift)) then
    View.ClearSelection;
  if (btnCreateObject.Down or btnCreateConnect.Down) and (Button = mbLeft) then begin
    SObj := View.GetObjectAt(DownPoint.X, DownPoint.Y);
    FNewObject := True;
    if SObj<>nil then
    begin
      R := View.ClientRect;
      R.TopLeft := View.ClientToScreen(R.TopLeft);
      R.BottomRight := View.ClientToScreen(R.BottomRight);
      ClipCursor(@R);
      View.ClearSelection;
    end else
    begin
      if btnCreateConnect.Down then
        btnCreateConnect.Down:=False;
    end;
  end;
  if ((hTest - [dxflchrt.htNowhere, dxflchrt.htByObject]) = []) and (Button = mbLeft) and (not btnCreateObject.Down) and (not btnCreateConnect.Down)
     and (not FPE) then begin  // Fix: by Kirill "and (not FPE)"
    FSelect := True;
    R := View.ClientRect;
    R.TopLeft := View.ClientToScreen(R.TopLeft);
    R.BottomRight := View.ClientToScreen(R.BottomRight);
    ClipCursor(@R);
    if not ((ssShift in Shift)) then View.ClearSelection;
  end;
  if FPE then FPE := False; // Fix: by Kirill
end;

procedure TfWfEditorUI.ViewMouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
var
  UpPoint: TPoint;
  Obj: TdxFcObject;
  AText, CountText: string;
  FirstObj: TdxFcObject;
  Count: Integer;
  procedure DrawStat;
  begin
    statWFEditor.Panels[1].Text:=IntToStr(DownPoint.X)+','+IntToStr(DownPoint.Y);
    statWFEditor.Panels[3].Text:=IntToStr(Abs(X-DownPoint.X))+','+IntToStr(Abs(Y-DownPoint.Y));
  end;
begin
  if btnZoomIn.Down then Exit;

  statWFEditor.Panels[2].Text:=IntToStr(X)+','+IntToStr(Y);
  UpPoint := Point(X, Y);
  if btnCreateObject.Down and FNewObject then begin
    DrawDrag(DownPoint, OldPoint, 1);
    DrawDrag(DownPoint, UpPoint, 1);
    OldPoint := UpPoint;
    DrawStat;
  end;
  if btnCreateConnect.Down and FNewObject and  ((Abs(UpPoint.Y - DownPoint.Y) > 5) or (Abs(UpPoint.X - DownPoint.X) > 5)) then begin
    DrawDrag(DownPoint, OldPoint, 2);
    DrawDrag(DownPoint, UpPoint, 2);
    OldPoint := UpPoint;
    DrawStat;
  end;

  if FSelect then begin
    DrawDrag(DownPoint, OldPoint, 3);
    DrawDrag(DownPoint, UpPoint, 3);
    OldPoint := UpPoint;
    DrawStat;
  end;
  
  if not (btnCreateConnect.Down or btnCreateObject.Down) then begin
    Obj := View.GetObjectAt(X, Y);
    AText := '';
    if Obj <> nil then begin
      if IsMainItemInUnion(Obj) then AText := '组合'+IntToStr(GetNumberByUnion(View, Obj))+'的主项';
      if IsChildItemInUnion(View, Obj) then begin
        FirstObj := nil;
        Count := 0;
        CountText := '';
        repeat
          FirstObj := FindUnions(View, FirstObj, Obj);
          if FirstObj <> nil then begin
            if Count = 0 then CountText := CountText + IntToStr(GetNumberByUnion(View, FirstObj))
            else CountText := CountText + ', '+IntToStr(GetNumberByUnion(View, FirstObj));
            inc(Count);
          end;
        until FirstObj = nil;
        if Count > 0 then begin
          if AText = '' then AText := '该子项属于'
          else AText := AText + '与子项属于';
          if Count > 1 then AText := AText + '组合'
          else AText := AText +'组合';
          AText := AText + CountText;
        end;
      end;
    end;
    if AText = '' then Obj := nil;
    if (Obj <> nil) and (Obj <> LastObj) then begin
      Application.HintHidePause := 5000;
      View.Hint := AText;
      View.ShowHint := True;
      LastObj := Obj;
    end else if Obj <> LastObj then begin
               View.ShowHint := False;
               LastObj := nil;
               Application.HintHidePause := OldHintHidePause;
             end;
  end;
end;

procedure TfWfEditorUI.ViewMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
var
  ALeft, ATop, SPoint, DPoint, Temp: Integer;
  P1, P2: TPoint;
  SObj, DObj, Obj: TdxFcObject;
  Con: TdxFcConnection;
begin
  statWFEditor.Panels[1].Text:='';
  statWFEditor.Panels[2].Text:='';
  statWFEditor.Panels[3].Text:='';

  if btnZoomIn.Down then exit;

  if Button=mbRight then
  begin
    if btnS.Down then
      btnS.Down:=False;
    if btnE.Down then
      btnE.Down:=False;
    if btnT.Down then
      btnT.Down:=False;
  end;

  if btnCreateObject.Down then begin
    btnCreateObject.Down := False;
    DrawDrag(DownPoint, OldPoint, 1);
    if (Abs(DownPoint.X - X) < 75) then
      X:=DownPoint.X+75;
    if (Abs(DownPoint.Y - Y) < 25) then
      Y:=DownPoint.Y+25;
    if Button = mbLeft then
    begin
      FChange := False;
      P1 := View.ChartPoint(DownPoint.X, DownPoint.Y);
      P2 := View.ChartPoint(X, Y);
      if P1.X < P2.X then ALeft := P1.X else ALeft := P2.X;
      if P1.Y < P2.Y then ATop := P1.Y else ATop := P2.Y;
      FStore := False;
      View.CreateObject(ALeft , ATop, Abs(P1.X - P2.X), Abs(P1.Y - P2.Y), TdxFcShapeType(sbShape.Tag));
      SelectLastObject;
      ChangeObjects(0);
      FChange := True;
      Obj := View.Objects[View.ObjectCount-1];
      if btnS.Down or btnE.Down or btnT.Down then
      begin
        Obj.Width:=20;
        Obj.Height:=20;
        Obj.ShapeType:=fcsEllipse;
        if btnS.Down then
        begin
          TWfActiG(Obj).ActiType:=atStart;
          Obj.Text:='S';
          btnS.Down:=False;
        end;
        if btnE.Down then
        begin
          TWfActiG(Obj).ActiType:=atEnd;
          Obj.Text:='E';
          btnE.Down:=False;
        end;
        if btnT.Down then
        begin
          TWfActiG(Obj).ActiType:=atTerminate;
          Obj.Text:='T';
          btnT.Down:=False;
        end;
      end else
      begin
        TWfActiG(Obj).ActiType:=atNormal;
        if Obj.Text = '' then Obj.Text := '活动 ' + IntToStr(View.ObjectCount);
      end;
      FStore := True;
      ViewChange(View, nil);
    end;
  end;
  if btnCreateConnect.Down then begin
    btnCreateConnect.Down := False;
    DrawDrag(DownPoint, OldPoint, 2);
    if (Button = mbLeft) and ((Abs(DownPoint.X - X) > 5) or (Abs(DownPoint.Y - Y) > 5)) then begin
      FChange := False;
      FStore := False;
      SObj := View.GetObjectAt(DownPoint.X, DownPoint.Y);
      DObj := View.GetObjectAt(X, Y);
      if SObj <> nil then SPoint := SObj.GetLinkedPoint(DownPoint.X, DownPoint.Y) else SPoint := sbSPoint.Tag;
      if DObj <> nil then DPoint := DObj.GetLinkedPoint(X, Y) else DPoint := sbDPoint.Tag;
      if (SObj<>nil) and (DObj<>nil) and
         (TWfActiG(SObj).ActiType<>atEnd) and
         (TWfActiG(SObj).ActiType<>atTerminate) and
         (TWfActiG(DObj).ActiType<>atStart) and
         not ((TWfActiG(SObj).ActiType=atStart) and ((TWfActiG(DObj).ActiType=atEnd) or (TWfActiG(DObj).ActiType=atTerminate))) and
         not View.HasConn(SObj,DObj) then
      begin
        View.CreateConnection(SObj, DObj , SPoint, DPoint);
        Con := View.Connections[View.ConnectionCount-1];
        if View.GetObjectAt(DownPoint.X, DownPoint.Y) = nil then Con.AddPoint(View.ChartPoint(DownPoint.X, DownPoint.Y));
        if View.GetObjectAt(X, Y) = nil then Con.AddPoint(View.ChartPoint(X, Y));
        SelectLastConnect;
        sbSPoint.Tag := SPoint;
        sbDPoint.Tag := DPoint;
        ChangeConnections(0);
        FChange := True;
        SelectLastConnect;
        FStore := True;
        ViewChange(View, nil);
      end;
    end;
  end;
  FNewObject := False;
  ClipCursor(nil);
  if FSelect then begin
    P1 := DownPoint;
    P2 := Point(X, Y);
   DrawDrag(DownPoint, OldPoint, 3);
     if Button = mbLeft then begin
       if P1.x > P2.x then begin Temp:=P1.x; P1.x:=P2.x; P2.x:=Temp; end; // Fix: by Kirill
       if P1.y > P2.y then begin Temp:=P1.y; P1.y:=P2.y; P2.y:=Temp; end; // Fix: by Kirill
       MultiSelect(not(ssShift in Shift), Rect(P1.X, P1.Y, P2.X, P2.Y));
     end;
  end;
  FSelect := False;

  if Button = mbRight then begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -