ddoc.pas

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

    begin
      { Root }
      BlockDocument(Value).BlockRoot.Free;
      BlockDocument(Value).BlockRoot := Root(Self);
    end
    else
      if (Value <> nil) and (Value is Block) then
      begin
        Block(Value).AddBlock(Self);
      end;
end;

function Block.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

procedure Block.SetName(const NewName: TComponentName);
var
  S: string;
begin
//  S := UniqueName(NewName);
  inherited SetName(NewName);
end;

function Block.SnapToGridValue(Value: Float): Float;
begin
  if FSnapToGrid then
    Result := Round(Value / GridStep) * GridStep
  else
    Result := Value;
end;

function Block.PtOnBlock(X, Y: Float): boolean;
var
  i: integer;
begin
  if Blocks.Count > 0 then
  begin
    for i := 0 to Blocks.Count - 1 do
      with Blocks[i].ToBlockCoordFromParent(X, Y) do
        if Blocks[i].PtOnBlock(X, Y) then
        begin
          Result := true;
          Exit;
        end;
    Result := false;
  end
  else
    if (X >= 0) and (Y >= 0) and (X <= FWidth) and (Y <= FHeight) then
      Result := true // shape is rect
    else
      Result := false;
end;

function Block.ToBlockCoord(X, Y: Float): FloatPoint;
var
  P: FloatPoint;
begin
  P.X := X;
  P.Y := Y;
  if (Parent <> nil) and not (Parent is Root) then
    P := Parent.ToBlockCoord(P.X, P.Y);

  Result := ToBlockCoordFromParent(P.X, P.Y);
{  CurParent := Self;
  while (CurParent <> nil) and not (CurParent is Root) do
  begin
    P := CurParent.ToBlockCoordFromParent(P.X, P.Y);
    CurParent := CurParent.Parent;
  end;}
end;

function Block.FromBlockCoord(X, Y: Float): FloatPoint;
var
  P: FloatPoint;
begin
  P.X := X;
  P.Y := Y;

  P := FromBlockCoordToParent(P.X, P.Y);
  if (Parent <> nil) and not (Parent is Root) then
    P := Parent.FromBlockCoord(P.X, P.Y);
{  CurParent := Self;
  while (CurParent <> nil) and not (CurParent is Root) do
  begin
    P := CurParent.FromBlockCoordToParent(P.X, P.Y);
    CurParent := CurParent.Parent;
  end;}

  Result := P;
end;

function Block.ToBlockCoordFromParent(X, Y: Float): FloatPoint;
var
  M: TGPMatrix;
begin
  M := TGPMatrix.Create;
  try
    Result.X := X - FLeft;
    Result.Y := Y - FTop;

    if FAngle <> 0 then
    begin
      M.Rotate(-FAngle);
    end;

    M.TransformPoints(PGPPointF(@Result), 1);
  finally
    M.Free;
  end;
end;

function Block.FromBlockCoordToParent(X, Y: Float): FloatPoint;
var
  M: TGPMatrix;
begin
  M := TGPMatrix.Create;
  try
    if FAngle <> 0 then
    begin
      M.Rotate(FAngle);
    end;

    Result.X := X;
    Result.Y := Y;

    M.TransformPoints(PGPPointF(@Result), 1);

    Result.X := Result.X + FLeft;
    Result.Y := Result.Y + FTop;
  finally
    M.Free;
  end;
end;

function Block.PixelateValue(Value: Float): Float;
begin
  Result := Round(Value / DevicePixel) * DevicePixel;
end;

function Block.PixelatePoint(X, Y: Float): FloatPoint;
begin
  Result.X := Round(X / DevicePixel) * DevicePixel;
  Result.Y := Round(Y / DevicePixel) * DevicePixel;
end;

{ Points }

function Block.PointByName(AName: string): BlockPoint;
var
  i: integer;
begin
  for i := 0 to Points.Count - 1 do
    if LowerCase(Points[i].Name) = LowerCase(AName) then
    begin
      Result := Points[i];
      Exit;
    end;
  Result := nil;
end;

function Block.PointXByName(AName: string): Float;
var
  P: BlockPoint;
begin
  P := PointByName(AName);
  if P <> nil then
    Result := P.X
  else
    Result := 0;
end;

function Block.PointYByName(AName: string): Float;
var
  P: BlockPoint;
begin
  P := PointByName(AName);
  if P <> nil then
    Result := P.Y
  else
    Result := 0;
end;

function Block.PointByPoint(X, Y: Float): BlockPoint;
var
  i: integer;
  R: TNotificationResult;
  Rt: FloatRect;
