ddoc.pas

KSDev.BlockEngine.v3.03.rar 界面控件

    AddBlock(TextBlock.Create(nil));
    TextBlock(Blocks[0]).Text := '';
    TextBlock(Blocks[0]).Grouped := true;
    TextBlock(Blocks[0]).Locked := true;
  end;

  FShowSnapPoint := true;
  FDesignState := FDesignState + [dsCanResize, dsCanRotate];
  FSnapToGrid := false;
end;

destructor Block.Destroy;
begin
  FPoints.Free;
  FStroke.Free;
  FFill.Free;
  FBlocks.Free;
//  FreeName(Name);
  inherited;
end;

procedure Block.Loaded;
var
  B: Block;
begin
  inherited;
  if (Blocks.Count > 0) and (Blocks[0] is TextBlock) and (Blocks[0].Locked) then
  begin
    B := Blocks[0];
    RemoveBlock(B);
    B.Free;
  end;
end;

function Block.BlockByName(AName: WideString): Block;
var
  R: TNotificationResult;
  Sv: string;
begin
  Sv := AName;
  R := PerformNotification(deFindBlockByName, Self, StringToArray(Sv));
  if High(R) >= 0 then
    Result := Block(Trunc(R[0]))
  else
    Result := nil;
end;

procedure Block.CopyFrom(Source: Block);
var
  S: Block;
  P: BlockPoint;
  i: integer;
begin
  Stroke.Assign(Source.Stroke);
  Fill.Assign(Source.Fill);

  FLeft := Source.Left;
  FTop := Source.Top;
  FWidth := Source.Width;
  FHeight := Source.Height;

  if (Source.Blocks.Count > 0) and (Source.Blocks[0] is TextBlock) and
     (Source.Blocks.Count > 0) and (Blocks[0] is TextBlock) then
  begin
    Blocks[0].CopyFrom(Source.Blocks[0]);
  end;

  for i := 0 to Source.Blocks.Count - 1 do
  begin
    if Source.Blocks[i] is TextBlock then Continue;

    S := BlockClass(Source.Blocks[i].ClassType).Create(nil);
    AddBlock(S);
    S.CopyFrom(Source.Blocks[i]);
    S.FLeft := Source.Blocks[i].Left;
    S.FTop := Source.Blocks[i].Top;
    S.FWidth := Source.Blocks[i].Width;
    S.FHeight := Source.Blocks[i].Height;
    S.Grouped := true;
  end;

  Points.Clear;
  for i := 0 to Source.Points.Count - 1 do
  begin
    P := BlockPoint(Points.Add);
    P.CopyFrom(Source.Points[i]);
  end;
end;

procedure Block.AddBlock(ABlock: Block);
begin
  if ABlock = nil then Exit;
  { Add }
  if ABlock.Parent <> nil then
    ABlock.Parent.RemoveBlock(ABlock);
  { Set child property }
  if dsDesignMode in FDesignState then
    ABlock.DesignState := ABlock.DesignState + [dsDesignMode];
  ABlock.SnapToGrid := FSnapToGrid;
  ABlock.EditMode := FEditMode;

  { Add }
  Blocks.Add(ABlock);
  ABlock.FParent := Self;
end;

procedure Block.RemoveBlock(ABlock: Block);
begin
  if ABlock = nil then Exit;
  Blocks.Remove(ABlock);
  ABlock.FParent := nil;
end;

procedure Block.SaveUndoState;
begin
  PerformNotification(deUndoSaveState, Self, []);
end;

procedure Block.BringToFront;
begin
  if Parent = nil then Exit;
  SaveUndoState;
  Parent.Blocks.Remove(Self);
  Parent.Blocks.Add(Self);
  Repaint;
end;

procedure Block.SendToBack;
begin
  if Parent = nil then Exit;
  SaveUndoState;
  Parent.Blocks.Remove(Self);
  Parent.Blocks.Insert(0, Self);
  Repaint;
end;

procedure Block.FlipHorz;
var
  i: integer;
