rounpic.pas

很不错的delphi 画失量图的delphi源代码

///////////////////////
//王昌雨
//2003-06-11
//圆角矩形
///////////////////////
unit RounPic;

interface

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

const
  FOCUS_NUM=10;

type
  TRounPic=Class(TPicBase)
    private
      StartPos:TPoint;
      EndPos:TPoint;
      FocusPoint:Array[1..FOCUS_NUM] of TPoint;
      WhPoint:TPoint;
      fRoundRate:Array[0..1] of Single;
      RounKeyState:TShiftState;
      procedure GetFocusPoints;
      procedure SetPicwhPoint(awhPoint:TPoint);
    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 DrawRounPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint;aWhPoint:TPoint);
      //property 的实现方法
    published
      property PicStartPoint:TPoint read StartPos write StartPos;
      property PicEndPoint: TPoint  read EndPos write EndPos;
      property PicWhPoint: TPoint read whPoint write SetPicwhPoint;
      property PicPen;
      property PicBrush;
      Property PicFont;
      property PicRect;
      property Choosed;
      property PicId;
      property FocusPen;
      property FocusBrush;
      property DrawEndEvent;
      property PicIndex;
  end;

implementation

constructor TRounPic.Create;
begin
  inherited Create;
  WhPoint:=Point(0,0);
  fRoundRate[0]:=1/3;
  fRoundRate[1]:=1/3;
end;

destructor  TRounPic.Destroy;
begin
  inherited Destroy;
end;

procedure TRounPic.SetPicwhPoint(awhPoint:TPoint);
begin
  whPoint:=awhPoint;
  fRoundRate[0] := whPoint.X / (EndPos.X-StartPos.X);
  if fRoundRate[0]<0 then fRoundRate[0]:=0;
  if fRoundRate[0]>1 then fRoundRate[0]:=1;
  fRoundRate[1] := whPoint.Y / (EndPos.Y-StartPos.Y);
  if fRoundRate[1]<0 then fRoundRate[1]:=0;
  if fRoundRate[1]>1 then fRoundRate[1]:=1;
end;

procedure TRounPic.GetFocusPoints;
begin
  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; //终点
  focusPoint[9] := Point(StartPos.X+whPoint.X, StartPos.Y);
  focusPoint[10]:= Point(StartPos.x,StartPos.Y+whPoint.Y);
end;

procedure TRounPic.DrawPic(ACanvas:TCanvas);          //在acanvas上画图
var
  pp: array[1..3] of TPoint;
  drawStartPoint: Tpoint;
  drawEndPoint: Tpoint;
  DrawwhPoint: TPoint;
begin
  drawStartPoint := startPos;
  drawEndPoint := endPos;
  drawwhPoint:=whPoint;
  pp[1] := drawStartPoint;
  pp[2] := drawEndPoint;
  pp[3] := drawwhPoint;
  LpToDp(ACanvas.Handle, pp[1], 3); //取得设备坐标
  drawStartPoint := pp[1];
  drawEndPoint:=pp[2];
  drawwhPoint:=pp[3];
  ACanvas.Pen:=PicPen;
  ACanvas.Brush:=PicBrush;
  ACanvas.Font:=PicFont;
  DrawRounPic(ACanvas, drawStartPoint, drawEndPoint,drawwhPoint);
  if Choosed then DrawFocusRect(ACanvas);
end;

procedure TRounPic.MovePic(ACanvas:TCanvas; APoint:TPoint);  //在acanvas上移动
var
  tmprect:TRect;
begin
  Inc(startPos.x, APoint.X);
  Inc(startPos.y, APoint.y);
  Inc(endpos.x, APoint.x);
  Inc(endpos.y, APoint.y);
   //调整图元矩形区域
  tmprect.Left := Min(startPos.x, endPos.x);
  tmprect.Top := Min(startPos.y, endpos.Y);
  tmprect.Right := Max(startPos.x, endpos.x);
  tmprect.Bottom := Max(startPos.y, endPos.y);
  if tmprect.Right = tmprect.Left then Inc(tmprect.Right, 2);
  if tmprect.Top = tmprect.Bottom then Inc(tmprect.Bottom, 2);
  PicRect:=tmpRect;
end;

function  TRounPic.MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS; //鼠标位置
var
  mPoint: Tpoint;
  mRect: TRect;
  FocusNumber: Integer; //焦点数量
  i: Integer;
  RectHRGN: HRGN;
begin
  result := POS_OUT;
  focusNumber := FOCUS_NUM; // =2 焦点数量
  RectHRGN := CreatePicRgn(ACanvas);
    //CreateLineRgn(startPoint.x,startPoint.y,endPoint.x,endPoint.y);//,Top,Right,Bottom);
  if not Choosed then begin //图元未选中，只要判断是否在图元区域即可
    if PtInRegion(RectHrgn, APoint.x, APoint.y) = True then result := POS_CENTER
  end else begin //图元被选中，不仅要判断是否在图元区域，还需要判断在图元的具体位置
    if PtInRegion(RectHrgn, APoint.x, APoint.y) = True then  result := POS_CENTER;
    GetFocusPoints;  //取焦点坐标
    LpToDp(ACanvas.Handle, focusPoint[1], focusNumber);
    mPoint:=APoint;
    for i := FocusNumber Downto 1 do  begin
      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
        if i>8 then begin
          Result := MOUSE_POS(Ord(POS_ROUNDRECT_TOP)- 1 + (i-8));
        end else begin
          Result := MOUSE_POS(Ord(POS_LEFTTOP)- 1 + i);
        end;
        Break;
      end
    end;
  end;
  DeleteObject(RectHrgn);
end;