begin
  R := nil;
  for i := Points.Count - 1 downto 0 do
  begin
    if not Points[i].Enabled then Continue;
    R := PerformNotification(deGetPointRect, Self, [Integer(Self), Integer(Points[i])]);
    if (High(R) >= 0) then
    begin
      Rt.Left := R[0];
      Rt.Top := R[1];
      Rt.Right := R[2];
      Rt.Bottom := R[3];
      if (X > Rt.Left) and (X < Rt.Right) and (Y > Rt.Top) and (Y < Rt.Bottom) then
      begin
        Result := Points[i];
        Exit;
      end;
    end;
  end;
  Result := nil;
end;

function Block.EditPointByPoint(X, Y: Float): BlockPoint;
var
  i: integer;
  R: TNotificationResult;
  Rt: FloatRect;
begin
  R := nil;
  for i := Points.Count - 1 downto 0 do
  begin
    if not Points[i].Enabled then Continue;
    if Points[i].Kind in [pkSnapPoint, pkBlockSnapPoint] then Continue;

    R := PerformNotification(deGetPointRect, Self, [Integer(Self), Integer(Points[i])]);
    if (High(R) >= 0) then
    begin
      Rt.Left := R[0];
      Rt.Top := R[1];
      Rt.Right := R[2];
      Rt.Bottom := R[3];
      if (X > Rt.Left) and (X < Rt.Right) and (Y > Rt.Top) and (Y < Rt.Bottom) then
      begin
        Result := Points[i];
        Exit;
      end;
    end;
  end;
  Result := nil;
end;

function Block.PointByKind(Kind: PointKind): BlockPoint;
var
  i: integer;
begin
  for i := Points.Count - 1 downto 0 do
  begin
    if Points[i].Kind = Kind then
    begin
      Result := Points[i];
      Exit;
    end;
  end;
  Result := nil;
end;

function GetAngleByPoint(P, Center: FloatPoint): Float;
begin
  if (P.X - Center.X = 0) and (P.Y - Center.Y = 0) then
    Result := 0
  else
    if (P.X - Center.X = 0) then
    begin
      if P.Y - Center.Y > 0 then
        Result := 90
      else
        Result := 270;
    end
    else
    begin
      Result := (ArcTan((P.Y - Center.Y) / (P.X - Center.X)) * (360 / (2 * Pi)));
      if P.X - Center.X > 0 then
      begin
        if P.Y - Center.Y >= 0 then
          Result := Result
        else
          Result := 360 + Result;
      end
      else
        Result := 180 + Result;
    end;
end;

procedure Block.MovePoint(APoint: BlockPoint; X, Y: Float);
var
  L, T: Float;
  P, GP1, GP2: FloatPoint;
  P1: BlockPoint;
  Len, NewAngle, MoveAngle, StartRadius, MoveRadius: Float;
  B: FloatRect;
