flexbase.pas

是一套创建矢量图形的VCL组件

begin
 if CanFree then begin
  Include(FState, fsDestroying);
  inherited;
 end;
end;

procedure TFlexControl.FreeInstance;
begin
 if fsDestroying in FState then inherited;
end;

function TFlexControl.CanFree: boolean;
begin
 Result := true;
end;

procedure TFlexControl.CreateProperties;
begin
 FIdProp := TLongWordProp.Create(FProps, 'ID');
 FIdProp.Style := FIdProp.Style + [ psNonVisual ];
 FTagProp := TIntProp.Create(FProps, 'Tag');
 FTagProp.Style := FTagProp.Style + [ psNonVisual ];
 FNameProp := TStrProp.Create(FProps, 'Name');
 FNameProp.Style := FNameProp.Style + [ psDontStore, psNonVisual ];
 FLeftProp := TIntProp.Create(FProps, 'Left');
 FLeftProp.Style := FLeftProp.Style + [ psScalable ];
 FTopProp := TIntProp.Create(FProps, 'Top');
 FTopProp.Style := FTopProp.Style + [ psScalable ];
 FWidthProp := TIntProp.Create(FProps, 'Width');
 FWidthProp.Style := FWidthProp.Style + [ psScalable ];
 FHeightProp := TIntProp.Create(FProps, 'Height');
 FHeightProp.Style := FHeightProp.Style + [ psScalable ];
 FVisibleProp := TBoolProp.Create(FProps, 'Visible');
 FVisibleProp.Style := FVisibleProp.Style - [ psVisible ] + [ psDontStore ];
 FHintProp := TStrListProp.Create(FProps, 'Hint');
 FHintProp.Style := FHintProp.Style + [ psNonVisual ];
 FShowHintProp := TBoolProp.Create(FProps, 'ShowHint');
 FShowHintProp.Style := FShowHintProp.Style + [ psNonVisual ];
 FLayerProp := TStrProp.Create(FProps, 'Layer');
 FLayerProp.Style := FLayerProp.Style + [ psRef ];
 FLayerProp.OnGetString := GetLayerStrProp;
 //FLayerProp.Style := [ psVisible ];
 FReferenceProp := TSchemeRefProp.Create(FProps, 'Reference');
 FReferenceProp.Style := FReferenceProp.Style + [ psNonVisual, psRef ];
 FUserDataProp := TUserDataProp.Create(FProps, 'UserData');
end;

procedure TFlexControl.ControlCreate;
begin
 if Assigned(FOwner) then begin
  FOwner.GenerateID(Self);
  if (NameProp.Value = '') and not FOwner.IsLoading then
   Name := FOwner.GetDefaultNewName(Self);
 end;
 FShowHintProp.Value := true;
 DoNotify(fnCreated);
end;

procedure TFlexControl.ControlDestroy;
begin
 DoNotify(fnDestroyed);
end;

class function TFlexControl.CursorInCreate: TCursor;
begin
 Result := crCreateControlCursor;
end;

class function TFlexControl.GetToolInfo(ToolIcon: TBitmap;
  var Hint: string): boolean;
begin
 Result := False;
end;

procedure TFlexControl.DoNotify(Notify: TFlexNotify);
begin
 if Assigned(FOwner) then FOwner.DoNotify(Self, Notify);
end;

procedure TFlexControl.SetParent(const Value: TFlexControl);
begin
 if Value = FParent then exit;
 if Assigned(Value) then
  Value.Add(Self)
 else
 if Assigned(FParent) then
  FParent.Extract(Self);
end;

function TFlexControl.Add(AControl: TFlexControl): integer;
var {PassRec: TPassControlRec;
    Control: TFlexControl;}
    IsSameOwner: boolean;
