flexbase.pas

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

begin
 Result := -1;
end;

procedure TFlexControl.EndFigure(Close: boolean);
var i: integer;
begin
 i := PointCount-1;
 while (i >= 0) and (PointTypes[i] = ptControl) do dec(i);
 if i >= 0 then
  if Close
   then PointTypes[i] := ptEndNodeClose
   else PointTypes[i] := ptEndNode;
end;

function TFlexControl.GetNode(NodeIndex: integer): TPoint;
begin
 Result := GetPoint(GetPointIndex(NodeIndex));
end;

procedure TFlexControl.SetNode(NodeIndex: integer; const Value: TPoint);
begin
 SetPoint(GetPointIndex(NodeIndex), Value);
end;

function TFlexControl.GetNodeCount: integer;
begin
 Result := PointCount;
 if Result > 0 then Result := GetNodeIndex(Result);
end;

function TFlexControl.GetNodeType(NodeIndex: integer): TPointType;
begin
 Result := GetPointType(GetPointIndex(NodeIndex));
end;

procedure TFlexControl.SetNodeType(NodeIndex: integer;
  const Value: TPointType);
begin
 SetPointType(GetPointIndex(NodeIndex), Value);
end;

function TFlexControl.GetPointCount: integer;
begin
 Result := 0;
end;

function TFlexControl.GetNodeIndex(Index: integer): integer;
var i: integer;
begin
 // Must be overriden for direct access to point arrays
 Result := -1;
 if (Index < PointCount) and
    (PointTypes[Index] = ptControl) then exit;
 inc(Result);
 for i:=0 to Index-1 do
  if PointTypes[i] <> ptControl then inc(Result);
end;

function TFlexControl.GetPointIndex(NodeIndex: integer): integer;
var i: integer;
begin
 // Must be overriden for direct access to point arrays
 Result := -1;
 for i:=0 to PointCount-1 do
  if PointTypes[i] <> ptControl then begin
   dec(NodeIndex);
   if NodeIndex < 0 then begin
    Result := i;
    break;
   end;
  end;
end;

function TFlexControl.GetPointsInfo: PPathInfo;
begin
 Result := Nil;
end;

procedure TFlexControl.ControlTranslate(const TranslateInfo: TTranslateInfo);
begin
 // Default translation
 DocRect := TranslateRect(DocRect, TranslateInfo);
end;

function TFlexControl.CreateCurveControl: TFlexControl;
begin
 // Default - covert not available
 Result := Nil;
end;

procedure TFlexControl.Translate(const TranslateInfo: TTranslateInfo);
var i: integer;
begin
 Invalidate;
 // Translate all sub controls
 for i:=0 to FControls.Count-1 do
  TFlexControl(FControls[i]).Translate(TranslateInfo);
 // Do translate
 ControlTranslate(TranslateInfo);
end;

function TFlexControl.GetRefreshRect(RefreshX, RefreshY: integer): TRect;
begin
 Result := Rect(RefreshX, RefreshY,
                RefreshX+FWidthProp.Value, RefreshY+FHeightProp.Value);
end;

function TFlexControl.ClientToOwner(const Point: TPoint): TPoint;
var Control: TFlexControl;
begin
 Result.X := Point.X;
 Result.Y := Point.Y;
 Control := Self;
 repeat
  inc(Result.X, Control.FLeftProp.Value);
  inc(Result.Y, Control.FTopProp.Value);
  Control := Control.Parent;
 until not Assigned(Control);
 FOwner.TransformPoint(Result);
end;

function TFlexControl.OwnerToClient(const Point: TPoint): TPoint;
var Control: TFlexControl;
begin
 Result.X := Point.X;
 Result.Y := Point.Y;
 FOwner.UnTransformPoint(Result.X, Result.Y);
 Control := Self;
 repeat
  dec(Result.X, Control.FLeftProp.Value);
  dec(Result.Y, Control.FTopProp.Value);
  Control := Control.Parent;
 until not Assigned(Control);
end;

procedure TFlexControl.Invalidate;
var R: TRect;
    i: integer;
begin
 if not Assigned(FOwner.Parent) {or not Visible} or (FUpdateCounter > 0) or
   ((FParent <> FOwner.Schemes) and Assigned(ParentScheme) and
    (ParentScheme <> FOwner.ActiveScheme)) then
  exit; 
 if not FNonVisual then begin
  with DocRect do R := GetRefreshRect(Left, Top);
  FOwner.TransformRect(R);
  InvalidateRect(FOwner.Handle, @R, False)
 end;
 for i:=0 to FControls.Count-1 do Controls[i].Invalidate;
end;

procedure TFlexControl.PaintAll(Canvas: TCanvas; PaintX, PaintY: integer);
var i: integer;
    R: TRect;
begin
 // Check control visible
 if not Visible or Assigned(FLayer) and not FLayer.Visible then exit;
 if not FNoPaintRectCheck then begin
  // Check control intersection with canvas PaintRect
  R := GetRefreshRect(PaintX, PaintY);
  FOwner.TransformRect(R);
  if // not IntersectRect(iRect, R, FOwner.PaintRect^) then exit;
    (R.Left >= FOwner.PaintWidth) or (R.Top >= FOwner.PaintHeight) or
    (R.Right < 0) or (R.Bottom < 0) then exit;
 end;
 if not FNonVisual then begin
  // Paint self
  R := Rect(PaintX, PaintY, PaintX + Width, PaintY + Height);
  FOwner.TransformRect(R);
  Paint(Canvas, R);
 end;
 // Paint sub-controls
 for i:=0 to FControls.Count-1 do with Controls[i] do
  PaintAll(Canvas, PaintX + Left, PaintY + Top);
