unitpaintpanel.pas

delphi开发矢量图的源代码

     ANoticeObject.ToPoint := Point(ANoticeObject.ToPoint.X + DeltaX,
                                         ANoticeObject.ToPoint.Y + DeltaY);
     if NoticeDragPoint = npBorder then
     begin
       ARect := ANoticeObject.ClientRect;
       ARect.Left := ARect.Left + DeltaX;
       ARect.Top := ARect.Top + DeltaY;
       ARect.Right := ARect.Right + DeltaX;
       ARect.Bottom := ARect.Bottom + DeltaY;
       ANoticeObject.ClientRect := ARect;
     end;
  end;
end;

function TCustomPaintPanel.PTInObject(Po :TPoint;ANoticeObject :TNoticeObject) :Boolean;
var
  IDX :integer;
  Contrast :Double;
  Header ,Border :Boolean;
begin
  Result := False;
  Contrast := 5;
  Header := PTInLine(ANoticeObject.PointList,Po,Contrast,IDX);
  Border := PTInRect(Po,ANoticeObject.ClientRect);
  if Header then NoticeDragPoint := npHeader;
  if Border then NoticeDragPoint := npBorder;
  Result := Header or Border;
end;

function TCustomPaintPanel.PTInObject(Po :TPoint;AGraphObject :TGraphObject) :Boolean;
var
  IDX :integer;
  Contrast :Double;
begin
  Result := False;
  Contrast := 5;
  case AGraphObject.GraphClass of
       gcLine : Result := PTInLine(AGraphObject.PointList,Po,Contrast,IDX);
       gcRect : Result := PTInRect(Po,Rect(AGraphObject.PointList[0].X,AGraphObject.PointList[0].Y,
                          AGraphObject.PointList[High(AGraphObject.PointList)].X,
                          AGraphObject.PointList[High(AGraphObject.PointList)].Y));
       gcArc  : Result := PTInRect(Po,Rect(AGraphObject.PointList[0].X,AGraphObject.PointList[0].Y,
                          AGraphObject.PointList[High(AGraphObject.PointList)].X,
                          AGraphObject.PointList[High(AGraphObject.PointList)].Y));
  end;
end;

procedure TCustomPaintPanel.ClearObjectSelected;
var
  i :integer;
  GraphObject :TGraphObject;
  NoticeObject :TNoticeObject;
begin
  FSelObject := nil;
  for i := 0 to FGraphList.Count - 1 do
  begin
    GraphObject := FGraphList[i];
    GraphObject.Selected := False;
  end;
  for i := 0 to FNoticeList.Count - 1 do
  begin
    NoticeObject := FNoticeList[i];
    NoticeObject.Selected := False;
  end;
end;

procedure TCustomPaintPanel.WMMouseMove(var Msg: TWMMouseMove);
var
  i :integer;
  DeltaX,DeltaY :integer;
begin
  inherited;
  if (FAction = paDrawGraph) or (FAction = paModiGraph) then
  begin
    Inc(FPointCount);
    SetLength(FPointList,FPointCount);
    SetLength(FAbsPointList,FPointCount);
    FPointList[FPointCount - 1].X := Msg.XPos;
    FPointList[FPointCount - 1].Y := Msg.YPos;
    FAbsPointList[FPointCount - 1] := ClientToScreen(Point(Msg.XPos,Msg.YPos));
    RunTimeDraw(GraphClass,FAbsPointList);
  end else if FAction = paMove then
  begin
    DeltaX := Msg.XPos - FMouseDownSPo.X;
    DeltaY := Msg.YPos - FMouseDownSPo.Y;
    ShowMoveObject(SelObject,DeltaX,DeltaY);
  end;
end;

procedure TCustomPaintPanel.ShowMoveObject(AObject :TObject;DeltaX,DeltaY :integer);
var
  APointList :TPointList;
  Po :TPoint;
  i :integer;
begin
 //   RunTimeDraw(AGraphObject.GraphClass,APointList);}
end;

procedure TCustomPaintPanel.PointListChangToScreen(ClientPointList,ScreenPointList :TPointList);
var
  i :integer;
