⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 janshape.pas

📁 delphi语言开发的矢量图形处理对象
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   setlength(poly,UserPoints);
   for i:=0 to UserPoints-1 do
   begin
    poly[i].x:=x+round(UserVector[i].x * (xw-x));
    poly[i].y:=y+round(UserVector[i].y * (yh-y));
   end;
    for i := 0 to UserPoints-1 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if (not FPolyLineMode) and FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,UserPoints,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else if FPolyLineMode then
     swCanvas.Polyline (poly)
   else
     swCanvas.polygon(poly);
end;

procedure TjanShape.StyleChanged(Sender: TObject);
begin
  Invalidate;

end;

procedure TjanShape.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TjanShape.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TjanShape.SetShape(Value: TjanShapeType);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Invalidate;

  end;
end;

procedure TjanShape.DrawTriangle;
var
   rgn :Hrgn;
   poly: array[0..2] of TPoint;
   rpoly: array[0..2] of TPoint;
   i:integer;
begin
    case FShape of
       jstTriangleRight:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y+h2);
        poly[2]:=point(x,yh);
        end;
       jstTriangleUp:
        begin
        poly[0]:=point(x+w2,y);
        poly[1]:=point(xw,yh);
        poly[2]:=point(x,yh);
        end;
       jstTriangleLeft:
        begin
        poly[0]:=point(xw,y);
        poly[1]:=point(xw,yh);
        poly[2]:=point(x,y+h2);
        end;
       jstTriangleDown:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y);
        poly[2]:=point(x+w2,yh);
        end;
       end;
    for i := 0 to 2 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,3,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(slice(poly,3));
   end
   else
   swCanvas.polygon(slice(poly,3));
end;

procedure TjanShape.DrawArrow;
var
   rgn :Hrgn;
   poly: array[0..6] of TPoint;
   rpoly: array[0..6] of TPoint;
   i:integer;

begin
    case FShape of
       jstArrowRight:
        begin
        poly[0]:=point(x,y+(h div 2)-(h div 16));
        poly[1]:=point(x+w-1-(w div 4),y+(h div 2)-(h div 16));
        poly[2]:=point(x+w-1-(w div 4),y);
        poly[3]:=point(x+w-1,y+(h div 2));
        poly[4]:=point(x+w-1-(w div 4),y+h-1);
        poly[5]:=point(x+w-1-(w div 4),y+(h div 2)+(h div 16));
        poly[6]:=point(x,y+(h div 2)+(h div 16));
        end;
       jstArrowLeft:
        begin
        poly[0]:=point(x+w-1,y+(h div 2)-(h div 16));
        poly[1]:=point(x+(w div 4),y+(h div 2)-(h div 16));
        poly[2]:=point(x+(w div 4),y);
        poly[3]:=point(x,y+(h div 2));
        poly[4]:=point(x+(w div 4),y+h-1);
        poly[5]:=point(x+(w div 4),y+(h div 2)+(h div 16));
        poly[6]:=point(x+w-1,y+(h div 2)+(h div 16));
        end;
       jstArrowUp:
        begin
        poly[0]:=point(x+(w div 2)-(w div 16),y+h-1);
        poly[1]:=point(x+(w div 2)-(w div 16),y+(h div 4));
        poly[2]:=point(x,y+(h div 4));
        poly[3]:=point(x+(w div 2),y);
        poly[4]:=point(x+w-1,y+(h div 4));
        poly[5]:=point(x+(w div 2)+(w div 16),y+(h div 4));
        poly[6]:=point(x+(w div 2)+(w div 16),y+h-1);
        end;
       jstArrowDown:
        begin
        poly[0]:=point(x+(w div 2)-(w div 16),y);
        poly[1]:=point(x+(w div 2)-(w div 16),y+h-1-(h div 4));
        poly[2]:=point(x,y+h-1-(h div 4));
        poly[3]:=point(x+(w div 2),y+h-1);
        poly[4]:=point(x+w-1,y+h-1-(h div 4));
        poly[5]:=point(x+(w div 2)+(w div 16),y+h-1-(h div 4));
        poly[6]:=point(x+(w div 2)+(w div 16),y);
        end;
       jstFatArrowRight:
        begin
        poly[0]:=point(x,y+h8);
        poly[1]:=point(xw-w8,y+h8);
        poly[2]:=point(xw-w8,y);
        poly[3]:=point(xw,y+h2);
        poly[4]:=point(xw-w8,yh);
        poly[5]:=point(xw-w8,yh-h8);
        poly[6]:=point(x,yh-h8);
        end;
       jstFatArrowLeft:
        begin
        poly[0]:=point(xw,y+h8);
        poly[1]:=point(x+w8,y+h8);
        poly[2]:=point(x+w8,y);
        poly[3]:=point(x,y+h2);
        poly[4]:=point(x+w8,yh);
        poly[5]:=point(x+w8,yh-h8);
        poly[6]:=point(xw,yh-h8);
        end;
       jstFatArrowUp:
        begin
        poly[0]:=point(x+w8,yh);
        poly[1]:=point(x+w8,y+h8);
        poly[2]:=point(x,y+h8);
        poly[3]:=point(x+w2,y);
        poly[4]:=point(xw,y+h8);
        poly[5]:=point(xw-w8,y+h8);
        poly[6]:=point(xw-w8,yh);
        end;
       jstFatArrowDown:
        begin
        poly[0]:=point(x+w8,y);
        poly[1]:=point(x+w8,yh-h8);
        poly[2]:=point(x,yh-h8);
        poly[3]:=point(x+w2,yh);
        poly[4]:=point(xw,yh-h8);
        poly[5]:=point(xw-w8,yh-h8);
        poly[6]:=point(xw-w8,y);
        end;
       end;
    for i := 0 to 6 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,7,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawChair;