begin
  SaveUndoState;
  for i := 0 to Points.Count - 1 do
  begin
    Points[i].X := FWidth - Points[i].X;
    if Points[i].Kind = pkRight then Points[i].Kind := PointKind(100);
    if Points[i].Kind = pkRightTop then Points[i].Kind := PointKind(101);
    if Points[i].Kind = pkRightBottom then Points[i].Kind := PointKind(102);
    if Points[i].Kind = pkLeft then
    begin
      Points[i].Kind := pkRight;
      Points[i].Name := 'right';
    end;
    if Points[i].Kind = pkLeftTop then
    begin
      Points[i].Kind := pkRightTop;
      Points[i].Name := 'righttop';
    end;
    if Points[i].Kind = pkLeftBottom then
    begin
      Points[i].Kind := pkRightBottom;
      Points[i].Name := 'rightbottom';
    end;
  end;
  for i := 0 to Points.Count - 1 do
  begin
    if Integer(Points[i].Kind) = 100 then
    begin
      Points[i].Kind := pkLeft;
      Points[i].Name := 'left';
    end;
    if Integer(Points[i].Kind) = 101 then
    begin
      Points[i].Kind := pkLeftTop;
      Points[i].Name := 'lefttop';
    end;
    if Integer(Points[i].Kind) = 102 then
    begin
      Points[i].Kind := pkLeftBottom;
      Points[i].Name := 'leftbottom';
    end;
  end;

  for i := 0 to Blocks.Count - 1 do
  begin
    Blocks[i].FlipHorz;
    with Blocks[i].GetOnlyBounds do
      Blocks[i].Left := FWidth - (Blocks[i].Left + (Right - Left));
  end;

  Repaint;
end;

procedure Block.FlipVert;
var
  i: integer;
begin
  SaveUndoState;
  for i := 0 to Points.Count - 1 do
  begin
    Points[i].Y := FHeight - Points[i].Y;
    if Points[i].Kind = pkBottom then Points[i].Kind := PointKind(100);
    if Points[i].Kind = pkLeftBottom then Points[i].Kind := PointKind(101);
    if Points[i].Kind = pkRightBottom then Points[i].Kind := PointKind(102);
    if Points[i].Kind = pkTop then
    begin
      Points[i].Kind := pkBottom;
      Points[i].Name := 'bottom';
    end;
    if Points[i].Kind = pkLeftTop then
    begin
      Points[i].Kind := pkLeftBottom;
      Points[i].Name := 'leftbottom';
    end;
    if Points[i].Kind = pkRightTop then
    begin
      Points[i].Kind := pkRightBottom;
      Points[i].Name := 'rightbottom';
    end;
  end;
  for i := 0 to Points.Count - 1 do
  begin
    if Integer(Points[i].Kind) = 100 then
    begin
      Points[i].Kind := pkTop;
      Points[i].Name := 'top';
    end;
    if Integer(Points[i].Kind) = 101 then
    begin
      Points[i].Kind := pkLeftTop;
      Points[i].Name := 'lefttop';
    end;
    if Integer(Points[i].Kind) = 102 then
    begin
      Points[i].Kind := pkRightTop;
      Points[i].Name := 'righttop';
    end;
  end;

  for i := 0 to Blocks.Count - 1 do
  begin
    Blocks[i].FlipHorz;
    with Blocks[i].GetOnlyBounds do
      Blocks[i].Top := FHeight - (Blocks[i].Top + (Bottom - Top));
  end;

  Repaint;
end;

function Block.Connect(ABlock: Block): Line;
var
  i: integer;
  L: Block;
  StartP, EndP: string;
  CP: BlockPoint;
begin
  SaveUndoState;
  L := Line.Create(nil);
  Parent.AddBlock(L);

  StartP := 'start';
  EndP := 'end';

  for i := 0 to Points.Count - 1 do
    if (Points[i].FKind = pkBlockSnapPoint) and (L.PointByName(EndP) <> nil) then
    begin
      CP := L.PointByName(EndP);
      CP.FPointMovePos := L.FromBlockCoord(CP.X, CP.Y);
      Points[i].ConnectedPoints.Add(CP);
      CP.FDockBlock := Self;
      UpdateConnection(false);
      Break;
    end;
  Repaint;

  for i := 0 to ABlock.Points.Count - 1 do
    if (ABlock.Points[i].FKind = pkBlockSnapPoint) and (L.PointByName(StartP) <> nil) then
    begin
      CP := L.PointByName(StartP);
      CP.FPointMovePos := L.FromBlockCoord(CP.X, CP.Y);
      ABlock.Points[i].ConnectedPoints.Add(CP);
      CP.FDockBlock := ABlock;
      with ABlock do
        UpdateConnection(true);
      Break;
    end;
  ABlock.Repaint;

  L.Loaded;
  Result := Line(L);
end;

