drwbasetype.pas

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

    offsetRect(gra,rt.Left,rt.Top);
    swCanvas.FillRect(gra);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure DoVertCenter(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
  Haf : Integer;
  iWidth,iHeight:Integer;
begin
  iWidth:=rt.Right-rt.Left;
  iHeight:=rt.Bottom-rt.Top;
  Haf := iHeight Div 2;
  ColorRect.Left := 0;
  ColorRect.Right := iWidth;
  for I := 0 to Haf do begin
    ColorRect.Top := MulDiv (I, Haf, Haf);
    ColorRect.Bottom := MulDiv (I + 1, Haf, Haf);
    R := fr + MulDiv(I, dr, Haf);
    G := fg + MulDiv(I, dg, Haf);
    B := fb + MulDiv(I, db, Haf);
    swCanvas.Brush.Color := RGB(R, G, B);
    offsetRect(ColorRect,rt.Left,rt.Top);
    swCanvas.FillRect(ColorRect);
    offsetRect(colorRect,-rt.Left,-rt.Top);
    ColorRect.Top := iHeight - (MulDiv (I, Haf, Haf));
    ColorRect.Bottom := iHeight - (MulDiv (I + 1, Haf, Haf));
    offsetRect(ColorRect,rt.Left,rt.Top);
    swCanvas.FillRect(ColorRect);
    offsetRect(colorRect,-rt.Left,-rt.Top);
  end;
end;

procedure doGradUUp(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  points:array[0..7] of TPoint;
  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;
  pw:=iwidth/2/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),Trunc(0));
    points[1]:=point(Trunc(i*pw),Trunc(iheight-1-i*ph));
    points[2]:=point(Trunc(iwidth-1-i*pw),Trunc(iheight-1-i*ph));
    points[3]:=point(Trunc(iwidth-1-i*pw),Trunc(0));
    points[4]:=point(Trunc(iwidth-1-i*pw-pw),Trunc(0));
    points[5]:=point(Trunc(iwidth-1-i*pw-pw),Trunc(iheight-1-i*ph-ph));
    points[6]:=point(Trunc(i*pw+pw),Trunc(iheight-1-i*ph-ph));
    points[7]:=point(Trunc(i*pw+pw),Trunc(0));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradURight(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..7] of TPoint;
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/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),Trunc(i*ph));
    points[1]:=point(Trunc(i*pw),Trunc(i*ph));
    points[2]:=point(Trunc(i*pw),Trunc(iHeight-1-i*ph));
    points[3]:=point(Trunc(iWidth-1),Trunc(iHeight-1-i*ph));
    points[4]:=point(Trunc(iWidth-1),Trunc(iHeight-1-i*ph-ph));
    points[5]:=point(Trunc(i*pw+pw),Trunc(iHeight-1-i*ph-ph));
    points[6]:=point(Trunc(i*pw+pw),Trunc(i*ph+ph));
    points[7]:=point(Trunc(iWidth-1),Trunc(i*ph+ph));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradULeft(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..7] of TPoint;
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/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(0),Trunc(i*ph));
    points[1]:=point(Trunc(iWidth-1-i*pw),Trunc(i*ph));
    points[2]:=point(Trunc(iWidth-1-i*pw),Trunc(iHeight-1-i*ph));
    points[3]:=point(Trunc(0),Trunc(iHeight-1-i*ph));
    points[4]:=point(Trunc(0),Trunc(iHeight-1-i*ph-ph));
    points[5]:=point(Trunc(iWidth-1-i*pw-pw),Trunc(iHeight-1-i*ph-ph));
    points[6]:=point(Trunc(iWidth-1-i*pw-pw),Trunc(i*ph+ph));
    points[7]:=point(Trunc(0),Trunc(i*ph+ph));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradUDown(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..7] 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/2/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),Trunc(iHeight-1));
    points[1]:=point(Trunc(i*pw),Trunc(i*ph));
    points[2]:=point(Trunc(iWidth-1-i*pw),Trunc(i*ph));
    points[3]:=point(Trunc(iWidth-1-i*pw),Trunc(iHeight-1));
    points[4]:=point(Trunc(iWidth-1-i*pw-pw),Trunc(iHeight-1));
    points[5]:=point(Trunc(iWidth-1-i*pw-pw),Trunc(i*ph+ph));
    points[6]:=point(Trunc(i*pw+pw),Trunc(i*ph+ph));
    points[7]:=point(Trunc(i*pw+pw),Trunc(iHeight-1));
    XPoly(swCanvas,points,rt.Left,rt.Top);
  end;
  swCanvas.Pen.Style := psSolid;
end;

procedure doGradSWNE(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 := iHeight-1-(i*Pw);
    if (y0>0) then x0:=0 else
      begin
      x0:=-y0;
      y0:=0;
      end;
    y1:=iHeight-1-((i+1)*pw);
    if (y1>0) then x1:=0 else
      begin
      x1:=-y1;
      y1:=0;
      end;
    x2:=(i*pw);
    if (x2<iWidth) then y2:=iHeight-1 else
      begin
      y2:=iHeight-1-(x2-iWidth);
      x2:=iWidth-1;
      end;
    x3:=(i+1)*pw;
    if (x3<iWidth) then y3:=iHeight-1 else
      begin
      y3:=iHeight-1-(x3-iWidth);
      x3:=iWidth-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 doGradSENW(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 := iHeight-1-(i*Pw);
    if (y0>0) then x0:=iWidth-1 else
      begin
      x0:=iWidth-1+y0;
      y0:=0;
      end;
    y1:=iHeight-1-((i+1)*pw);
    if (y1>0) then x1:=iWidth-1 else
      begin
      x1:=iWidth-1+y1;
      y1:=0;
      end;
    x2:=iWidth-1-(i*pw);
    if (x2>0) then y2:=iHeight-1 else
      begin
      y2:=iHeight-1+x2;
      x2:=0;
      end;
    x3:=iWidth-1-((i+1)*pw);
    if (x3>0) then y3:=iHeight-1 else
      begin
      y3:=iHeight-1+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 doGradRCModulo(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I,x3,y3: Integer;
  R, G, B : Byte;
  Pw,ph: Real;
  IsRect:boolean;
  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/2)/255;
  IsRect:=false;
  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);
     x3:=trunc(iWidth-2*i*pw) div 4;
     y3:=trunc(iHeight-2*i*ph) div 4;
    if i=0 then begin x3:=0;y3:=0 end;
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    if (i mod 10)=0 then IsRect:= not IsRect;
    if IsRect then
    Xroundrect(swCanvas,trunc(i*pw),trunc(i*ph),
     trunc(iWidth-i*pw),trunc(iHeight-1-i*ph),
     x3,y3,rt.Left,rt.Top)
    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 doGradRCMix(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
var
  I,x3,y3: 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/2)/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);
     x3:=trunc(iWidth-2*i*pw) div 4;
     y3:=trunc(iHeight-2*i*ph) div 4;
    if i=0 then begin x3:=0;y3:=0 end;
    swCanvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    if i<63 then
    Xroundrect(swCanvas,trunc(i*pw),trunc(i*ph),
     trunc(iWidth-i*pw),trunc(iHeight-1-i*ph),
     x3,y3,rt.Left,rt.Top)