begin
  SetLength(ScreenPointList,High(ClientPointList) + 1);
  for i := 0 to High(ScreenPointList) do
  begin
    ScreenPointList[i] := ClientToScreen(ClientPointList[i]);
  end;
end;


procedure TCustomPaintPanel.Delete;
begin
  if SelObject = nil then Exit;
  DeleteObject(SelObject);
  Invalidate;
end;

procedure TCustomPaintPanel.Clear;
begin
  ClearNoticeObject;
  ClearGraphObject;
  ClearFillObject;
  Invalidate;
end;

procedure TCustomPaintPanel.ClearFillObject;
var
  FillObject :TFillObject;
  i :integer;
begin
  for i := 0 to FFillList.Count - 1 do
  begin
    FillObject := FFillList[i];
    FillObject.Free;
  end;
  FFillList.Clear;
end;

procedure TCustomPaintPanel.DeleteObject(AObject: TObject);
begin
  if AObject is TGraphObject then
     DeleteGraph(TGraphObject(AObject))
  else if AObject is TNoticeObject then
     DeleteNotice(TNoticeObject(AObject));
end;

procedure TCustomPaintPanel.DeleteGraph(AGraphObject :TGraphObject);
var
  i :integer;
begin
  for i := 0 to FGraphList.Count - 1 do
  begin
    if FGraphList[i] = AGraphObject then
    begin
      FGraphList.Delete(i);
      AGraphObject.Free;
      break;
    end;
  end;
  if FGraphList.Count > 0 then SelObject := FGraphList[0]
  else SelObject := nil ;
end;

procedure TCustomPaintPanel.DeleteNotice(ANoticeObject :TNoticeObject);
var
  i :integer;
begin
  for i := 0 to FNoticeList.Count - 1 do
  begin
    if  FNoticeList[i] = ANoticeObject then
    begin
      FNoticeList.Delete(i);
      ANoticeObject.Free;
      break;
    end;
  end;
  if FNoticeList.Count > 0 then SelObject := FNoticeList[0]
  else SelObject := nil;
end;

procedure TCustomPaintPanel.WMKeyDown(var Msg: TWMKeyDown);
var
  FillObject :TFillObject;
begin
  case Msg.CharCode of
       VK_DELETE :Delete;
       VK_F5     :Refresh;
       VK_F6     :begin
                    if FFillList.Count  < 0 then Exit;
                    FillObject := FFillList[FFillList.Count - 1];
                    FFillList.Delete(FFillList.Count - 1);
                    FillObject.Free;
                  end;
  end;
end;

procedure TCustomPaintPanel.RunTimeDraw(AGraphClass :TGraphClass;APointList :TPointList);
begin
  case AGraphClass of
       gcLine :DrawPolyLine(GetDC(0),APointList);
       gcRect :DrawRect(GetDC(0),APointList);
       gcArc  :DrawArc(GetDC(0),APointList);
  end;
end;

procedure TCustomPaintPanel.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TCustomPaintPanel.SetSelObject(const Value: TObject);
begin
  FSelObject := Value;
  if SelObject is TGraphObject then TGraphObject(SelObject).Selected := True
  else if SelObject is TNoticeObject then TNoticeObject(SelObject).Selected := True;
end;

procedure TCustomPaintPanel.SetDrawClass(const Value: TDrawClass);
begin
  FDrawClass := Value;
end;

procedure TCustomPaintPanel.SetFillColor(const Value: TColor);
begin
  FFillColor := Value;
end;

procedure TCustomPaintPanel.SetIsFill(const Value: Boolean);
begin
  FIsFill := Value;
end;

procedure TCustomPaintPanel.SetNoticeClass(const Value: TNoticeClass);
begin
  FNoticeClass := Value;
end;

procedure TCustomPaintPanel.SetNoticeDragPoint(
  const Value: TNoticeDragPoint);
begin
  FNoticeDragPoint := Value;
end;

procedure TCustomPaintPanel.SetOnMouseDrag(
  const Value: TPaintMouseDragEvent);
begin
  FOnMouseDrag := Value;
end;

{ TNoticeObject }

constructor TNoticeObject.Create;
begin
  inherited Create;
  FLines := TStringList.Create;
  FillColor := clYellow;
  NoticeClass := ncRect;
