u_function.~pas

对绘图工作者

unit U_function;  //函数单元文件

interface
  uses {Graphics,}Math;

  procedure  drawLine(xFrom,yFrom,xTo,yTo:integer);//画直线
  procedure drawroundretangle(x0,y0,x1,y1:integer);//画圆角矩形
  procedure  drawCardinal(CurveNum:integer);//画插值曲线  
  procedure drawapoint(m,k:integer);{cardinal上从点curvePoint[k]到点 curvePoint[k+1]画一曲线,点的密度由m控制}
  procedure  drawBazier(CurveNum:integer);//画逼近曲线
  procedure computePoint( u:double);//bazier上画点
  function computeCoefficeents(n:integer):integer;//bazier计算参数
  procedure transform(xFrom,yFrom,xto,yto:integer);//对选定区域坐标变换
  procedure showeraser(x0,y0:integer);// 显示橡皮擦
  procedure doerase(x0,y0:integer);//用橡皮擦擦除

  procedure rePaint;//重画
  procedure backup;  //暂存图像
  procedure clear;//清空画板
  procedure clearRect;//清空备份区某个区域setRect
  procedure clearBackup;//清空备份区
  procedure savefile(fileName: string);//保存文件
  procedure openfile(fileName: string);//打开文件

  var
   curvePoint:array[1..2,1..29998] of integer;//曲线上的输入点，最多30000个
   con:array[1..2,1..30000] of integer;//控制点的数目，比 curvePoint多2个点
   c:array[1..29998] of integer;//计算bazier曲线用的数组
   ncontrols:integer;//控制点的数目
   s:double;  //张量的值
   m:integer;//控制两个输入点之间曲线的密度

{ const //画图类型
   m_line=1;m_curve=2;m_retangle=3;m_roundRetangle=4;m_polygon=5;
   m_ellipse=6;m_round=7;m_arc=8;m_cardinal=9;m_bazier=10;
   m_boundFill=11;m_floodFill=12;m_retangleCut=13;m_lineCut=14;
   m_rotation=15;m_manify=16;m_move=17;m_reverseColor=18;
}
implementation
  uses u_main,u_setTransform{设置坐标变换};

{*******************************************************************
* 画图函数部分
********************************************************************}
{********************画直线********************}
procedure  drawLine(xFrom,yFrom,xTo,yTo:integer);
begin
  f_main.PaintBox1.Canvas.MoveTo(xFrom,yFrom);//移动到
  f_main.PaintBox1.Canvas.LineTo(xTo,yTo);  //画直线
end;
{********************画圆角矩形********************}
procedure drawroundretangle(x0,y0,x1,y1:integer);
var x,y:integer;
begin
  x:=(x1-x0) div 8;  //8等份
  y:=(y1-y0) div 8;
  f_main.PaintBox1.Canvas.RoundRect(x0,y0,x1,y1,x,y);
 ////    x:=x1-x0; x:=x div 8;  //8等份
 //    y:=y1-y0; y:=y div 8;
 //    drawline(x0+x,y0,x0+7*x,y0);  //上
 //    drawline(x0+x,y1,x0+7*x,y1); //下
 //    drawline(x0,y0+y,x0,y0+7*y); //左
 //    drawline(x1,y0+y,x1,y0+7*y); //右
     {画弧}
 //    f_main.PaintBox1.Canvas.Arc(x0,y0,x0+2*x,y0+2*y,x0+x,y0,x0,y0+y);      // leftup
 //    f_main.PaintBox1.Canvas.Arc(x0+6*x,y0+2*y,x1,y0,x1,y0+y,x0+7*x,y0);      // rightup
 //    f_main.PaintBox1.Canvas.Arc(x0,y1,x0+2*x,y0+6*y,x0,y0+7*y,x0+x,y1);      // leftdown
 //    f_main.PaintBox1.Canvas.Arc(x0+6*x,y0+6*y,x1,y1,x0+7*x,y1,x1,y0+7*y);// rightdown
