polypic.pas

矢量图源代码 包括直线文本矩形等等

///////////////////////
//王昌雨
//2003-06-15
//矩形
///////////////////////
unit PolyPic;

interface

uses Windows,Graphics,Math,Classes,Controls,
  PicConst,PicBase,PicFuns;

const
  FOCUS_NUM=8;

type
  TPolyType=(PolyOpen,PolyClose);

type
  TPolyPoint=packed record
    aPolyPoint:Array of TPoint;   //顶点个数
    fPolyPointNum: Cardinal;
  end;

type
  TPolyPic=Class(TPicBase)
    private
      FocusPoint:Array[1..FOCUS_NUM] of TPoint;
      fPolyType: TPolyType;     //
      fPolyPoint:TPolyPoint;
      MouseFocus:Cardinal;
      DrawState: Boolean;
      procedure GetFocusPoints;
      procedure SetPolyType(V:TPolyType);
      function  GetPolyPoint:TPolyPoint;
      procedure SetPolyPicRect;
      Function  GetPolyPointNum:Integer;
      procedure SetPolyPointNum(V:Integer);
    protected

    public
      constructor Create;
      destructor  Destroy; override;
      procedure DrawPic(ACanvas:TCanvas);  override;        //在acanvas上画图
      procedure MovePic(ACanvas:TCanvas; APoint:TPoint); override; //在acanvas上移动
      function  MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS; override; //鼠标位置
      function  CreatePicRgn(ACanvas:TCanvas): HRGN; override; //产生图元区域的句柄
      procedure DrawFocusRect(ACanvas:TCanvas); override; //在Acanvas上画焦点
      //鼠标响应
      procedure ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint); override;
      procedure ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer; Shift: TShiftState;APoint:TPoint);  override;
      procedure ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;  Shift: TShiftState; APoint:TPoint); override;
      //键盘响应
      procedure ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift:TShiftState); override;
      procedure ParentKeyUp(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift: TShiftState); override;
      //图象改变
      procedure PicChangeing(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseRect:TRect;
        mouseDownOldX, mouseDownOldY, mouseOldX, mouseOldY, mouseX, mouseY:Integer); override;
      procedure PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS;chooseRect: TRect; //选择图元形成的矩形
        mouseDownOldX, mouseDownOldY: Integer; mouseX, mouseY: Integer); override; //鼠标当前的坐标
      //位置代码可参见 PicConst.pas
      procedure AssignPic(SourcePic: TPicBase); override;
      //保存和读取数据
      procedure GetClassDataFromChar(var Len:Integer; var Buf:Array of Char); override;
      procedure SaveClassDataToChar(var Len:Integer; var Buf:Array of Char);  override;
      //非重载函数
      //绘图函数
      procedure DrawPolyPic(ACanvas: TCanvas; aPoints:Array of TPoint);
      //property 的实现方法
    published
      property PolyType : TPolyType read fPolyType write SetPolyType;
      property PolyPoint: TPolyPoint read GetPolyPoint;
      property PicState:Boolean read DrawState;
      property PolyPointNum:Integer read GetPolyPointNum write SetPolyPointNum;
      property PicPen;
      property PicBrush;
      Property PicFont;
      property PicRect;
      property Choosed;
      property PicId;
      property FocusPen;
      property FocusBrush;
      property DrawEndEvent;
      property PicIndex;

  end;

implementation


constructor TPolyPic.Create;
begin
  inherited Create;
  fPolyPoint.fPolyPointNum:=0;
  fPolyType:=PolyOpen; //开
  MouseFocus:=0;
  DrawState:=False;  //非画图模式
end;

destructor  TPolyPic.Destroy;
begin
  inherited Destroy;
end;


Function  TPolyPic.GetPolyPointNum:Integer;
begin
  Result:=fPolyPoint.fPolyPointNum;
end;

procedure TPolyPic.SetPolyPointNum(V:Integer);
begin
  fPolyPoint.fPolyPointNum:=0;
end;

procedure TPolyPic.GetFocusPoints;
var
  StartPos,EndPos:TPoint;
begin
  StartPos:=PicRect.TopLeft;
  EndPos:=PicRect.BottomRight;
  focusPoint[1] := startPos; //左上
  focusPoint[2] := Point((StartPos.X+ endPos.X)div 2, StartPos.Y); //上中
  focusPoint[3] := Point(EndPos.X,StartPos.Y); //右上
  focusPoint[4] := Point(StartPos.X,(StartPos.Y+ endPos.Y)div 2); //左中
  focusPoint[5] := Point(EndPos.X,(StartPos.Y+ endPos.Y)div 2); //右中
  focusPoint[6] := Point(StartPos.X,EndPos.Y); //左下
  focusPoint[7] := Point((StartPos.X + endPos.X)div 2, EndPos.Y); //下中
  focusPoint[8] := endPos; //终点
