janshape.pas

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

      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.rectangle(x,y,xw,yh);
     swCanvas.ellipse(x+w8,y+h8,xw-w8,yh-h8);
   end
   else begin
     swCanvas.rectangle(x,y,xw,yh);
     swCanvas.ellipse(x+w8,y+h8,xw-w8,yh-h8);
     end;
   end;
   end;
end;


procedure TjanShape.Draw2Hole;
var
   rgn0,rgn1,rgn2,rgn3,rgn4 :Hrgn;
begin
   case FShape of
//       jstBowlLeft: Pie(x,y,x+w,y+h,x+w2,y,x+w2,y+h);
//       jstBowlRight: Pie(x,y,x+w,y+h,x+w2,y+h,x+w2,y);
//       jstBowlDown: Pie(x,y,x+w,y+h,x,y+h2,x+w,y+h2);
//       jstBowlUp: Pie(x,y,x+w,y+h,x+w,y+h2,x,y+h2);

   jst2HoleHoriz:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+Xw,swtop+YH);
      rgn2 := CreateEllipticRgn(swleft+x+w8,swtop+Y+h4,swleft+x+w2-w8,swtop+YH-h4);
      combineRgn(rgn0,rgn1,rgn2,RGN_XOR);
      rgn4 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn3 := CreateEllipticRgn(swleft+x+w2+w8,swtop+Y+h4,swleft+xw-w8,swtop+YH-h4);
      combineRgn(rgn4,rgn0,rgn3,RGN_XOR);
      SelectClipRgn(swCanvas.handle,rgn4);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn4);
      DeleteObject(rgn3);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w8,y+h4,x+w2-w8,yh-h4);
     swCanvas.ellipse(x+w2+w8,y+h4,xw-w8,yh-h4);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w8,y+h4,x+w2-w8,yh-h4);
     swCanvas.ellipse(x+w2+w8,y+h4,xw-w8,yh-h4);
     end;
   end;
   jst2HoleVert:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+Xw,swtop+YH);
      rgn2 := CreateEllipticRgn(swleft+x+w4,swtop+Y+h8,swleft+xw-w4,swtop+Y+h2-h8);
      combineRgn(rgn0,rgn1,rgn2,RGN_XOR);
      rgn4 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn3 := CreateEllipticRgn(swleft+x+w4,swtop+Y+h2+h8,swleft+xw-w4,swtop+YH-h8);
      combineRgn(rgn4,rgn0,rgn3,RGN_XOR);
      SelectClipRgn(swCanvas.handle,rgn4);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn4);
      DeleteObject(rgn3);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h8,xw-w4,y+h2-h8);
     swCanvas.ellipse(x+w4,y+h2+h8,xw-w4,yh-h8);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h8,xw-w4,y+h2-h8);
     swCanvas.ellipse(x+w4,y+h2+h8,xw-w4,yh-h8);
     end;
   end;
   end;
end;

procedure TjanShape.Drawflower;
var
   rgn0,rgn1,rgn2,rgn3,rgn4 :Hrgn;
begin
   case FShape of
   jstflower:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateEllipticRgn(swleft+x,swtop+Y+h3,swleft+x+w2,swtop+YH-h3);
      rgn2 := CreateEllipticRgn(swleft+x+w3,swtop+Y,swleft+x+xw-w3,swtop+Y+h2);
      rgn3 := CreateEllipticRgn(swleft+x+w2,swtop+Y+h3,swleft+xw,swtop+YH-h3);
      rgn4 := CreateEllipticRgn(swleft+x+w3,swtop+Y+h2,swleft+xw-w3,swtop+Y+H);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      combineRgn(rgn0,rgn0,rgn3,RGN_OR);
      combineRgn(rgn0,rgn0,rgn4,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn4);
      DeleteObject(rgn3);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y+h3,x+w2,yh-h3);
     swCanvas.ellipse(x+w3,y,xw-w3,y+h2);
     swCanvas.ellipse(x+w2,y+h3,xw,yh-h3);
     swCanvas.ellipse(x+w3,y+h2,xw-w3,yh);
   end
   else begin
     swCanvas.ellipse(x,y+h3,x+w2,yh-h3);
     swCanvas.ellipse(x+w3,y,xw-w3,y+h2);
     swCanvas.ellipse(x+w2,y+h3,xw,yh-h3);
     swCanvas.ellipse(x+w3,y+h2,xw-w3,yh);
     end;
   end;
  end;
