drwbasetype.pas

delphi语言开发的矢量图形处理对象

    else
    Xellipse(swCanvas,trunc(i*pw),trunc(i*ph),
     trunc(iWidth-i*pw),trunc(iHeight-1-i*ph),rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradQuatro(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I,w2,h2: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  iWidth,iHeight:Integer;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Ph := (iHeight/4) / 255;
  pw:=(iWidth/4)/255;
  w2:=iWidth div 2;
  h2:=iHeight div 2;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    Xrectangle(swCanvas,trunc(i*pw),trunc(i*ph),
     trunc(w2+1-i*pw),trunc(h2+1-i*ph),rt.Left,rt.Top);
    Xrectangle(swCanvas,trunc(w2-1+i*pw),trunc(i*ph),
     trunc(iWidth-1-i*pw),trunc(h2+1-i*ph),rt.Left,rt.Top);
    Xrectangle(swCanvas,trunc(i*pw),trunc(h2-1+i*ph),
     trunc(w2+1-i*pw),trunc(iHeight-1-i*ph),rt.Left,rt.Top);
    Xrectangle(swCanvas,trunc(w2-1+i*pw),trunc(h2-1+i*ph),
     trunc(iWidth-1-i*pw),trunc(iHeight-1-i*ph),rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradNWSE(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw: Real;
  iWidth,iHeight:Integer;
  x0,y0,x1,y1,x2,y2,x3,y3 : Real;
  points:array[0..3] of TPoint;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Pw := (iWidth+iHeight) / 255;
  for I := 0 to 254 do begin         //Make trapeziums of color
    x0 := i*Pw;
    if (x0<iWidth) then y0:=0 else
      begin
      y0:=x0-iWidth;
      x0:=iWidth-1;
      end;
    x1:=(i+1)*pw;
    if (x1<iWidth) then begin
      y1:=0;
      end
      else begin
      y1:=x1-iWidth;
      x1:=iWidth-1;
      end;
    y2:=i*pw;
    if (y2<iHeight) then x2:=0 else
      begin
      x2:=y2-iHeight;
      y2:=iHeight-1;
      end;
    y3:=(i+1)*pw;
    if (y3<iHeight) then x3:=0 else
      begin
      x3:=y3-iHeight;
      y3:=iHeight-1;
      end;
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    points[0]:=point(Trunc(x0),Trunc(y0));
    points[1]:=point(Trunc(x1),Trunc(y1));
    points[3]:=point(Trunc(x2),Trunc(y2));
    points[2]:=point(Trunc(x3),Trunc(y3));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradNESW(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw: Real;
  iWidth,iHeight:Integer;
  x0,y0,x1,y1,x2,y2,x3,y3 : Real;
  points:array[0..3] of TPoint;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Pw := (iWidth+iHeight) / 255;
  for I := 0 to 254 do begin         //Make trapeziums of color
    y0 := i*Pw;
    if (y0<iHeight) then x0:=iWidth-1 else
      begin
      x0:=iWidth-1-(y0-iHeight);
      y0:=iHeight-1;
      end;
    y1:=(i+1)*pw;
    if (y1<iHeight) then x1:=iWidth-1 else
      begin
      x1:=iWidth-1-(y1-iHeight);
      x1:=iWidth-1;
      end;
    x2:=iWidth-1-(i*pw);
    if (x2>0) then y2:=0 else
      begin
      y2:=-x2;
      x2:=0;
      end;
    x3:=iWidth-1-((i+1)*pw);
    if (x3>0) then y3:=0 else
      begin
      y3:=-x3;
      x3:=0;
      end;
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    points[0]:=point(Trunc(x0),Trunc(y0));
    points[1]:=point(Trunc(x1),Trunc(y1));
    points[3]:=point(Trunc(x2),Trunc(y2));
    points[2]:=point(Trunc(x3),Trunc(y3));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradLNW(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  iWidth,iHeight:integer;
  points:array[0..5] of TPoint;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Ph := iHeight / 255;
  pw:=iWidth/255;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    points[0]:=point(Trunc(iwidth-1-i*pw),0);
    points[1]:=point(Trunc(iwidth-1-i*pw),Trunc(iheight-1-i*ph));
    points[2]:=point(0,Trunc(iheight-1-i*ph));
    points[3]:=point(0,Trunc(iheight-1-i*ph-ph));
    points[4]:=point(Trunc(iwidth-1-i*pw-pw),Trunc(iheight-1-i*ph-ph));
    points[5]:=point(Trunc(iwidth-1-i*pw-pw),0);
    Xpoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradLNE(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  iWidth,iHeight:Integer;
  points:array[0..5] of TPoint;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Ph := iHeight / 255;
  pw:=iWidth/255;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    points[0]:=point(Trunc(i*pw),0);
    points[1]:=point(Trunc(i*pw),Trunc(iHeight-1-i*ph));
    points[2]:=point(Trunc(iWidth-1),Trunc(iHeight-1-i*ph));
    points[3]:=point(Trunc(iWidth-1),Trunc(iHeight-1-i*ph-ph));
    points[4]:=point(Trunc(i*pw+pw),Trunc(iHeight-1-i*ph-ph));
    points[5]:=point(Trunc(i*pw+pw),0);
    Xpoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradLeftRight(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  pw: Real;
  h2:integer;
  gra:TRect;
  iWidth,iHeight:integer;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Pw := iWidth / 255;
  h2:=iHeight div 2;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    gra:=rect(trunc(i*pw),0,trunc(i*pw+pw),h2);
    offsetRect(gra,rt.Left,rt.Top);
    swCanvas.Fillrect(gra);
    gra:=rect(trunc(iWidth-1-i*pw-pw),h2,trunc(iWidth-1-i*pw),iHeight-1);
    offsetRect(gra,rt.Left,rt.Top);
    swCanvas.Fillrect(gra);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradDuo(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I,w2: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  iWidth,iHeight:Integer;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Ph := (iHeight/2) / 255;
  pw:=(iWidth/4)/255;
  w2:=iWidth div 2;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    Xrectangle(swCanvas,trunc(i*pw),trunc(i*ph),
     trunc(w2+1-i*pw),trunc(iHeight-1-i*ph),rt.Left,rt.Top);
    Xrectangle(swCanvas,trunc(w2-1+i*pw),trunc(i*ph),
     trunc(iWidth-1-i*pw),trunc(iHeight-1-i*ph),rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure DoCircle(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw, Ph : Real;
  x1,y1,x2,y2 : Real;
  iWidth,iHeight:Integer;
begin
  swCanvas.Pen.Style := psClear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  x1 := 0;
  x2 := iWidth+2;
  y1 := 0;
  y2 := iHeight+2;
  Pw := (iWidth / 2) / 255;
  Ph := (iHeight / 2) / 255;
  for I := 0 to 255 do begin         //Make cicles of color
    x1 := x1 + Pw;
    x2 := X2 - Pw;
    y1 := y1 + Ph;
    y2 := y2 - Ph;
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    XEllipse(swCanvas,Trunc(x1),Trunc(y1),Trunc(x2),Trunc(y2),rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradUpDown(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  ph: Real;
  w2:integer;
  gra:Trect;
  iWidth,iHeight:Integer;
begin
  swCanvas.Pen.Style := psclear;
  swCanvas.Pen.Mode := pmCopy;
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Ph := iHeight / 255;
  w2:=iWidth div 2;
  for I := 0 to 255 do begin         //Make trapeziums of color
    R := fr + MulDiv(I, dr, 255);    //Find the RGB values
    G := fg + MulDiv(I, dg, 255);
    B := fb + MulDiv(I, db, 255);
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    gra:=rect(0,trunc(i*ph),w2,trunc(i*ph+ph));
    offsetRect(gra,rt.Left,rt.Top);
    swCanvas.Fillrect(gra);
    gra:=rect(w2,trunc(iHeight-1-i*ph-ph),iWidth-1,trunc(iHeight-1-i*ph));
    offsetRect(gra,rt.Left,rt.Top);
    swCanvas.Fillrect(gra);
  end;
  swCanvas.Pen.Style := psSolid;
end;


end.