end;
{********************画插值曲线********************}
procedure  drawCardinal(CurveNum:integer);
var
  i,c:integer;
begin
    if  CurveNum=0 then
      exit;//如果没有输入点，结束
    s:=(1-0.0)/2;      //0.0为张量的值

    ncontrols:=curveNum+2;//控制点多输入点多前后两个点
    //重复第一点
    con[1,1]:= curvePoint[1,1];  //x
    con[2,1]:= curvePoint[2,1];  //y
    for i:=1 to curveNum do begin //复制中间点
        con[1,i+1]:= curvePoint[1,i]; //x
        con[2,i+1]:= curvePoint[2,i]; //y
    end;
    //重复最后点
    con[1,ncontrols]:= curvePoint[1,curveNum]; //x
    con[2,ncontrols]:= curvePoint[2,curveNum]; //y

    for c:=2 to ncontrols-2 do begin //在两个输入点之间画线
        drawapoint(m,c);//从第c个控制点到第c+1个控制点之间画一曲线
    end;

end;
{从点curvePoint[k]到点 curvePoint[k+1]画一曲线,点的密度由m控制}
procedure drawapoint(m,k:integer);
var i,yu,xu:integer;
    u,ax,ay,bx,by,cx,cy,dx,dy :double;
    color: TColor;
begin
    ax:=-s*con[1,k-1]+(2-s)*con[1,k]+(s-2)*con[1,k+1]+ s*con[1,k+2];
    bx:=2*s*con[1,k-1]+(s-3)*con[1,k]+(3-2*s)*con[1,k+1]-s*con[1,k+2];
    cx:=-s*con[1,k-1]+s*con[1,k+1];
    dx:=con[1,k];
    ay:=-s*con[2,k-1]+(2-s)*con[2,k]+(s-2)*con[2,k+1]+ s*con[2,k+2];
    by:=2*s*con[2,k-1]+(s-3)*con[2,k]+(3-2*s)*con[2,k+1]-s*con[2,k+2];
    cy:=-s*con[2,k-1]+s*con[2,k+1];
    dy:=con[2,k];
    color:= f_main.PaintBox1.Canvas.Pen.Color  ;
    for  i:=0 to m do begin
        u:=i*1.0/m  ;
        xu:=round(ax*u*u*u+bx*u*u+ cx*u+dx);//四舍五入
        yu:=round(ay*u*u*u+by*u*u+ cy*u+dy);
        f_main.PaintBox1.Canvas.Pixels[xu,yu] := color; //画点
    end;
end;

{*******************画逼近曲线********************}
procedure  drawBazier(CurveNum:integer);
var
  i:integer;
begin
      nControls := CurveNum;  //控制点的个数
      computeCoefficeents(ncontrols-1);  //计算参数
      for i:=0 to m do begin             //画点
        computePoint( (i*1.0)/(m*1.0));      //m是生成的直线上的点的个数
      end;
end;
{求一个点}
procedure computePoint( u:double);
var k,n:integer;
    x,y:double;
    xx,yy:integer;
    blend:double;
    color:TColor;
begin
    n:=ncontrols-1;
    x:=0;y:=0;
    for k:=0 to n do
    begin
        blend:= c[k+1]*power(u,k)*power(1-u,n-k); //power()求n次方
        x:=x+curvePoint[1,k+1]*blend+0.5;
        y:=y+curvePoint[2,k+1]*blend+0.5;
    end;
    xx:=round(x);
    yy:=round(y);
    color:=  f_main.PaintBox1.Canvas.Pen.Color; //画笔颜色
    f_main.PaintBox1.Canvas.Pixels[xx,yy]:= color;//画点
end;
{计算系数}
function computeCoefficeents(n:integer):integer;
var k,i:integer;
begin
  for k:=0 to n do begin
    c[k+1]:=1;
    for i:=k+1 to n do begin
        c[k+1]:=c[k+1]*i;
    end;
    for i:=2 to n-k do begin
        c[k+1]:=c[k+1] div i;
    end;
  end;