end;


procedure TjanShape.DrawTorus;
var
   rgn0,rgn1,rgn2 :Hrgn;
begin
   case FShape of
//       jstBowlLeft: Pie(x,y,x+w,y+h,x+w2,y,x+w2,y+h);
//       jstBowlRight: Pie(x,y,x+w,y+h,x+w2,y+h,x+w2,y);
//       jstBowlDown: Pie(x,y,x+w,y+h,x,y+h2,x+w,y+h2);
//       jstBowlUp: Pie(x,y,x+w,y+h,x+w,y+h2,x,y+h2);

   jstTorus:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+xw,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x+w4,swtop+Y+h4,swleft+xW-w4,swtop+YH-h4);
      combineRgn(rgn0,rgn1,rgn2,RGN_XOR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h4,xw-w4,yh-h4);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h4,xw-w4,yh-h4);
     end;
   end;
   end;
end;

procedure TjanShape.DrawFrame;
var
   rgn0,rgn1,rgn2 :Hrgn;
   dw,dh:integer;
begin
   case Fshape of
    jstFrame: begin dw:=w4;dh:=h4;end;
    jstFrameNarrow: begin dw:=w8;dh:=h8;end;
    end;
   case FShape of
//       jstBowlLeft: Pie(x,y,x+w,y+h,x+w2,y,x+w2,y+h);
//       jstBowlRight: Pie(x,y,x+w,y+h,x+w2,y+h,x+w2,y);
//       jstBowlDown: Pie(x,y,x+w,y+h,x,y+h2,x+w,y+h2);
//       jstBowlUp: Pie(x,y,x+w,y+h,x+w,y+h2,x,y+h2);

   jstFrame,jstFrameNarrow:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateRectRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x,swtop+Y,swleft+xw,swtop+Yh);
      rgn2 := CreateRectRgn(swleft+x+dw,swtop+Y+dh,swleft+xW-dw,swtop+YH-dh);
      combineRgn(rgn0,rgn1,rgn2,RGN_XOR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.rectangle(x,y,xw,yh);
     swCanvas.rectangle(x+dw,y+dh,xw-dw,yh-dh);
   end
   else begin
     swCanvas.rectangle(x,y,xw,yh);
     swCanvas.rectangle(x+dw,y+dh,xw-dw,yh-dh);
     end;
   end;
   end;
end;

procedure TjanShape.DrawRectangle;
var
   rgn :Hrgn;
begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn := CreateRectRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      SelectClipRgn(swCanvas.handle,rgn);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn);
     SetPenBrushForOutLine;
     swCanvas.Rectangle(X, Y, X + W, Y + H);
   end
   else
     swCanvas.Rectangle(X, Y, X + W, Y + H);
end;

procedure TjanShape.DrawRoundRect;
var
   rgn :Hrgn;
begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn := CreateRoundRectRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H,S div 4, S div 4);
      SelectClipRgn(swCanvas.handle,rgn);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn);
     SetPenBrushForOutLine;
     swCanvas.RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
   end
   else
     swCanvas.RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
end;


procedure TjanShape.DrawUBar;
var
   rgn :Hrgn;
   poly: array[0..7] of TPoint;
   rpoly: array[0..7] of TPoint;
   i:integer;