function  TRounPic.CreatePicRgn(ACanvas:TCanvas): HRGN;  //产生图元区域的句柄
var
  tempHrgn: HRGN;
  diff: Integer;
  mRect: TRect;
  pp: array[1..3] of TPoint;
begin
  diff := 3; //内外矩形与与指定矩形的差距
  mRect := PicRect;
  pp[1]:=mRect.TopLeft;
  pp[2]:=mRect.BottomRight;
  pp[3]:=whPoint;
  LpToDp(ACanvas.Handle, pp[1], 3);
  mRect.TopLeft:=pp[1];
  mRect.BottomRight:=pp[2];
  if PicBrush.Style=bsClear then begin //透明
    Result := CreateRoundRectRgn(mRect.Left - diff, mRect.Top - diff, mRect.Right+ diff,
        mRect.Bottom + diff,pp[3].X,pp[3].y);
    tempHrgn := CreateRoundRectRgn(mRect.Left + diff, mRect.Top + diff,mRect.Right - diff,
        mRect.Bottom - diff,pp[3].x,pp[3].y);
    CombineRGN(Result, Result, tempHrgn, RGN_DIFF);
    DeleteObject(tempHrgn);
  end else begin
    Result := CreateRoundRectRgn(mRect.Left, mRect.Top, mRect.Right, mRect.Bottom,pp[3].x,pp[3].y);
  end;
end;

procedure TRounPic.DrawFocusRect(ACanvas:TCanvas);  //在Acanvas上画焦点
var
  mRect: TRect;
  FocusNumber: Integer; //焦点数量
  i: Integer;
begin
  focusNumber := FOCUS_NUM; //=2   焦点数量
  GetFocusPoints;  //取焦点坐标
  LpToDp(ACanvas.Handle,FocusPoint[1],FocusNumber);
  ACanvas.Pen:=FocusPen;
  ACanvas.Brush:=FocusBrush;
  for i := 1 to focusNumber do begin  //绘制焦点矩形
    if i>8 then ACanvas.Brush.Color:=clLime;
    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;
end;

//鼠标响应
procedure TRounPic.ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer;
    Button: TMouseButton;Shift: TShiftState; APoint:TPoint);
begin
  if Button = mbRight then  Exit;
  //设置pen的格式
  ACanvas.Pen:=PicPen;
  ACanvas.Pen.Mode:=pmXor;
  //设置Brush的格式
  ACanvas.Brush:=PicBrush;
  StartPos:=APoint;  //设置图元的起点
  EndPos := APoint; //置终点坐标
end;

procedure TRounPic.ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer;
    Shift: TShiftState;APoint:TPoint);
var
  center: TPoint;
begin
  if (ssLeft in shift) then begin //鼠标左键按下
    DrawRounPic(ACanvas, StartPos,EndPos,whPoint);
    if ssCtrl in shift then begin //ssCtrl 键按下 以中心点为起点绘制椭圆
      Center.x := (startPos.x + endPos.x) div 2;
      Center.y := (startPos.y + endPos.y) div 2;
      startPos.x := center.x - (APoint.x - center.x);
      startPos.y := center.y - (APoint.y - center.y);
      endPos.x := center.x + (APoint.x - center.x);
      endPos.y := center.y + (APoint.y - center.y);
    end else begin
      EndPos := APoint;
    end;
    WhPoint.X :=Round((EndPos.X-StartPos.X) * fRoundRate[0]);
    WhPoint.Y :=Round((EndPos.Y-StartPos.Y) * fRoundRate[1]);
    DrawRounPic(ACanvas, StartPos,EndPos,whPoint);
  end;
end;

procedure TRounPic.ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer;
    Button: TMouseButton;  Shift: TShiftState; APoint:TPoint);
var
  tmpRect:TRect;
  pp: array[1..3] of TPoint;
begin
  //保证绘制的图元尺寸的最小值
  if ((Abs(endPos.x - startPos.x) < MinCellSize) and (Abs(endPos.y - startPos.y) < MinCellSize)) then begin
    endPos.x := startpos.x + MinCellSize;
    endPos.y := startpos.y + MinCellSize;
    WhPoint.X :=Round((EndPos.X-StartPos.X) * fRoundRate[0]);
    WhPoint.Y :=Round((EndPos.Y-StartPos.Y) * fRoundRate[1]);
  end;
  pp[1] := startPos;
  pp[2] := endPos;
  pp[3] := whPoint;
  DpToLp(ACanvas.Handle, pp[1], 3);
  startPos := pp[1];
  endPos := pp[2];
  whPoint:= pp[3];
  tmpRect.Left := Min(startPos.x, endPos.x);
  tmpRect.Top := Min(startPos.y, endPos.y);
  tmpRect.Right := Max(startPos.x, endPos.x);
  tmpRect.Bottom := Max(startPos.y, endPos.y);
  if tmpRect.Left =tmpRect.Right then Inc(tmpRect.Right);
  if tmpRect.Top =tmpRect.Bottom then Inc(tmpRect.Bottom);
  StartPos:=tmprect.TopLeft;
  endpos:=tmprect.BottomRight;
  WhPoint.X :=Round((EndPos.X-StartPos.X) * fRoundRate[0]);
  WhPoint.Y :=Round((EndPos.Y-StartPos.Y) * fRoundRate[1]);
  PicRect:=tmpRect;
  //绘制矩形
  ACanvas.Pen := PicPen;
  ACanvas.Brush := PicBrush;
  ACanvas.Font := PicFont;
  DrawRounPic(ACanvas, StartPos,EndPos,whPoint);
  if Assigned(DrawEndEvent) then DrawEndEvent(Self);
end;

//键盘响应
procedure TRounPic.ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer;
    var Key: Word; mouse: TPoint; Shift:TShiftState);
begin

end;