end;

procedure TPolyPic.SetPolyType(V:TPolyType);
begin
  if fPolyType<>V then fPolyType:=V;
end;

function  TPolyPic.GetPolyPoint:TPolyPoint;
begin
  Result:=fPolyPoint;
end;

procedure TPolyPic.SetPolyPicRect;
var
  i:Integer;
  tmpRect:TRect;
begin
  with tmpRect do begin
    Left  := fPolyPoint.aPolyPoint[0].x;
    Top   := fPolyPoint.aPolyPoint[0].y;
    Right := fPolyPoint.aPolyPoint[0].x;
    Bottom:= fPolyPoint.aPolyPoint[0].y;
  end;
  with tmpRect do begin
    for i := 1 to fPolyPoint.fPolyPointNum-1 do begin
      Left  := Min(Left, fPolyPoint.aPolyPoint[i].x);
      Top   := Min(Top,  fPolyPoint.aPolyPoint[i].y);
      Right := Max(Right, fPolyPoint.aPolyPoint[i].x);
      Bottom:= Max(Bottom, fPolyPoint.aPolyPoint[i].y);
    end; //调整起点和终点的位置
    if Right = Left then  Inc(Right);
    if Top = Bottom then  Inc(Bottom);
  end;
  PicRect:=tmpRect;
end;

procedure TPolyPic.DrawPic(ACanvas:TCanvas);        //在acanvas上画图
begin
  ACanvas.Pen:=PicPen;
  ACanvas.Brush:=PicBrush;
  ACanvas.Font:=PicFont;
  DrawPolyPic(ACanvas,fPolyPoint.aPolyPoint);
  if Choosed then DrawFocusRect(ACanvas);
end;

procedure TPolyPic.MovePic(ACanvas:TCanvas; APoint:TPoint);  //在acanvas上移动
var
  i: Integer;
begin
  for i := 0 to fPolyPoint.fPolyPointNum-1 do begin
    Inc(fPolyPoint.aPolyPoint[i].x, APoint.X);
    Inc(fPolyPoint.aPolyPoint[i].y, APoint.Y);
  end;
  //调整图元矩形区域
  SetPolyPicRect;
end;

function  TPolyPic.MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS;  //鼠标位置
var
  mRect: TRect;
  mPoint: Tpoint;
  i: Integer;
  polyHrgn: HRGN;
begin
  Result := POS_OUT;
  mPoint.x := APoint.X;
  mPoint.y := APoint.Y;
  polyHrgn := CreatePicRgn(ACanvas); //产生图元句柄
  if not Choosed  then begin //图元未选中，只要判断是否在图元区域即可
    if PtInRegion(polyHrgn, APoint.x, APoint.y) = True then  Result := POS_CENTER
  end else  begin //图元被选中，不仅要判断是否在图元区域，还需要判断在图元的具体位置
    if PtInRegion(polyHrgn, APoint.x, APoint.y) = True then Result := POS_CENTER;
    GetFocusPoints;
    for i := 1 to 8 do begin //先判断多边形所在矩形的8个焦点
      with mRect do  begin
        Left := focusPoint[i].x - FOCUS_SIZE;
        Top := focusPoint[i].y - FOCUS_SIZE;
        Right := focusPoint[i].x + FOCUS_SIZE;
        Bottom := focusPoint[i].y + FOCUS_SIZE;
      end;
      if PtInRect(mrect, mPoint) = True then  begin
        Result := MOUSE_POS(i);
        MouseFocus := 0;
        break;
      end;
    end;
    for i := 0 to fPolyPoint.fPolyPointNum-1 do begin
      with mRect do begin
        Left := fPolyPoint.aPolyPoint[i].x - FOCUS_SIZE;
        Top := fPolyPoint.aPolyPoint[i].y - FOCUS_SIZE;
        Right := fPolyPoint.aPolyPoint[i].x + FOCUS_SIZE;
        Bottom := fPolyPoint.aPolyPoint[i].y + FOCUS_SIZE;
      end;
      if PtInRect(mrect, mPoint) = True then begin
        MouseFocus := i;
        Result := POS_POLYPOINT;
        break;
      end;
    end;
  end;
  DeleteObject(polyHrgn);
end;

