drwbasetype.pas

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

unit DrwBaseType;

interface
uses
  windows,Messages, SysUtils, Variants, Classes,Graphics,Types,math;
CONST
  MAXOFFSET=5;
  CurrentVer='Draw 2.0';
  CLIPBOARDFORMAT='ObjectStream';
  WM_UNSELECT=WM_USER+100;
  WM_DELACTION=WM_USER+101;
type
  TDrwStyle=(drwSelect,drwLine,drwEllispe,drwRect,drwCircle,drwPLine,
            drwText,drwPolygon,drwImage,drwGroup,drwArc,drwFreeLine,
            drwSanJiao,drwRectGraph,drwLineGraph,drwYc,drwCurve,drwGrid);
  TArrowStyle=(arNone,arLeft,arRight,arBoth,arFillLeft,arFillRight,arFillBoth);
  TAlign=(taLeft,taRight,taTop,taBottom);
  TDrwName=String[100];
  TDrwFont=String[60];
  TDrwPline=array of TPoint;
  //棒图的数据结构
  TDotData=record
    gatherName:TDrwName;
    gatherCode:integer;
    realValue:double;
    gatherTime:TDatetime;
  end;
  //曲线的数据结构
  TLineData=record
      realY:double;
      realX:double;
      gatherTime:TDateTime;
  end;
  TLineArray=array of array of TlineData;
  TDotLine=record
     lineName:string[40];
     gatherCode:integer;
     lineWidth:integer;
     color:TColor;
  end;
  TYcData=record //曲线数据结构
     Name:string[40];
     gatherCode:integer;
     DataNum:integer;//位数
     isAbs:boolean;
     dataFormat:byte;//数据格式：1、浮点数 2、整数 3、百分数
     dataType:byte;//1:遥测2：日报3：月报4：年报
     dataTime:byte;//小时、天、月
     Value:double;
  end;
  TCurveData=record //曲线量数据结构
    Name:string[40];
    dataNum:integer;
    //1:最大值2:最小值3:平均值4:负荷率5:最大值时间6:最小值时间
    dataType:byte;
    dataFormat:byte;//数据格式：1、浮点数 2、整数 3、百分数
    isAbs:boolean;
    Value:double;
  end;
  //**************************************************************
  //   以下定义用于图形的渐变填充 2004.4.9 add
  //
  //**************************************************************
  TGradientStyle = (jgdUp, jgdDown, jgdLeft, jgdRight,
    jgdRectOut,jgdRectIn, jgdHorizCenter, jgdVertCenter,
    jgdCircOut,jgdCircIn,jgdNWSE,jgdNESW,jgdSENW,jgdSWNE,
    jgdUright,jgdULeft,jgdUUp,jgdUDown,
    jgdRCMix,jgdRCModulo,jgdQuatro,jgdDuo,
    jgdLNE,jgdLNW,jgdUpDown,jgdLeftRight);

  procedure DoVertCenter(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
  procedure DoHorizCenter(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
  procedure DoRectangle(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
  procedure doGradUUp(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradURight(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradULeft(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradUDown(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradSWNE(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradSENW(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradRCModulo(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradRCMix(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradQuatro(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradNWSE(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradNESW(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradLNW(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradLNE(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradLeftRight(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure doGradDuo(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);
  procedure DoCircle(swCanvas:TCanvas;fr, fg, fb, dr, dg, db : Integer;rt:TRect);
  procedure doGradUpDown(swCanvas:TCanvas;fr, fg, fb, dr, dg, db: Integer;rt:TRect);


  procedure FillWithGradient(swCanvas:TCanvas;StartGradientColor,EndGradientColor:TColor;
            FillDirection:TGradientStyle;r:TRect);

var
  drwTool:TDrwStyle;
  isFill:boolean;//说明是否填充
  isRound:boolean;
  drwCanvasWidth:longint;//存储当前画布的宽
  drwCanvasHeight:longint;//存储当前花布的高
  CF_MYFORMAT:integer;
  curFillColor:TColor;
  curForeColor:TColor;//当前画布前景色
  curTextName:string;
  curTextSize:integer;
  bFontBold,bFontItalic,bFontUnderLine:boolean;
  curPenWidth:integer;

implementation

procedure XPoly(swCanvas:TCanvas;P:array of TPoint;x0,y0:Integer);
var i:integer;
begin
  for i:=0 to High(P) do
  begin
    P[i].x:=x0+P[i].x;
    P[i].y:=y0+P[i].y;
  end;
  swCanvas.Polygon (P);
end;

procedure XEllipse(swCanvas:TCanvas;x1,y1,x2,y2 : Integer;x0,y0:Integer);
begin
  x1:=x0+x1;
  y1:=y0+y1;
  x2:=x0+x2;
  y2:=y0+y2;
  swCanvas.Ellipse (x1,y1,x2,y2);
end;

procedure XRoundrect(swCanvas:TCanvas;x1,y1,x2,y2,x3,y3 : integer;x0,y0:integer);
begin
  x1:=x0+x1;
  y1:=y0+y1;
  x2:=x0+x2;
  y2:=y0+y2;
  x3:=x3;
  y3:=y3;
  swCanvas.roundrect(x1,y1,x2,y2,x3,y3);
end;

procedure XRectangle(swCanvas:TCanvas;x1,y1,x2,y2 : integer;x0,y0:integer);
begin
  x1:=x0+x1;
  y1:=y0+y1;
  x2:=x0+x2;
  y2:=y0+y2;
  swCanvas.Rectangle (x1,y1,x2,y2);
end;

procedure FillWithGradient(swCanvas:TCanvas;StartGradientColor,EndGradientColor:TColor;
          FillDirection:TGradientStyle;r:TRect);
var
  oldPenMode:TPenMode;
  oldPenStyle:TPenStyle;
  oldBrushStyle:TBrushStyle;
  oldBrushColor:TColor;

  TargetRect : TRect;
  i,iWidth,iHeight: Integer;
  clrFrom,clrTo : TColor;
  RGBFromR,RGBFromG,RGBFromB : Byte;
  RGBDiffR,RGBDiffG,RGBDiffB : integer;
begin
   //保存画布的默认设置
   oldPenStyle:=swCanvas.Pen.Style;
   oldPenMode:=swCanvas.Pen.Mode;
   oldBrushStyle:=swCanvas.Brush.Style;
   oldBrushColor:=swCanvas.Brush.Color;

   iWidth:=r.Right -r.Left;
   iHeight:=r.Bottom -r.Top;
   clrFrom := StartGradientColor;
   clrTo := EndGradientColor;

   Case FillDirection of
      jgdCircOut,jgdRectOut:begin
         clrTo:=StartGradientcolor;
         clrFrom:=EndGradientColor;
      end;
   end;


   RGBFromR := GetRValue (ColorToRGB (ClrFrom));
   RGBFromG := GetGValue (ColorToRGB (ClrFrom));
   RGBFromB := GetBValue (ColorToRGB (ClrFrom));
   RGBDiffR := GetRValue (ColorToRGB (ClrTo)) - RGBFromR;
   RGBDiffG := GetGValue (ColorToRGB (ClrTo)) - RGBFromG;
   RGBDiffB := GetBValue (ColorToRGB (ClrTo)) - RGBFromB;

   swCanvas.Pen.Style := psSolid;
   swCanvas.Pen.Mode := pmCopy;
   swCanvas.Brush.style:=bssolid;
   case FillDirection of
     jgdLeft,jgdRight:
     begin
       for i := 0 to 255 do
       begin
          TargetRect := Rect(MulDiv (i,iWidth,256),0,
                            MulDiv (i+1,iWidth,256),iHeight);
          swCanvas.Brush.Color := RGB (RGBFromR + MulDiv(i,RGBDiffR, 255),
                                    RGBFromG + MulDiv(i,RGBDiffG, 255),
                                    RGBFromB + MulDiv(i,RGBDiffB, 255));
          offsetRect(targetRect,r.Left,r.Top);
          swCanvas.FillRect(TargetRect);
        end;
      end; {if left or right}
      jgdUp,jgdDown:
      begin
        for i := 0 to $ff do
        begin
           TargetRect := Rect(0,MulDiv (i,iHeight,256),
                            iWidth,MulDiv (i+1,iHeight,256));
           swCanvas.Brush.Color := RGB (RGBFromR + MulDiv(i,RGBDiffR,255),
                                    RGBFromG + MulDiv(i,RGBDiffG,255),
                                    RGBFromB + MulDiv(i,RGBDiffB,255));
           offsetRect(targetRect,r.Left,r.Top);
           swCanvas.FillRect(TargetRect);
        end;
      end;
      jgdRectOut,jgdRectIn: DoRectangle(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdCircOut,jgdCircIn: DoCircle(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdHorizCenter: DoHorizCenter(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdVertCenter: DoVertCenter(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdNWSE: doGradNWSE(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdNESW: doGradNESW(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdSENW: doGradSENW(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdSWNE: doGradSWNE(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdURight: doGradURight(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdLNE: doGradLNE(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdLNW: doGradLNW(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdULeft: doGradULeft(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdUUp: doGradUUp(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdUDown: doGradUDown(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdRCMix: doGradRCMix(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdRCModulo: doGradRCModulo(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdQuatro: doGradQuatro(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdDuo:doGradDuo(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdUpDown:doGradUpDown(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
      jgdLeftRight:doGradLeftRight(swCanvas,
            RGBFromR,RGBFromG,RGBFromB,RGBDiffR,RGBDiffG,RGBDiffB,r);
   end;

   //恢复画笔的默认设置
   swCanvas.Pen.Style :=oldPenStyle;
   swCanvas.Pen.Mode :=oldPenMode;
   swCanvas.Brush.Style :=oldBrushStyle;
   swCanvas.Brush.Color :=oldBrushColor;
end;
procedure DoHorizCenter(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 := iWidth Div 2;
  ColorRect.Top := 0;
  ColorRect.Bottom := iHeight;
  for I := 0 to Haf do begin
    ColorRect.Left := MulDiv (I, Haf, Haf);
    ColorRect.Right := 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.Left := iWidth - (MulDiv (I, Haf, Haf));
    ColorRect.Right := iWidth - (MulDiv (I + 1, Haf, Haf));
    offsetRect(ColorRect,rt.Left,rt.Top);
    swCanvas.FillRect(ColorRect);
    offsetRect(colorRect,-rt.Left,-rt.Top);
  end;
end;
procedure DoRectangle(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;
  gra:Trect;
  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 rectangles 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
    gra:=Rect(Trunc(x1),Trunc(y1),Trunc(x2),Trunc(y2));