janshape.pas

更好用的 shape 控件 delphi 3.0, 4.0, 5.0, 6.0, 7.0 適用

   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   end;
    case FShape of
       jstCubeUpRight:
        begin
        poly[0]:=point(xw-w3,y+h3);
        poly[1]:=point(x,y+h3);
        poly[2]:=point(x,yh);
        poly[3]:=point(xw-w3,yh);
        poly[4]:=point(xw-w3,y+h3);
        poly[5]:=point(xw,y);
        poly[6]:=point(xw,yh-h3);
        poly[7]:=point(xw-w3,yh);
        poly[8]:=point(xw-w3,y+h3);
        poly[9]:=point(x,y+h3);
        poly[10]:=point(x+w3,y);
        poly[11]:=point(xw,y);
        end;
       jstCubeHalf:
        begin
        poly[0]:=point(xw-w3,yh-h3);
        poly[1]:=point(x,yh-h3);
        poly[2]:=point(x,yh);
        poly[3]:=point(xw-w3,yh);
        poly[4]:=point(xw-w3,yh-h3);
        poly[5]:=point(xw,yh-h3-h3);
        poly[6]:=point(xw,yh-h3);
        poly[7]:=point(xw-w3,yh);
        poly[8]:=point(xw-w3,yh-h3);
        poly[9]:=point(x,yh-h3);
        poly[10]:=point(x+w3,yh-h3-h3);
        poly[11]:=point(xw,yh-h3-h3);
        end;
       jstCubeUpLeft:
        begin
        poly[0]:=point(x+w3,y+h3);
        poly[1]:=point(xw,y+h3);
        poly[2]:=point(xw,yh);
        poly[3]:=point(x+w3,yh);
        poly[4]:=point(x+w3,y+h3);
        poly[5]:=point(x,y);
        poly[6]:=point(x,yh-h3);
        poly[7]:=point(x+w3,yh);
        poly[8]:=point(x+w3,y+h3);
        poly[9]:=point(xw,y+h3);
        poly[10]:=point(xw-w3,y);
        poly[11]:=point(x,y);
        end;
       jstCubeDownLeft:
        begin
        poly[0]:=point(x+w3,yh-h3);
        poly[1]:=point(xw,yh-h3);
        poly[2]:=point(xw,y);
        poly[3]:=point(x+w3,y);
        poly[4]:=point(x+w3,yh-h3);
        poly[5]:=point(x+w3,y);
        poly[6]:=point(x,y+h3);
        poly[7]:=point(x,yh);
        poly[8]:=point(x+w3,yh-h3);
        poly[9]:=point(xw,yh-h3);
        poly[10]:=point(xw-w3,yh);
        poly[11]:=point(x,yh);
        end;
       jstCubeDownRight:
        begin
        poly[0]:=point(xw-w3,yh-h3);
        poly[1]:=point(x,yh-h3);
        poly[2]:=point(x,y);
        poly[3]:=point(xw-w3,y);
        poly[4]:=point(xw-w3,yh-h3);
        poly[5]:=point(xw-w3,y);
        poly[6]:=point(xw,y+h3);
        poly[7]:=point(xw,yh);
        poly[8]:=point(xw-w3,yh-h3);
        poly[9]:=point(x,yh-h3);
        poly[10]:=point(x+w3,yh);
        poly[11]:=point(xw,yh);
        end;
       end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawRoof;
var
   rgn :Hrgn;
   poly: array[0..6] of TPoint;
   rpoly: array[0..4] of TPoint;
   i:integer;
begin
    case FShape of
       jstRoofFront:
        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);
        end;
       jstRoofBack:
        begin
        poly[0]:=point(x,yh);
        poly[1]:=point(xw-w3,yh);
        poly[2]:=point(xw,yh-h3);
        poly[3]:=point(xw-w3,y);
        poly[4]:=point(x,y);
        end;
       jstRoofLeft:
        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(x+w3,y);
        end;
       jstRoofRight:
        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(xw-w3,y+h3);
        end;
       end;
    for i := 0 to 4 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,5,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   end;
    case FShape of
       jstRoofFront:
        begin
        poly[0]:=point(xw-w3,yh);
        poly[1]:=point(xw,y);
        poly[2]:=point(x+w3,y);
        poly[3]:=point(x,yh);
        poly[4]:=point(xw-w3,yh);
        poly[5]:=point(xw,yh-h3);
        poly[6]:=point(xw,y);
        end;
       jstRoofBack:
        begin
        poly[0]:=point(xw-w3,yh);
        poly[1]:=point(xw-w3,y);
        poly[2]:=point(x,y);
        poly[3]:=point(x,yh);
        poly[4]:=point(xw-w3,yh);
        poly[5]:=point(xw,yh-h3);
        poly[6]:=point(xw-w3,y);
        end;
       jstRoofLeft:
        begin
        poly[0]:=point(x,y+h3);
        poly[1]:=point(x,yh);
        poly[2]:=point(xw-w3,yh);
        poly[3]:=point(x,y+h3);
        poly[4]:=point(x+w3,y);
        poly[5]:=point(xw,yh-h3);
        poly[6]:=point(xw-w3,yh);
        end;
       jstRoofRight:
        begin
        poly[0]:=point(xw-w3,yh);
        poly[1]:=point(xw-w3,y+h3);
        poly[2]:=point(x,yh);
        poly[3]:=point(xw-w3,yh);
        poly[4]:=point(xw,yh-h3);
        poly[5]:=point(xw,y);
        poly[6]:=point(xw-w3,y+h3);
        end;
       end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawPyramid;