end;
{***************对选定区域坐标变换***************}
procedure transform(xFrom,yFrom,xto,yto:integer);
var
  x,y:integer;
  x1,x2,y1,y2:integer;//区域的左右界，上下限
  newx,newy:integer;//变换后的x,y
begin
  {设置区域的左右界，上下限 }
  if yFrom<yto then
  begin
    y1:= yFrom; y2:= yto;
  end
  else
  begin
    y1:= yto; y2:= yFrom;
  end;
  if xFrom<xto then
  begin
    x1:= xFrom; x2:= xto;
  end
  else
  begin
    x1:= xto; x2:= xFrom;
  end;

  {旋转}
  if f_setTransform.e_rotation.ItemIndex = 0 then//0度
    {无变化}
  else
  begin
    backup;//暂时备份
    clearRect;//删除备份区 setRect
    if f_setTransform.e_rotation.ItemIndex = 1 then//90度
      for x:=0 to (x2-x1) do
        for y:=0 to (y2-y1) do
        begin
          newx:= x1 - y;
          newy:= y2 -x;
          f_main.Image1.Canvas.Pixels[newx,newy]:= f_main.PaintBox1.Canvas.Pixels[x1+x,y2-y]; //复制
        end;
    if f_setTransform.e_rotation.ItemIndex = 2 then//180度
      for x:=0 to (x2-x1) do
        for y:=0 to (y2-y1) do
        begin
          newx:= x1 - x;
          newy:= y2 + y ;
          f_main.Image1.Canvas.Pixels[newx,newy]:= f_main.PaintBox1.Canvas.Pixels[x1+x,y2-y]; //复制
        end;
    if f_setTransform.e_rotation.ItemIndex = 3 then//270度
      for x:=0 to (x2-x1) do
        for y:=0 to (y2-y1) do
        begin
          newx:= x1 + y;
          newy:= y2 + x ;
          f_main.Image1.Canvas.Pixels[newx,newy]:= f_main.PaintBox1.Canvas.Pixels[x1+x,y2-y]; //复制
        end;
    if f_setTransform.e_rotation.ItemIndex = 4 then//水平翻转
      for x:=0 to (x2-x1) do
        for y:=0 to (y2-y1) do
        begin
          newx:= x1 - x ;
          newy:= y2 - y ;
          f_main.Image1.Canvas.Pixels[newx,newy]:= f_main.PaintBox1.Canvas.Pixels[x1+x,y2-y]; //复制
        end;
    if f_setTransform.e_rotation.ItemIndex = 5 then//垂直翻转
      for x:=0 to (x2-x1) do
        for y:=0 to (y2-y1) do
        begin
          newx:= x1 + x ;
          newy:= y2 + y ;
          f_main.Image1.Canvas.Pixels[newx,newy]:= f_main.PaintBox1.Canvas.Pixels[x1+x,y2-y]; //复制
        end;
    repaint;  //刷新
  end;//end 旋转

  {缩放}
   if  f_setTransform.manifyNum  = 1 then //缩放系数
     {无变化}
   else
   begin
     {设置目标区}
     destRect := setRect;
     destRect.Right:= setRect.Left+
           (setRect.Right-setRect.Left)*f_setTransform.manifyNum ;
     destRect.Bottom := setRect.Top +
           (setRect.Bottom-setRect.Top)*f_setTransform.manifyNum ;
     {缩放}
     f_main.PaintBox1.Canvas.CopyRect(destRect,f_main.PaintBox1.Canvas,setRect);
   end;
  {平移}
   if  (f_setTransform.moveX=0) or (f_setTransform.moveY=0) then //平移系数
     {无变化}
   else
   begin
     backup;//暂时备份
     clearRect;//删除备份区的setRect
     {设置目标区域}
     destRect.Left  := setRect.Left + f_setTransform.moveX;
     destRect.Right  := setRect.Right + f_setTransform.moveX;
     destRect.Top  := setRect.Top + f_setTransform.moveY;
     destRect.Bottom   := setRect.Bottom  + f_setTransform.moveY;
     //复制选择区域到备份区目标区域
     f_main.Image1.Canvas.CopyRect(destRect,f_main.PaintBox1.Canvas,setRect);
     repaint;//刷新
   end;

