unitpaintpanel.pas

delphi开发矢量图的源代码

      AStream.WriteBuffer(Count,Sizeof(Int64));
      AStream.CopyFrom(DestStream,0);
      AStream.SaveToFile(FileName);
     finally
       DestStream.Free;
     end;
  finally
    AStream.Destroy;
  end;
end;

procedure TCustomPaintPanel.SaveToStream(Stream: TStream);
var
  i :integer;
  Count :integer;
  AColor :TColor;
  AGraphObject :TGraphObject;
  AGraphClass :TGraphClass;
begin
  for i := 0 to FGraphList.Count - 1 do      //载入曲线数据
  begin
    AGraphObject := FGraphList[i];
    Count := High(AGraphObject.PointList) + 1;
    AColor := AGraphObject.Color;
    AGraphClass := AGraphObject.GraphClass;
    Stream.WriteBuffer(Count,Sizeof(integer));
    Stream.WriteBuffer(AColor ,Sizeof(TColor));
    Stream.WriteBuffer(AGraphClass,Sizeof(TGraphClass));
    Stream.WriteBuffer(AGraphObject.PointList[0],Sizeof(TPoint) * Count);
  end;
end;


procedure TCustomPaintPanel.SaveToBitmap(const FileName: string);
var
  ABitmap :TBitmap;
begin
  ABitmap := TBitmap.Create;
  try
    ABitmap.PixelFormat := pf24bit;
    ABitmap.Width := Width;
    ABitmap.Height := Height;
    ABitmap.Canvas.CopyRect(Rect(0,0,Width,Height),Canvas,Rect(0,0,Width,Height));
    ABitmap.SaveToFile(FileName);
  finally
    ABitmap.Free;
  end;
end;

procedure TCustomPaintPanel.Paint;
begin
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Rect(0,0,Width,Height));
  Canvas.CopyMode := cmSrcAnd;
  PaintFill;
  PaintGraph;     //绘制图形对象
  PaintNotice;    //绘制注释对象
  Canvas.Pen.Color := Color;
end;

procedure TCustomPaintPanel.PaintFill;
var
  i :integer;
  FillObject :TFillObject;
begin
  for i := 0 to FFillList.Count - 1 do
  begin
    FillObject := FFillList[i];
    FillRgn(Canvas.Handle,FillObject.Rgn,CreateSolidBrush(FillObject.FillColor));
  end;
end;

procedure TCustomPaintPanel.PaintNotice;
var
  i :integer;
  NoticeObject :TNoticeObject;
begin
  for i := 0 to FNoticeList.Count - 1 do
  begin
    NoticeObject := FNoticeList[i];
    Canvas.Brush.Color := NoticeObject.FillColor;
    Canvas.Pen.Color := NoticeObject.FillColor;
    Canvas.Font.Color := clBlack;
    Canvas.Polyline(NoticeObject.PointList);
    FillPoly(Canvas.Handle,NoticeObject.PointList,NoticeObject.FillColor);
    DrawNoticeText(NoticeObject);
    if NoticeObject.Selected then
       PaintSelected(NoticeObject);
  end;
end;

procedure TCustomPaintPanel.DrawNoticeText(ANoticeObject :TNoticeObject);
var
  i :integer;
  X,Y :integer;
  AHeight,AWidth :integer;
  PercentY :Double;
begin
  AHeight := ANoticeObject.ClientRect.Bottom - ANoticeObject.ClientRect.Top;
  AWidth := ANoticeObject.ClientRect.Right - ANoticeObject.ClientRect.Left;
  PercentY := AHeight / ANoticeObject.Lines.Count ;
  if PercentY < Canvas.TextHeight('hg') then PercentY := Canvas.TextHeight('hg');
  for i := 0 to ANoticeObject.Lines.Count - 1 do
  begin
    X := ANoticeObject.ClientRect.Left + Round((AWidth - Canvas.TextWidth(ANoticeObject.Lines[i])) / 2 );
    Y := ANoticeObject.ClientRect.Top + Round(PercentY * i + (PercentY -
                            Canvas.TextHeight(ANoticeObject.Lines[i])) / 2);
    Canvas.TextOut(X,Y,ANoticeObject.Lines[i]);
  end;
end;

procedure TCustomPaintPanel.PaintGraph;
var
  i,j :integer;
  GraphObject :TGraphObject;