begin
 Result := FControls.IndexOf(AControl);
 if Result >= 0 then exit;
 if Assigned(AControl.Parent) then AControl.Parent.Extract(AControl);
 IsSameOwner := not Assigned(FOwner) or (AControl.Owner = FOwner);
 if not IsSameOwner then AControl.Owner := FOwner;
 Result := FControls.Add(AControl);
 AControl.FParent := Self;
{ if not IsSameOwner then begin
  // Validate IDs
  Control := AControl;
  FirstControl(Control, PassRec);
  try
   while Assigned(Control) do begin
    FOwner.ValidateID(Control, 0);
    Control := NextControl(PassRec);
   end;
  finally
   ClosePassRec(PassRec);
  end;
 end;   }
 if Assigned(FLayer) and (AControl.Layer <> FLayer)
  then AControl.Layer := FLayer
  else AControl.Invalidate;
 DoNotify(fnOrder);
end;

procedure TFlexControl.Clear;
var i: integer;
begin
 i := FControls.Count-1;
 while i >= 0 do begin
  Delete(i);
  dec(i);
 end;
end;

procedure TFlexControl.Delete(Index: integer);
begin
 with TFlexControl(FControls[Index]) do
  if not ((fsDestroying in FState) or (fsExtracting in Self.FState)) then
   Free
  else begin
   FParent := Nil;
   Self.FOwner.Unselect(TFlexControl(Self.FControls[Index]));
   Self.FControls.Delete(Index);
   DoNotify(fnOrder);
  end;
end;

procedure TFlexControl.Remove(AControl: TFlexControl);
var Index: integer;
begin
 Index := FControls.IndexOf(AControl);
 if Index >=0 then Delete(Index);
end;

procedure TFlexControl.Extract(AControl: TFlexControl);
begin
 Include(FState, fsExtracting);
 try
  AControl.IsSelected := False;
  AControl.Invalidate;
  Remove(AControl);
  if FControls.IndexOf(AControl) < 0 then begin
   AControl.FParent := Nil;
   AControl.FLayer := Nil;
  end;
 finally
  Exclude(FState, fsExtracting);
 end;
end;

procedure TFlexControl.ChangeOrder(CurIndex, NewIndex: integer);
begin
 if CurIndex = NewIndex then exit;
 FControls.Move(CurIndex, NewIndex);
 Controls[NewIndex].Invalidate;
 DoNotify(fnOrder);
end;

function TFlexControl.IndexOf(AControl: TFlexControl): integer;
begin
 Result := FControls.IndexOf(AControl);
end;

function TFlexControl.FindControlAtPoint(x, y: integer): TFlexControl;
var i: integer;
begin
 Result := Nil;
 for i:=FControls.Count-1 downto 0 do
  with TFlexControl(FControls[i]) do
   if FVisibleProp.Value and (not Assigned(FLayer) or FLayer.Selectable) and
      IsPointInside(x, y) then begin
    Result := TFlexControl(Self.FControls[i]);
    break;
   end;
end;

function TFlexControl.ValidateName(CheckEmpty, CheckUnique: boolean): boolean;
var i: integer;
begin
 Result := not (CheckEmpty and (FNameProp.Value = ''));
 if Result and CheckUnique and Assigned(FParent) then begin
  for i:=0 to FParent.Count-1 do
   if (FParent[i] <> Self) and
      (CompareStr(FNameProp.Value, FParent[i].Name) = 0) then begin
    Result := False;
    break;
   end;
 end;
end;

function TFlexControl.BeginUpdate: boolean;
begin
 Result := FUpdateCounter = 0;
 if Result then Invalidate;
 inc(FUpdateCounter);
end;

function TFlexControl.EndUpdate: boolean;
begin
 if FUpdateCounter = 0 then
  Result := False
 else begin
  dec(FUpdateCounter);
  Result := FUpdateCounter = 0;
  if Result then Invalidate;
 end;
end;

function TFlexControl.GetAnchorPoint: TPoint;
begin
 with DocRect do begin
  Result.X := Left;
  Result.Y := Top;
 end;
 FOwner.TransformPoint(Result);
end;

function TFlexControl.CreatePointsPath(DC: HDC): boolean;
begin
 Result := false;
end;

function TFlexControl.GetTransformPoints(OfsX, OfsY,
  Scale: integer): TPointArray;
var i, AddX, AddY: integer;
    Denominator: integer;