end;
{***************显示橡皮擦***************}
procedure showeraser(x0,y0:integer);
begin
    {橡皮擦的大小}
    setRect.Left:=x0;    setRect.Top:=y0;
    setRect.right:=x0+45;   setRect.Bottom:=y0+45;
    {设置画布画刷颜色和模式 }
    f_main.PaintBox1.Canvas.Brush.Style:= bsClear;// 空心
    {画橡皮}
    f_main.PaintBox1.Canvas.Rectangle(x0,y0,x0+45,y0+45);
    f_main.PaintBox1.Canvas.TextRect(setRect,x0,y0,'橡皮擦');
end;
{***************用橡皮擦擦除***************}
procedure doerase(x0,y0:integer);
begin
    {橡皮擦的大小}
    setRect.Left:=x0;    setRect.Top:=y0;
    setRect.right:=x0+45;   setRect.Bottom:=y0+45;
    {设置画布画刷颜色和模式 }
    f_main.PaintBox1.Canvas.Brush.Style:= bsSolid;// 实心
    {擦除}
    f_main.PaintBox1.Canvas.Rectangle(x0,y0,x0+45,y0+45);
    f_main.PaintBox1.Canvas.FillRect(setRect);
end;
{*******************************************************************
* 其它函数部分
********************************************************************}
{重画}
procedure rePaint;
begin
    clear;//一定要先清空画图区
  //从 Image1复制到   PaintBox1
  f_main.PaintBox1.Canvas.CopyRect(drawRect,f_main.Image1.Canvas,backupRect);
end;

{暂存图像}
procedure backup;
begin
   clearBackup;//一定要先清空备份区
  //从 PaintBox1复制到 Image1
  f_main.Image1.Canvas.CopyRect(backupRect,f_main.PaintBox1.Canvas,drawRect);
end;


{清空画板}
procedure clear;
begin
  //设置画布画刷颜色和模式
  f_main.PaintBox1.Canvas.Brush.Color:= clwhite;
  f_main.PaintBox1.Canvas.Brush.Style:= bsSolid;
  //用画刷颜色填充整个绘图框
  f_main.PaintBox1.Canvas.FillRect(drawRect);
end;

{清空备份区}
procedure clearBackup;
begin
  //设置画布画刷颜色和模式
  f_main.Image1.Canvas.Brush.Color:= clwhite;
  f_main.Image1.Canvas.Brush.Style:= bsSolid;
  //用画刷颜色填充整个备份区
  f_main.Image1.Canvas.FillRect(backupRect);
end;

procedure clearRect;//清空备份区某个区域
begin
  //设置画布画刷颜色和模式
  f_main.Image1.Canvas.Brush.Color:= clwhite;
  f_main.Image1.Canvas.Brush.Style:= bsSolid;
  //用画刷颜色填充整个备份区
  f_main.Image1.Canvas.FillRect(setRect);
end;

{保存文件}
procedure savefile(fileName: string);
begin
  f_main.Image1.Picture.SaveToFile(fileName); //保存位图对象到文件
end;

{打开文件}
procedure openfile(fileName: string);
var
  pic:TBitmap;     //声明位图对象

begin
 pic:= TBitmap.Create;//创建位图对象
  pic.LoadFromFile(fileName); //从文件载入位图到位图对象
  f_main.PaintBox1.Canvas.Draw(0,0,pic); //在画布插入位图（左上角坐标为（0，0））
  pic.Free;              //释放位图对象

 // f_main.Image1.Picture.LoadFromFile(fileName);

end;

end.