end;

destructor TNoticeObject.Destroy;
begin
  FLines.Free;
  inherited;
end;

//根据矩形框计算点数据

function TNoticeObject.GetPointList: TPointList;
var
  PD :TPositionDirection;
  Count :integer;
begin
  if NoticeClass = ncNotice then
  begin
    SetLength(Result,8);
    PD := PoInRectPosition(ToPoint,ClientRect);
    Count := 0;
    Result[Count] := ClientRect.TopLeft;
    inc(Count);
    if PD = pdTop then
    begin
       Result[Count] := Point(ClientRect.Left + Round((ClientRect.Right -
                                     ClientRect.Left) * 0.25),ClientRect.Top);
       Inc(Count);
       Result[Count] := ToPoint;
       Inc(Count);
       Result[Count] := Point(ClientRect.Left + Round((ClientRect.Right -
                                     ClientRect.Left ) * 0.75),ClientRect.Top);
       Inc(Count);
    end;
    Result[Count] := Point(ClientRect.Right,ClientRect.Top);
    Inc(Count);
    if PD = pdRight then
    begin
       Result[Count] := Point(ClientRect.Right,ClientRect.Top + Round((ClientRect.Bottom -
                               ClientRect.Top ) * 0.25));
       Inc(Count);
       Result[Count] := ToPoint;
       Inc(Count);
       Result[Count] := Point(ClientRect.Right,ClientRect.Top + Round((ClientRect.Bottom -
                              ClientRect.Top )* 0.75));
       Inc(Count);
    end;
    Result[Count] := ClientRect.BottomRight;
    Inc(Count);
    if PD = pdBottom then
    begin
       Result[Count] := Point(ClientRect.Left + Round((ClientRect.Right -
                                     ClientRect.Left ) * 0.75),ClientRect.Bottom);
       Inc(Count);
       Result[Count] := ToPoint;
       Inc(Count);
       Result[Count] := Point(ClientRect.Left + Round((ClientRect.Right -
                                     ClientRect.Left ) * 0.25),ClientRect.Bottom);
       Inc(Count);
    end;
    Result[Count] := Point(ClientRect.Left,ClientRect.Bottom);
    Inc(Count);
    if PD = pdLeft then
    begin
       Result[Count] := Point(ClientRect.Left,ClientRect.Top + Round((ClientRect.Bottom -
                              ClientRect.Top)  * 0.75));
       Inc(Count);
       Result[Count] := ToPoint;
       Inc(Count);
       Result[Count] := Point(ClientRect.Left,ClientRect.Top + Round((ClientRect.Bottom -
                              ClientRect.Top) * 0.25));
       Inc(Count);
    end;
    Result[Count] := ClientRect.TopLeft;
  end else if NoticeClass = ncRect then
  begin
    SetLength(Result, 4);
    Result[0] := ClientRect.TopLeft;
    Result[1] := Point(ClientRect.Right,ClientRect.Top);
    Result[2] := ClientRect.BottomRight;
    Result[3] := Point(ClientRect.Left ,ClientRect.Bottom);
  end;
end;

//取得点位于矩形框的方位

function  TNoticeObject.PoInRectPosition(Po :TPoint;ARect :TRect) :TPositionDirection;
begin
  if Po.X < ARect.Left then Result := pdLeft
  else if Po.Y < ARect.Top then Result := pdTop
  else if Po.X > ARect.Right then Result := pdRight
  else if Po.Y > ARect.Bottom then Result := pdBottom;
end;

procedure TNoticeObject.SetClientRect(const Value: TRect);
begin
  FClientRect := Value;
end;

procedure TNoticeObject.SetFillColor(const Value: TColor);
begin
  FFillColor := Value;
end;

procedure TNoticeObject.SetLines(const Value: TStringList);
begin
  FLines.Assign(Value);
end;

procedure TNoticeObject.SetNoticeClass(const Value: TNoticeClass);
begin
  FNoticeClass := Value;
end;

procedure TNoticeObject.SetPoint(const Value: TPoint);
begin
  FPoint := Value;
end;

procedure TNoticeObject.SetSelected(const Value: Boolean);
begin
  FSelected := Value;
end;

end.