begin
  for i := 0 to FGraphList.Count - 1 do
  begin
    GraphObject := FGraphList[i];
    Canvas.Pen.Color := GraphObject.Color;
    case GraphObject.GraphClass of
         gcLine :begin
                   DrawPolyLine(Canvas.Handle,GraphObject.PointList);
                 end;
         gcCurve:begin

                 end;
         gcArc  :begin
                   DrawArc(Canvas.Handle,GraphObject.PointList);
                   if GraphObject.Fill then
                      FillARc(Canvas.Handle,GraphObject.PointList,GraphObject.Color);
                 end;
         gcRect :begin
                   DrawRect(Canvas.Handle,GraphObject.PointList,GraphObject.Fill,
                             GraphObject.Color);
                 end;
    end;
    if GraphObject.Selected then
       PaintSelected(GraphObject);
  end;
end;

procedure TCustomPaintPanel.PaintSelected(AObject :TObject);
var
  P,P1,P2 :TPoint;
  i :integer;
  AGraphObject : TGraphObject;
  ANoticeObject : TNoticeObject;
begin
  if AObject is TGraphObject then
  begin
    AGraphObject := TGraphObject(AObject);
    Canvas.Brush.Color := AGraphObject.Color ;
    case AGraphObject.GraphClass of
         gcLine :begin
                   P := AGraphObject.PointList[0];
                   Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
                   P := AGraphObject.PointList[High(AGraphObject.PointList)];
                   Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
                 end;
         gcRect :begin
                   P1 := AGraphObject.PointList[0];
                   Canvas.FillRect(Rect(P1.X -2,P1.Y - 2,P1.X + 2,P1.Y + 2));
                   P2 := AGraphObject.PointList[High(AGraphObject.PointList)];
                   Canvas.FillRect(Rect(P2.X -2,P2.Y - 2,P2.X + 2,P2.Y + 2));
                   P := Point(P1.X,P2.Y);
                   Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
                   P := Point(P2.X,P1.Y);
                   Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
                 end;
         gcArc  :begin
                 end;
    end;
  end else if AObject is TNoticeObject then
  begin
    ANoticeObject := TNoticeObject(AObject);
    Canvas.Brush.Color := clRed;
    for i := 0 to High(ANoticeObject.PointList) do
    begin
      P := ANoticeObject.PointList[i];
      Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
    end;
  end;
end;

procedure TCustomPaintPanel.SetGraphClass(const Value: TGraphClass);
begin
  FGraphClass := Value;
end;

procedure TCustomPaintPanel.WMLButtonDown(var Msg: TWMLButtonDown);
var
  i :integer;
  GraphObject :TGraphObject;
  FillObject :TFillObject;
  NoticeObject :TNoticeObject;
begin
  inherited;
  SetFocus;
  ClearObjectSelected;
  FMouseDownSPo := Point(Msg.XPos,Msg.YPos);

  if IsFill then
  begin
    FillObject := TFillObject.Create;
    FillObject.Rgn := GetFillRgn(Canvas.Handle,Point(Msg.XPos,Msg.YPos));
    FillObject.FillColor := FillColor;
    FillRgn(Canvas.Handle,FillObject.Rgn,CreateSolidBrush(FillObject.FillColor));
    FFillList.Add(FillObject);
    IsFill := False;
  end;
   //检测图形对象是否被选中
  for i := 0 to FGraphList.Count-1 do
  begin
    GraphObject := FGraphList[i];
    if PTInObject(Point(Msg.XPos,Msg.YPos),GraphObject) then
    begin
      GraphObject.Selected:= True;
      SelObject := GraphObject;
      break;
    end;
  end;

  //检测注释对象是否被选中
  for i := 0 to FNoticeList.Count - 1 do
  begin
    NoticeObject := FNoticeList[i];
    if PTInObject(Point(Msg.XPos,Msg.YPos),NoticeObject) then
    begin
      NoticeObject.Selected := True;
      SelObject := NoticeObject;
      break;
    end;
  end;

  if SelObject <> nil then
  begin
     if IsFill then
     begin
       if SelObject is TGraphObject then
         TGraphObject(SelObject).Fill := True;
     end;
     if SelObject is TGraphObject then
     begin
       if PointInEdge(Point(Msg.XPos,Msg.YPos),TGraphObject(SelObject)) then
       begin
         FAction := paModiGraph;
         FPointList := Copy(TGraphObject(SelObject).PointList,0,
                 High(TGraphObject(SelObject).PointList) +1);
         FPointCount := High(FPointList) + 1;
         PointListChangToScreen(FPointList,FAbsPointList);
       end else FAction := paMove;
     end else if SelObject is TNoticeObject then FAction := paMove;
     Invalidate;
  end  else if DrawClass = dcGraph then
  begin
    FAction := paDrawGraph;
    SetLength(FPointList,0);
    SetLength(FAbsPointList,0);
  end else if DrawClass = dcNotice then
  begin
    FAction := paDrawNotice;
  end;