begin
  if APoint = nil then Exit;
  if not (APoint.Kind in [pkRotate, pkRotateLeftTop, pkRotateRightTop, pkRotateRightBottom, pkRotateLeftBottom]) then
  begin
    X := SnapToGridValue(X);
    Y := SnapToGridValue(Y);
  end;

  if (APoint.X = X) and (APoint.Y = Y) then Exit;

  if (APoint.Kind in [pkRotate, pkRotateLeftTop, pkRotateRightTop, pkRotateRightBottom, pkRotateLeftBottom]) then
  begin
    P := MakePoint(APoint.X, APoint.Y);
    if (P.X - FRotateCenter.X) <> 0 then
    begin
      NewAngle := (ArcTan((Y - FRotateCenter.Y) / (X - FRotateCenter.X)) * (360 / (2 * Pi)));
      if X - FRotateCenter.X > 0 then
        if Y - FRotateCenter.Y > 0 then
          NewAngle := NewAngle
        else
          NewAngle := 360 + NewAngle;

      MoveAngle := (ArcTan((P.Y - FRotateCenter.Y) / (P.X - FRotateCenter.X)) * (360 / (2 * Pi)));
      if P.X - FRotateCenter.X > 0 then
        if P.Y - FRotateCenter.Y > 0 then
          MoveAngle := MoveAngle
        else
          MoveAngle := 360 + MoveAngle;

      SetBounds(Left, Top, Width, Height, FAngle + (NewAngle - MoveAngle), true);
    end
    else
    begin
      NewAngle := (ArcTan((X - FRotateCenter.X) / (Y - FRotateCenter.Y)) * (360 / (2 * Pi)));
      if Y - FRotateCenter.Y > 0 then
        if X - FRotateCenter.X > 0 then
          NewAngle := NewAngle
        else
          NewAngle := 360 + NewAngle;

      MoveAngle := (ArcTan((P.X - FRotateCenter.X) / (P.Y - FRotateCenter.Y)) * (360 / (2 * Pi)));
      if P.Y - FRotateCenter.Y > 0 then
        if P.X - FRotateCenter.X > 0 then
          MoveAngle := MoveAngle
        else
          MoveAngle := 360 + MoveAngle;

      SetBounds(Left, Top, Width, Height, FAngle - (NewAngle - MoveAngle), true);
    end;
  end;

  if (APoint.Kind = pkRotateCenter) then
  begin
    FRotateCenter.X := FRotateCenter.X + (X - APoint.X);
    FRotateCenter.Y := FRotateCenter.Y + (Y - APoint.Y);
    APoint.X := FRotateCenter.X;
    APoint.Y := FRotateCenter.Y;
    Repaint;
  end;

  if (APoint.Kind in [pkFreePoint, pkBlockPoint]) then
  begin
    P.X := APoint.X;
    P.Y := APoint.Y;
    case APoint.MoveStyle of
      msFree:
        begin
          APoint.X := X;
          APoint.Y := Y;
        end;
      msHorizontal: APoint.X := X;
      msVertical: APoint.Y := Y;
      msEllipse:
        begin
          { Snap to Ellipse }
          if APoint.CenterPoint <> nil then
          begin
            StartRadius := Sqrt(Sqr(APoint.X - APoint.CenterPoint.X) + Sqr(APoint.Y - APoint.CenterPoint.Y));
            APoint.X := X;
            APoint.Y := Y;
            MoveRadius := Sqrt(Sqr(X - APoint.CenterPoint.X) + Sqr(Y - APoint.CenterPoint.Y));

            APoint.X := APoint.X - APoint.CenterPoint.X;
            APoint.Y := APoint.Y - APoint.CenterPoint.Y;

            APoint.X := APoint.X * (StartRadius / MoveRadius);
            APoint.Y := APoint.Y * (StartRadius / MoveRadius);

            APoint.X := APoint.X + APoint.CenterPoint.X;
            APoint.Y := APoint.Y + APoint.CenterPoint.Y;
          end;
        end;
    end;

    { All other point }
    B := IntBounds;
    UpdateBounds;
    RepaintRect(B);
    Repaint;
  end;

  if (APoint.Kind in [pkLeftRotate, pkRightRotate, pkBottomRotate, pkTopRotate]) then
  begin
    P.X := APoint.X;
    P.Y := APoint.Y;
    P1 := APoint.CenterPoint;

    case APoint.MoveStyle of
      msFree:
        begin
          APoint.X := X;
          APoint.Y := Y;
        end;
      msHorizontal: APoint.X := X;
      msVertical: APoint.Y := Y;
      msEllipse:
        begin
          { Snap to Ellipse }
          if APoint.CenterPoint <> nil then
          begin
            StartRadius := Sqrt(Sqr(APoint.X - APoint.CenterPoint.X) + Sqr(APoint.Y - APoint.CenterPoint.Y));
            APoint.X := X;
            APoint.Y := Y;
            MoveRadius := Sqrt(Sqr(X - APoint.CenterPoint.X) + Sqr(Y - APoint.CenterPoint.Y));

            APoint.X := APoint.X - APoint.CenterPoint.X;
            APoint.Y := APoint.Y - APoint.CenterPoint.Y;

            APoint.X := APoint.X * (StartRadius / MoveRadius);
            APoint.Y := APoint.Y * (StartRadius / MoveRadius);

            APoint.X := APoint.X + APoint.CenterPoint.X;
            APoint.Y := APoint.Y + APoint.CenterPoint.Y;
          end;
        end;
    end;

    if (P1 <> nil) then
    begin
      GP1 := MakePoint(APoint.X, APoint.Y);
      GP2 := MakePoint(P1.X, P1.Y);
      NewAngle := GetAngleByPoint(GP1, GP2);

      GP1 := P;
      GP2 := MakePoint(P1.X, P1.Y);
      MoveAngle := GetAngleByPoint(GP1, GP2);

      Len := Sqrt(Sqr(APoint.X - P1.X) + Sqr(APoint.Y - P1.Y));
      APoint.X := P.X;
      APoint.Y := P.Y;

      case APoint.Kind of
        pkLeftRotate:
          begin
            FRotateCenter.X := P1.X;
            FRotateCenter.Y := P1.Y;

            B := IntBounds;
            SetBounds(FLeft, FTop, FWidth, FHeight, FAngle + (NewAngle - MoveAngle), false);
            P := FromBlockCoord(FWidth - Len, 0.0);
            SetBounds(P.X, P.Y, Len, FHeight, FAngle, false);

            RepaintRect(B);
            Repaint;
          end;
        pkTopRotate: ;
        pkRightRotate:
          begin
            FRotateCenter.X := P1.X;
            FRotateCenter.Y := P1.Y;

            B := IntBounds;
            SetBounds(Left, Top, Width, Height, FAngle + (NewAngle - MoveAngle), false);
            SetBounds(Left, Top, Len, Height, FAngle, false);
            RepaintRect(B);
            Repaint;
          end;
        pkBottomRotate: ;
      end;