begin
    case FShape of
       jstUBarUp:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh);
        poly[2]:=point(xw,yh);
        poly[3]:=point(xw,y);
        poly[4]:=point(xw-w4,y);
        poly[5]:=point(xw-w4,yh-h4);
        poly[6]:=point(x+w4,yh-h4);
        poly[7]:=point(x+w4,y);
        end;
       jstUBarLeft:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y);
        poly[2]:=point(xw,yh);
        poly[3]:=point(x,yh);
        poly[4]:=point(x,yh-h4);
        poly[5]:=point(xw-w4,yh-h4);
        poly[6]:=point(xw-w4,y+h4);
        poly[7]:=point(x,y+h4);
        end;
       jstUBarDown:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh);
        poly[2]:=point(x+w4,yh);
        poly[3]:=point(x+w4,y+h4);
        poly[4]:=point(xw-w4,y+h4);
        poly[5]:=point(xw-w4,yh);
        poly[6]:=point(xw,yh);
        poly[7]:=point(xw,y);
        end;
       jstUBarRight:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh);
        poly[2]:=point(xw,yh);
        poly[3]:=point(xw,yh-h4);
        poly[4]:=point(x+w4,yh-h4);
        poly[5]:=point(x+w4,y+h4);
        poly[6]:=point(xw,y+h4);
        poly[7]:=point(xw,y);
        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.DrawIBar;
var
   rgn :Hrgn;
   poly: array[0..11] of TPoint;
   rpoly: array[0..11] of TPoint;
   i:integer;
begin
    case FShape of
       jstIBar:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y);
        poly[2]:=point(xw,y+h4);
        poly[3]:=point(xw-w4,y+h4);
        poly[4]:=point(xw-w4,yh-h4);
        poly[5]:=point(xw,yh-h4);
        poly[6]:=point(xw,yh);
        poly[7]:=point(x,yh);
        poly[8]:=point(x,yh-h4);
        poly[9]:=point(x+w4,yh-h4);
        poly[10]:=point(x+w4,y+h4);
        poly[11]:=point(x,y+h4);
        end;
       jstHBar:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x+w4,y);
        poly[2]:=point(x+w4,y+h4);
        poly[3]:=point(xw-h4,y+h4);
        poly[4]:=point(xw-h4,y);
        poly[5]:=point(xw,y);
        poly[6]:=point(xw,yh);
        poly[7]:=point(xw-w4,yh);
        poly[8]:=point(xw-w4,yh-h4);
        poly[9]:=point(x+w4,yh-h4);
        poly[10]:=point(x+w4,yh);
        poly[11]:=point(x,yh);
        end;
       end;
    for i := 0 to 11 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,12,WINDING);
   SelectClipRgn(swCanvas.handle,rgn);
   FillWithGradient;
   SelectClipRgn(swCanvas.handle,0);
   DeleteObject(rgn);
   SetPenBrushForOutLine;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;

procedure TjanShape.DrawLBar;
var
   rgn :Hrgn;
   poly: array[0..5] of TPoint;
   rpoly: array[0..5] of TPoint;
   i:integer;
begin
    case FShape of
       jstLBarLeft:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(x,yh);
        poly[2]:=point(xw,yh);
        poly[3]:=point(xw,yh-h4);
        poly[4]:=point(x+w4,yh-h4);
        poly[5]:=point(x+w4,y);
        end;
       jstLBarRight:
        begin
        poly[0]:=point(xw,y);
        poly[1]:=point(xw,yh);
        poly[2]:=point(x,yh);
        poly[3]:=point(x,yh-h4);
        poly[4]:=point(xw-h4,yh-h4);
        poly[5]:=point(xw-h4,y);
        end;
       jstLBarUpLeft:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y);
        poly[2]:=point(xw,y+h4);
        poly[3]:=point(x+w4,y+h4);
        poly[4]:=point(x+w4,yh);
        poly[5]:=point(x,yh);
        end;
       jstLBarUpRight:
        begin
        poly[0]:=point(x,y);
        poly[1]:=point(xw,y);
        poly[2]:=point(xw,yh);
        poly[3]:=point(xw-h4,yh);
        poly[4]:=point(xw-h4,y+h4);
        poly[5]:=point(x,y+h4);
        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.FillWithGradient;
var
  TargetRect : TRect;
  i         : Integ