function Block.GroupSelected: Block;
var
  SList: TList;

 procedure ProcessBlock(S: Block);
 var
   i: integer;
 begin
   for i := 0 to S.Blocks.Count - 1 do
   begin
     if (not S.Blocks[i].Locked) and ((dsSelected in S.Blocks[i].FDesignState) or (dsFocused in S.Blocks[i].FDesignState)) then
     begin
       SList.Add(S.Blocks[i]);
     end
     else
       ProcessBlock(S.Blocks[i]);
   end;
 end;

var
  P: Block;
  i: integer;
  R, B: Float;
begin
  SaveUndoState;
  Result := nil;

  P := Self;
  while (P.Parent <> nil) and not (P.Parent is Root) do
    P := P.Parent;

  SList := TList.Create;
  try
    { Collect all selected shapes }
    ProcessBlock(P);
    if SList.Count > 0 then
    begin
      { Remove from parents }
      for i := 0 to SList.Count - 1 do
        Block(SList[i]).Parent.RemoveBlock(Block(SList[i]));

      { Create group }
      Result := Block.Create(nil);

      { Find Group position }
      Result.FLeft := $FFFFFF;
      Result.FTop := $FFFFFF;
      R := -$FFFFFF;
      B := -$FFFFFF;
      for i := 0 to SList.Count - 1 do
      begin
        with Block(SList[i]).GetOnlyBounds do
        begin
          if Result.Left > Left then
            Result.FLeft := Left;
          if Result.Top > Top then
            Result.FTop := Top;
          if R < Right then R := Right;
          if B < Bottom then B := Bottom;
        end;
      end;
      AddBlock(Result);
      Result.Width := R - Result.Left;
      Result.Height := B - Result.Top;

      { Add to group }
      for i := 0 to SList.Count - 1 do
      begin
        Result.AddBlock(Block(SList[i]));
        with Block(SList[i]) do
        begin
          FDesignState := FDesignState - [dsCaptureMouse, dsSelected, dsFocused];
          Grouped := true;
          FLeft := FLeft - Result.Left;
          FTop := FTop - Result.Top;
        end;
      end;

      Result.FDesignState := Result.FDesignState + [dsFocused];
      Result.Repaint;
    end;
  finally
    SList.Free;
  end;
end;

function Block.CanUngroup: boolean;
var
  i: integer;
  EnableUngroup: boolean;
begin
  Result := false;

  if Parent = nil then Exit;
  if Blocks.Count = 0 then Exit;

  EnableUngroup := false;
  for i := Blocks.Count - 1 downto 0 do
    if not Blocks[i].Locked then
    begin
      EnableUngroup := true;
      Break;
    end;
  if not EnableUngroup then Exit;

  Result := true;
end;

procedure Block.Ungroup;
var
  i: integer;
  S: Block;
  SaveRC: FloatPoint;
begin
  if not CanUngroup then Exit;
  SaveUndoState;

  { Remove from group }
  for i := Blocks.Count - 1 downto 0 do
  begin
    S := Blocks[i];
    if S.Locked then Continue;
    Parent.AddBlock(Blocks[i]);
    with S do
    begin
      FDesignState := FDesignState + [dsSelected];
      Grouped := false;
      with Self.FromBlockCoordToParent(FLeft, FTop) do
        SetBounds(X, Y, FWidth, FHeight, FAngle, false);

      if PointByKind(pkRotateCenter) <> nil then
      begin
        SaveRC := FRotateCenter;
        PointByKind(pkRotateCenter).X := 0;
        PointByKind(pkRotateCenter).Y := 0;
        FRotateCenter.X := 0;
        FRotateCenter.Y := 0;
        SetBounds(FLeft, FTop, FWidth, FHeight, FAngle + Self.Angle, true);
        PointByKind(pkRotateCenter).X := SaveRC.X;
        PointByKind(pkRotateCenter).Y := SaveRC.Y;
        FRotateCenter := SaveRC;
      end;
    end;
  end;
  for i := Blocks.Count - 1 downto 0 do
  begin
    S := Blocks[0];
    if S.Locked then Continue;
    RemoveBlock(S);
  end;
  FDesignState := FDesignState - [dsCaptureMouse, dsFocused, dsSelected];
  Repaint;
end;

procedure Block.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i: Integer;
begin
  inherited;
  for i := 0 to FBlocks.Count - 1 do
    Proc(FBlocks[i]);
end;

function Block.HasParent: Boolean;
begin
  Result := true;
end;

procedure Block.SetParentComponent(Value: TComponent);
begin
  if Parent <> nil then
    Parent.RemoveBlock(Self);

  if (Value <> nil) and (Value is TextBlock) then
  begin
    { Text }
  end
  else
    if (Value <> nil) and (Value is BlockDocument) then