end;

procedure TFlexControl.Paint(Canvas: TCanvas; var PaintRect: TRect);
begin
end;

function TFlexControl.GetDocRect: TRect;
var Control: TFlexControl;
begin
 Result := Rect(Left, Top, Left+Width, Top+Height);
 Control := FParent;
 while Assigned(Control) do begin
  OffsetRect(Result, Control.Left, Control.Top);
  Control := Control.FParent;
 end;
end;

function TFlexControl.GetPaintRect: TRect;
begin
 Result := GetDocRect;
 FOwner.TransformRect(Result);
end;

procedure TFlexControl.SetDocRect(Value: TRect);
var Control: TFlexControl;
begin
 Control := FParent;
 while Assigned(Control) do begin
  OffsetRect(Value, -Control.Left, -Control.Top);
  Control := Control.FParent;
 end;
 BeginUpdate;
 try
  Left := Value.Left;
  Top := Value.Top;
  Width := Value.Right - Value.Left;
  Height := Value.Bottom - Value.Top;
 finally
  EndUpdate;
 end;
end;

function TFlexControl.GetParenScheme: TFlexCustomScheme;
var Control: TFlexControl;
begin
 Result := Nil;
 Control := Parent;
 while Assigned(Control) do begin
  if Control is TFlexCustomScheme then begin
   Result := TFlexCustomScheme(Control);
   break;
  end;
  Control := Control.Parent;
 end;
end;

procedure TFlexControl.StartResizing(const SelRect: TRect);
var i: integer;
begin
 if fsResizing in FState then exit;
 Include(FState, fsResizing);
 FResizingRect := DocRect;
 OffsetRect(FResizingRect, -SelRect.Left, -SelRect.Top);
 for i:=0 to FControls.Count-1 do Controls[i].StartResizing(SelRect);
end;

procedure TFlexControl.FinishResizing;
var i: integer;
begin
 if not (fsResizing in FState) then exit;
 for i:=0 to FControls.Count-1 do Controls[i].FinishResizing;
 Exclude(FState, fsResizing);
end;

function TFlexControl.GetVisual: boolean;
begin
 Result := not FNonVisual;
end;

function TFlexControl.GetControl(Index: integer): TFlexControl;
begin
 Result := TFlexControl(FControls[Index]);
end;

function TFlexControl.GetByName(const Name: string): TFlexControl;
var i: integer;
begin
 Result := Nil;
 for i:=0 to FControls.Count-1 do
  if CompareStr(Name, TFlexControl(FControls[i]).Name) = 0 then begin
   Result := TFlexControl(FControls[i]);
   break;
  end;
end;

function TFlexControl.FindByID(ControlID: LongWord): TFlexControl;
var PassRec: TPassControlRec;
    Control: TFlexControl;
begin
 Result := Nil;
 if ControlID = 0 then exit;
 Control := Self;
 FirstControl(Control, PassRec);
 try
  while Assigned(Control) do begin
   if Control.ID = ControlID then begin
    Result := Control;
    break;
   end;
   Control := NextControl(PassRec);
  end;
 finally
  ClosePassRec(PassRec);
 end;
end;

function TFlexControl.FindByName(const AName: string): TFlexControl;
var PassRec: TPassControlRec;
    Control: TFlexControl;
begin
 Result := Nil;
 if AName = '' then exit;
 Control := Self;
 FirstControl(Control, PassRec);
 try
  while Assigned(Control) do begin
   if CompareStr(AName, Control.Name) = 0 then begin
    Result := Control;
    break;
   end;
   Control := NextControl(PassRec);
  end;
 finally
  ClosePassRec(PassRec);
 end;
end;

function TFlexControl.GetCount: integer;
begin
 Result := FControls.Count;
end;

function TFlexControl.GetID: LongWord;
begin
 Result := FIdProp.Value;
end;

procedure TFlexControl.SetID(Value: LongWord);
begin
 FIdProp.Value := Value;
end;

function TFlexControl.GetName: string;
begin
 Result := FNameProp.Value;
end;

procedure TFlexControl.SetName(const Value: string);
begin
 FNameProp.Value := Value;
end;

function TFlexControl.GetLeft: integer;
begin
 Result := FLeftProp.Value;
end;

function TFlexControl.GetTop: integer;
begin
 Result := FTopProp.Value;
end;

function TFlexControl.GetHeight: integer;
begin
 Result := FHeightProp.Value;
end;

function TFlexControl.GetWidth: integer;
begin
 Result := FWidthProp.Value;
end;

procedure TFlexControl.SetLeft(Value: integer);
begin
 FLeftProp.Value := Value;
end;

procedure TFlexControl.SetTop(Value: integer);
begin
 FTopProp.Value := Value;
end;

procedure TFlexControl.SetHeight(Value: integer);
begin
 FHeightProp.Value := Value;
end;

procedure TFlexControl.SetWidth(Value: integer);
begin
 FWidthProp.Value := Value;
end;

procedure TFlexControl.SetVisible(Value: boolean);
begin
 FVisibleProp.Value := Value;
end;

procedure TFlexControl.GetLayerStrProp(Sender: TObject; out Value: string);
begin
 if Assigned(FLayer)
  then Value := FLayer.Name
  else Value := '';
end;

proc