var
   rgn :Hrgn;
   poly: array[0..5] of TPoint;
   rpoly: array[0..3] of TPoint;
   i:integer;
begin
    case FShape of
       jstPyramid:
        begin
        poly[0]:=point(x,yh);
        poly[1]:=point(xw-w3,yh);
        poly[2]:=point(xw,yh-h3);
        poly[3]:=point(x+w2,y);
        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;
   end;
    case FShape of
       jstPyramid:
        begin
        poly[0]:=point(xw-w3,yh);
        poly[1]:=point(x+w2,y);
        poly[2]:=point(x,yh);
        poly[3]:=point(xw-w3,yh);
        poly[4]:=point(xw,yh-h3);
        poly[5]:=point(x+w2,y);
        end;
       end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawMoret;
var
   rgn :Hrgn;
   poly: array[0..19] of TPoint;
   rpoly: array[0..19] of TPoint;
   i:integer;
begin
    case FShape of
       jstMoret:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,y+h4);
        poly[2]:=point(x+w8,y+h4);
        poly[3]:=point(x+w8,yh-h4);
        poly[4]:=point(x,yh-h4);
        poly[5]:=point(x,yh);
        poly[6]:=point(x+w4,yh);
        poly[7]:=point(x+w4,yh-h8);
        poly[8]:=point(xw-w4,yh-h8);
        poly[9]:=point(xw-w4,yh);
        poly[10]:=point(xw,yh);
        poly[11]:=point(xw,yh-h4);
        poly[12]:=point(xw-w8,yh-h4);
        poly[13]:=point(xw-w8,y+h4);
        poly[14]:=point(xw,y+h4);
        poly[15]:=point(xw,y);
        poly[16]:=point(xw-w4,y);
        poly[17]:=point(xw-w4,y+h8);
        poly[18]:=point(x+w4,y+h8);
        poly[19]:=point(x+w4,y);
        end;
       end;
    for i := 0 to 19 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,20,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawZ;
var
   rgn :Hrgn;
   poly: array[0..9] of TPoint;
   rpoly: array[0..9] of TPoint;
   i:integer;
begin
    case FShape of
       jstZ:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,y+h4);
        poly[2]:=point(xw-w3,y+h4);
        poly[3]:=point(x,yh-h4);
        poly[4]:=point(x,yh);
        poly[5]:=point(xw,yh);
        poly[6]:=point(xw,yh-h4);
        poly[7]:=point(x+w3,yh-h4);
        poly[8]:=point(xw,y+h4);
        poly[9]:=point(xw,y);
        end;
       jstN:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh);
        poly[2]:=point(x+w4,yh);
        poly[3]:=point(x+w4,y+h3);
        poly[4]:=point(xw-w4,yh);
        poly[5]:=point(xw,yh);
        poly[6]:=point(xw,y);
        poly[7]:=point(xw-w4,y);
        poly[8]:=point(xw-w4,yh-h3);
        poly[9]:=point(x+w4,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;
   end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawMatta;
var
   rgn :Hrgn;
   poly: array[0..15] of TPoint;
   rpoly: array[0..15] of TPoint;
   i:integer;
begin
    case FShape of
       jstMatta:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,y+h4);
        poly[2]:=point(x+w2,y+h2);
        poly[3]:=point(x,yh-h4);
        poly[4]:=point(x,yh);
        poly[5]:=point(x+w4,yh);
        poly[6]:=point(x+w2,y+h2);
        poly[7]:=point(xw-w4,yh);
        poly[8]:=point(xw,yh);
        poly[9]:=point(xw,yh-h4);
        poly[10]:=point(x+w2,y+h2);
        poly[11]:=point(xw,y+h4);
        poly[12]:=point(xw,y);
        poly[13]:=point(xw-w4,y);
        poly[14]:=point(x+w2,y+h2);
        poly[15]:=point(x+w4,y);
        end;
       end;
    for i := 0 to 15 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,16,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   end;
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawHexagon;
var
   rgn :Hrgn;
   poly: array[0..5] of TPoint;
   rpoly: array[0..5] of TPoint;
   i:integer;
begin
    case FShape of
       jstHexagon:
        begin
        poly[0]:=point(x+w2,y);
        poly[1]:=point(xw,y+h4);
        poly[2]:=point(xw,yh-h4);
        poly[3]:=point(x+w2,yh);
        poly[4]:=point(x,yh-h4);
        poly[5]:=point(x,y+h4);
        end;
       jstHexagonFlat:
        begin
        poly[0]:=point(x+w4,y);
        poly[1]:=point(xw-w4,y);
        poly[2]:=point(xw,y+h2);
        poly[3]:=point(xw-w4,yh);
        poly[4]:=point(x+w4,yh);
        poly[5]:=point(x,y+h2);
        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);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;


procedure TjanShape.DrawWaggle;
var
   rgn :Hrgn;
   poly: array[0..15] of TPoint;
   rpoly: array[0..15] of TPoint;
   i:integer;
begin
    case FShape of
       jstWaggle:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x+w4,y+h8);
        poly[2]:=point(x+w2,y);
        poly[3]:=point(xw-w4,y+h8);
        poly[4]:=point(xw,y);
        poly[5]:=point(xw-w8,y+h4);
        poly[6]:=point(xw,y+h2);
        poly[7]:=point(xw-w8,yh-h4);
        poly[8]:=point(xw,yh);
        poly[9]:=point(xw-w4,yh-h8);
        poly[10]:=point(x+w2,yh);
        poly[11]:=point(x+w4,yh-h8);
        poly[12]:=point(x,yh);
        poly[13]:=point(x+w8,yh-h4);
        poly[14]:=point(x,y+h2);