var
   rgn :Hrgn;
   poly: array[0..9] of TPoint;
   rpoly: array[0..9] of TPoint;
   i:integer;
begin
    case FShape of
       jstChairLeft:
        begin
        poly[0]:=point(xw,y);
        poly[1]:=point(xw-w4,y);
        poly[2]:=point(xw-w4,y+h2);
        poly[3]:=point(x,y+h2);
        poly[4]:=point(x,yh);
        poly[5]:=point(x+w4,yh);
        poly[6]:=point(x+w4,yh-h4);
        poly[7]:=point(xw-w4,yh-h4);
        poly[8]:=point(xw-w4,yh);
        poly[9]:=point(xw,yh);
        end;
       jstChairRight:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x+w4,y);
        poly[2]:=point(x+w4,y+h2);
        poly[3]:=point(xw,y+h2);
        poly[4]:=point(xw,yh);
        poly[5]:=point(xw-w4,yh);
        poly[6]:=point(xw-w4,yh-h4);
        poly[7]:=point(x+w4,yh-h4);
        poly[8]:=point(x+w4,yh);
        poly[9]:=point(x,yh);
        end;
       jstArrowUpDown:
        begin
        poly[0]:=point(x+w2,y);
        poly[1]:=point(x,y+h8);
        poly[2]:=point(x+w8,y+h8);
        poly[3]:=point(x+w8,yh-h8);
        poly[4]:=point(x,yh-h8);
        poly[5]:=point(x+w2,yh);
        poly[6]:=point(xw,yh-h8);
        poly[7]:=point(xw-w8,yh-h8);
        poly[8]:=point(xw-w8,y+h8);
        poly[9]:=point(xw,y+h8);
        end;
       jstArrowleftRight:
        begin
        poly[0]:=point(x,y+h2);
        poly[1]:=point(x+w8,yh);
        poly[2]:=point(x+w8,yh-h8);
        poly[3]:=point(xw-w8,yh-h8);
        poly[4]:=point(xw-w8,yh);
        poly[5]:=point(xw,y+h2);
        poly[6]:=point(xw-w8,y);
        poly[7]:=point(xw-w8,y+h8);
        poly[8]:=point(x+w8,y+h8);
        poly[9]:=point(x+w8,y);
        end;
       end;
    for i := 0 to 9 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,10,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawValve;