end;

function  TCustomPaintPanel.PointInEdge(Po :TPoint;AGraphObject :TGraphObject) :Boolean;
var
  P :TPoint;
begin
  Result := False;
  if AGraphObject.GraphClass = gcLine then
  begin
    P := AGraphObject.PointList[0];
    if PTInRect(Po,Rect(P.X - 2,P.Y - 2,P.X + 2,P.Y + 2)) then
    begin
       Result := True;
    end;
    P := AGraphObject.PointList[High(AGraphObject.PointList)];
    if PTInRect(Po,Rect(P.X - 2,P.Y -2 ,P.X + 2,P.Y +2)) then
       Result := True;
  end;
end;

procedure TCustomPaintPanel.WMLButtonUp(var Msg: TWMLButtonUp);
var
  DeltaX,DeltaY :integer;
  ARect :TRect;
  Lines :TStringList;
  Po :TPoint;
begin
  inherited;
  if FAction = paDrawGraph then
  begin
    AddGraphObject;
  end else if FAction = paMove then
  begin
    DeltaX := Msg.XPos - FMouseDownSPo.X;
    DeltaY := Msg.YPos - FMouseDownSPo.Y;
    if (Abs(DeltaX) > 2) or (Abs(DeltaY) > 2) then
    begin
      MoveObject(SelObject,DeltaX,DeltaY);
      Invalidate;
    end;
  end else if FAction = paDrawNotice then
  begin
    Lines := TStringList.Create;
    try
     ARect := Rect(FMouseDownSPo,Point(Msg.XPos,Msg.YPos));
     Po := Point(ARect.Left + Round((ARect.Right - ARect.Left) * 0.3),ARect.Top - 50);
     Lines.Add('NoticeText');
     if Assigned(FOnMouseDrag) then
        FOnMouseDrag(Self,ARect,Po,Lines);
     AddNotice(ARect,Po,Lines);
    finally
      Lines.Free;
    end;
    Invalidate;
  end else if FAction = paModiGraph then
  begin
    if SelObject is TGraphObject then
    begin
      TGraphObject(SelObject).PointList := FPointList;
      Invalidate;
    end;
  end;
  FPointCount := 0;
  FAction := paNone;
end;

procedure TCustomPaintPanel.AddGraphObject;
var
  GraphObject :TGraphObject;
  APointList :TPointList;
begin
  if High(FPointList) > 0 then
  begin
    GraphObject := TGraphObject.Create;
    GraphObject.GraphClass := GraphClass;
    GraphObject.Color := Color;
    case GraphClass of
         gcLine :  GraphObject.PointList := Copy(FPointList,0,High(FPointList));
         gcRect :begin
                   SetLength(APointList,2);
                   APointList[0].X := FPointList[0].X;
                   APointList[0].Y := FPointList[0].Y;
                   APointList[1].X := FPointList[FPointCount - 1].X;
                   APointList[1].Y := FPointList[FPointCount - 1].Y;
                   GraphObject.PointList := APointList;
                 end;
         gcArc  :begin
                   SetLength(APointList,2);
                   APointList[0].X := FPointList[0].X;
                   APointList[0].Y := FPointList[0].Y;
                   APointList[1].X := FPointList[FPointCount - 1].X;
                   APointList[1].Y := FPointList[FPointCount - 1].Y;
                   GraphObject.PointList := APointList;
                 end;
    end;
    GraphObject.Selected := True;
    SelObject := GraphObject;
    FGraphList.Add(GraphObject);
    RePaint;
  end;
end;

procedure TCustomPaintPanel.MoveObject(AObject :TObject;DeltaX ,DeltaY :integer);
var
  i :integer;
  AGraphObject :TGraphObject;
  ANoticeObject :TNoticeObject;
  ARect :TRect;
begin
  if AObject is TGraphObject then
  begin
     AGraphObject := TGraphObject(AObject);
    for i := 0 to High(AGraphObject.PointList) do
    begin
      AGraphObject.PointList[i].X := AGraphObject.PointList[i].X + DeltaX;
      AGraphObject.PointList[i].Y := AGraphObject.PointList[i].Y + DeltaY;
    end;
  end  else if AObject is TNoticeObject then
  begin
     ANoticeObject := TNoticeObject(AObject);