begin
 SetLength(Result, PointCount);
 if PointCount = 0 then exit;
 with DocRect do begin
  AddX := Left;
  AddY := top;
 end;
 dec(OfsX, ScaleValue(AddX, Scale));
 dec(OfsY, ScaleValue(AddY, Scale));
 Denominator := 100 * PixelScaleFactor;
 for i:=0 to PointCount-1 do with Points[i] do begin
  Result[i].X := MulDiv(X+AddX, Scale, Denominator) + OfsX;
  Result[i].Y := MulDiv(Y+Addy, Scale, Denominator) + OfsY;
 end;
end;

function TFlexControl.GetPoint(Index: integer): TPoint;
begin
 Result.x := 0;
 Result.y := 0;
end;

procedure TFlexControl.SetPoint(Index: integer; const Value: TPoint);
begin
end;

procedure TFlexControl.SetPoints(const APoints: TPointArray);
var Types: TPointTypeArray;
    i, Count: integer;
begin
 Count := Length(APoints);
 SetLength(Types, Count);
 if Count > 0 then begin
  for i:=0 to Count-2 do Types[i] := ptNode;
  if IsPointsClosed
   then Types[Count-1] := ptEndNodeClose
   else Types[Count-1] := ptEndNode;
 end;
 SetPointsEx(APoints, Types);
end;

procedure TFlexControl.SetPointsEx(const APoints: TPointArray;
  const ATypes: TPointTypeArray);
begin
end;

procedure TFlexControl.GetPointsEx(out APoints: TPointArray;
  out ATypes: TPointTypeArray);
begin
end;

function TFlexControl.GetPointType(Index: integer): TPointType;
begin
 if Index = PointCount-1 then begin
  if IsPointsClosed
   then Result := ptEndNodeClose
   else Result := ptEndNode;
 end else
  Result := ptNode;
end;

procedure TFlexControl.SetPointType(Index: integer;
  const Value: TPointType);
begin
end;

function TFlexControl.GetIsPointsClosed: boolean;
begin
 Result := True;
end;

procedure TFlexControl.SetIsPointsClosed(Value: boolean);
begin
end;

function TFlexControl.FlattenPoints(const Curvature: single): boolean;
begin
 Result := false;
end;

function TFlexControl.FindNearestPoint(const Point: TPoint;
  var Nearest: TNearestPoint): boolean;
begin
 Result := false;
end;

function TFlexControl.FindNearestPathSegment(const Point: TPoint;
  var FirstIndex, NextIndex: integer): boolean;
begin
 Result := false;
end;

function TFlexControl.EditPoints(Func: TPathEditFunc;
  const Selected: TSelectedArray; Params: PPathEditParams = Nil): boolean;
begin
 Result := false;
end;

function TFlexControl.EditPointsCaps(
  const Selected: TSelectedArray): TPathEditFuncs;
begin
 Result := [];
end;

function TFlexControl.InsertPoint(Index: integer; const Point: TPoint): integer;
begin
 Result := -1;
end;

function TFlexControl.InsertCurvePoints(Index: integer; const Point,
  CtrlPointA, CtrlPointB: TPoint): integer;
begin
 Result := -1;
end;

procedure TFlexControl.DeletePoint(Index: integer);
begin 
end;

function TFlexControl.AddCurvePoints(const Point, CtrlPointA,
  CtrlPointB: TPoint): integer;
begin
 Result := InsertCurvePoints(PointCount, Point, CtrlPointA, CtrlPointB);
end;

function TFlexControl.AddPoint(const Point: TPoint): integer;
begin
 Result := InsertPoint(PointCount, Point);
end;

function TFlexControl.InsertCurveNode(NodeIndex: integer; const Point,
  CtrlPointA, CtrlPointB: TPoint): integer;
var Index: integer;
begin
 Result := -1;
 if NodeIndex = NodeCount
  then Index := PointCount
  else Index := GetPointIndex(NodeIndex);
 if InsertCurvePoints(Index, Point, CtrlPointA, CtrlPointB) >= 0 then
  Result := NodeIndex;
end;

procedure TFlexControl.DeleteNode(NodeIndex: integer);
begin
 DeletePoint(GetPointIndex(NodeIndex));
end;

function TFlexControl.InsertNearestPoint(const Point: TPoint): integer;