function  TPolyPic.CreatePicRgn(ACanvas:TCanvas): HRGN;  //产生图元区域的句柄
var
  i: Integer;
  tempHrgn: HRGN;
  hrgnFlag: Integer;
  cellHrgn: HRGN;
begin
  Case fPolyType of
    PolyOpen:
      begin
        hrgnflag := 0 //不封闭
      end;
    else
      begin
        if PicBrush.Style =bsClear then
            hrgnFlag := 1 //封闭透明
        else
            hrgnFlag := 2; //封闭不透明
      end;
  end;
  cellHrgn := 0;
  case hrgnFlag of
    0: //不封闭
      begin
        cellHrgn := CreateLineRgn(fPolyPoint.aPolyPoint[0].x, fPolyPoint.aPolyPoint[0].y,
            fPolyPoint.aPolyPoint[1].x, fPolyPoint.aPolyPoint[1].y);
        for i := 1 to fPolyPoint.fPolyPointNum-2 do begin
          tempHrgn := CreateLineRgn(fPolyPoint.aPolyPoint[i].x, fPolyPoint.aPolyPoint[i].y,
            fPolyPoint.aPolyPoint[i + 1].x, fPolyPoint.aPolyPoint[i + 1].y);
          CombineRGN(cellHrgn, cellHrgn, tempHrgn, RGN_OR);
          DeleteObject(tempHrgn);
        end;
      end;
    1: //封闭透明
      begin
        cellHrgn := CreateLineRgn(fPolyPoint.aPolyPoint[0].x, fPolyPoint.aPolyPoint[0].y,
            fPolyPoint.aPolyPoint[1].x, fPolyPoint.aPolyPoint[1].y);
        for i := 1 to fPolyPoint.fPolyPointNum-2 do begin
          tempHrgn := CreateLineRgn(fPolyPoint.aPolyPoint[i].x, fPolyPoint.aPolyPoint[i].y,
            fPolyPoint.aPolyPoint[i + 1].x, fPolyPoint.aPolyPoint[i + 1].y);
          CombineRGN(cellHrgn, cellHrgn, tempHrgn, RGN_OR);
        end;
        tempHrgn := CreateLineRgn(fPolyPoint.aPolyPoint[fPolyPoint.fPolyPointNum-1].x,
            fPolyPoint.aPolyPoint[fPolyPoint.fPolyPointNum-1].Y,
            fPolyPoint.aPolyPoint[0].X, fPolyPoint.aPolyPoint[0].Y);
        CombineRGN(cellHrgn, cellHrgn, tempHrgn, RGN_OR);
        DeleteObject(tempHrgn);
      end;
    2: //封闭不透明
      begin
        cellHrgn := CreatePolygonRgn(fPolyPoint.aPolyPoint, fPolyPoint.fPolyPointNum, ALTERNATE);
      end;
  end;
  Result := cellHrgn;
end;

procedure TPolyPic.DrawFocusRect(ACanvas:TCanvas); //在Acanvas上画焦点
var
  mRect: TRect;
  i: Integer;
begin
  GetFocusPoints;
  ACanvas.Pen:=FocusPen;
  ACanvas.Brush:=FocusBrush;
  for i := 1 to FOCUS_NUM do begin  //绘制焦点矩形
    mRect.Left := focusPoint[i].x - FOCUS_SIZE;
    mRect.Top := focusPoint[i].y - FOCUS_SIZE;
    mRect.Right := focusPoint[i].x + FOCUS_SIZE;
    mRect.Bottom := focusPoint[i].y + FOCUS_SIZE;
    ACanvas.Rectangle(mRect.Left, mRect.Top, mRect.Right, mRect.Bottom);
  end;
  for i := 0 to fPolyPoint.fPolyPointNum-1 do begin  //绘制焦点矩形
    ACanvas.Brush.Color:=clLime;
    mRect.Left := fPolyPoint.aPolyPoint[i].x - FOCUS_SIZE;
    mRect.Top  := fPolyPoint.aPolyPoint[i].y - FOCUS_SIZE;
    mRect.Right := fPolyPoint.aPolyPoint[i].x + FOCUS_SIZE;
    mRect.Bottom:= fPolyPoint.aPolyPoint[i].y + FOCUS_SIZE;
    ACanvas.Rectangle(mRect.Left, mRect.Top, mRect.Right, mRect.Bottom);
  end;
end;

//鼠标响应
procedure TPolyPic.ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint);
var
  i:Integer;
  bPolyPoint:Array of TPoint;
begin
  if fPolyPoint.fPolyPointNum=0 then begin  //鼠标第一次按下
    if Button = mbRight then  Exit;
    //设置pen的格式
    ACanvas.Pen:=PicPen;