var
   rgn :Hrgn;
   poly: array[0..3] of TPoint;
   rpoly: array[0..3] of TPoint;
   i:integer;
begin
    case FShape of
      jstValve:
        begin
         poly[0]:=point(x,y);
         poly[1]:=point(xw,yh);
         poly[2]:=point(xw,y);
         poly[3]:=point(x,yh);
        end;
      jstValveUp:
        begin
         poly[0]:=point(x,y);
         poly[1]:=point(xw,y);
         poly[2]:=point(x,yh);
         poly[3]:=point(xw,yh);
        end;
       end;
    for i := 0 to 3 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,4,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;


procedure TjanShape.DrawOctagon;
var
   rgn :Hrgn;
   poly: array[0..7] of TPoint;
   rpoly: array[0..7] of TPoint;
   i:integer;
begin
    case FShape of
       jstOctagon:
        begin
        poly[0]:=point(x+(w div 3),y);
        poly[1]:=point(x+w-1-(w div 3),y);
        poly[2]:=point(x+w-1,y+(h div 3));
        poly[3]:=point(x+w-1,y+h-1-(h div 3));
        poly[4]:=point(x+w-1-(w div 3),y+h-1);
        poly[5]:=point(x+(w div 3),y+h-1);
        poly[6]:=point(x,y+h-1-(h div 3));
        poly[7]:=point(x,y+(h div 3));
        end;
       jst4Point:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x+w2,y+h4);
        poly[2]:=point(xw,y);
        poly[3]:=point(xw-w4,y+h2);
        poly[4]:=point(xw,yh);
        poly[5]:=point(x+w2,yh-h4);
        poly[6]:=point(x,yh);
        poly[7]:=point(x+w4,y+h2);
        end;
       end;
    for i := 0 to 7 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,8,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawCube;
var
   rgn :Hrgn;
   poly: array[0..11] of TPoint;
   rpoly: array[0..5] of TPoint;
   i:integer;
begin
    case FShape of
       jstCubeUpRight:
        begin
        poly[0]:=point(x,yh);
        poly[1]:=point(xw-w3,yh);
        poly[2]:=point(xw,yh-h3);
        poly[3]:=point(xw,y);
        poly[4]:=point(x+w3,y);
        poly[5]:=point(x,y+h3);
        end;
       jstCubeHalf:
        begin
        poly[0]:=point(x,yh);
        poly[1]:=point(xw-w3,yh);
        poly[2]:=point(xw,yh-h3);
        poly[3]:=point(xw,yh-h3-h3);
        poly[4]:=point(x+w3,yh-h3-h3);
        poly[5]:=point(x,yh-h3);
        end;
       jstCubeUpLeft:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh-h3);
        poly[2]:=point(x+w3,yh);
        poly[3]:=point(xw,yh);
        poly[4]:=point(xw,y+h3);
        poly[5]:=point(xw-w3,y);
        end;
       jstCubeDownLeft:
        begin
        poly[0]:=point(x,y+h3);
        poly[1]:=point(x,yh);
        poly[2]:=point(xw-w3,yh);
        poly[3]:=point(xw,yh-h3);
        poly[4]:=point(xw,y);
        poly[5]:=point(x+w3,y);
        end;
       jstCubeDownRight:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh-h3);
        poly[2]:=point(x+w3,yh);
        poly[3]:=point(xw,yh);
        poly[4]:=point(xw,y+h3);
        poly[5]:=point(xw-w3,y);
        end;
       end;
    for i := 0 to 5 do
    begin
       rpoly[i].x := swleft+poly[i].x;
       rpoly[i].y := swtop+poly[i].y;
    end;
   if FGradient then begin
   SetPenBrushForGradient;
   rgn :=  Winprocs.CreatePolygonRgn(rpoly,6,WINDING);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -