janshape.pas

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

        poly[15]:=point(x+w8,y+h4);
        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;
   swCanvas.polygon(poly);
   end
   else
   swCanvas.polygon(poly);
end;

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

procedure TjanShape.DrawDiamond;
var
   rgn :Hrgn;
   poly: array[0..3] of TPoint;
   rpoly: array[0..3] of TPoint;
   i:integer;
begin
    case FShape of
       jstDiamond:
        begin
        poly[0]:=point(x+(w div 2),y);
        poly[1]:=point(x+w-1,y+(h div 2));
        poly[2]:=point(x+(w div 2),y+h-1);
        poly[3]:=point(x,y+(h div 2));
        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.DrawEllipse;
var
   rgn :Hrgn;
begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      SelectClipRgn(swCanvas.handle,rgn);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn);
     SetPenBrushForOutLine;
     swCanvas.Ellipse(X, Y, X + W, Y + H);
   end
   else
     swCanvas.Ellipse(X, Y, X + W, Y + H);
end;

procedure TjanShape.DrawBowl;
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);

   jstBowlLeft:
   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+W,swtop+Y+H);
      rgn2 := CreateRectRgn(swleft+x,swtop+Y,swleft+x+w2,swtop+Y+H);
      combineRgn(rgn0,rgn1,rgn2,RGN_AND);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.Pie(x,y,x+w,y+h,x+w2,y,x+w2,y+h);
   end
   else
     swCanvas.Pie(x,y,x+w,y+h,x+w2,y,x+w2,y+h);
   end;
   jstBowlRight:
   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+W,swtop+Y+H);
      rgn2 := CreateRectRgn(swleft+x+w2,swtop+Y,swleft+x+W,swtop+Y+H);
      combineRgn(rgn0,rgn1,rgn2,RGN_AND);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.Pie(x,y,x+w,y+h,x+w2,y+h,x+w2,y);
   end
   else
     swCanvas.Pie(x,y,x+w,y+h,x+w2,y+h,x+w2,y);
   end;
   jstBowlUp:
   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+W,swtop+Y+H);
      rgn2 := CreateRectRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H2);
      combineRgn(rgn0,rgn1,rgn2,RGN_AND);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.Pie(x,y,x+w,y+h,x+w,y+h2,x,y+h2);
   end
   else
     swCanvas.Pie(x,y,x+w,y+h,x+w,y+h2,x,y+h2);
   end;
   jstBowlDown:
   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+W,swtop+Y+H);
      rgn2 := CreateRectRgn(swleft+x,swtop+Y+h2,swleft+x+W,swtop+Y+H);
      combineRgn(rgn0,rgn1,rgn2,RGN_AND);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.Pie(x,y,x+w,y+h,x,y+h2,x+w,y+h2);
   end
   else
     swCanvas.Pie(x,y,x+w,y+h,x,y+h2,x+w,y+h2);
   end;

  end;
end;

procedure TjanShape.DrawCloud;
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);

   jstCloudLeft:
   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-W4,swtop+Yh-h4);
      rgn2 := CreateEllipticRgn(swleft+x+w4,swtop+Y+h4,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw-w4,yh-h4);
     swCanvas.ellipse(x+w4,y+h4,xw,yh);
   end
   else begin
     swCanvas.ellipse(x,y,xw-w4,yh-h4);
     swCanvas.ellipse(x+w4,y+h4,xw,yh);
     end;
   end;
   jstDoubleOval:
   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+w2,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x+w2,swtop+Y,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,x+w2,yh);
     swCanvas.ellipse(x+w2,y,xw,yh);
   end
   else begin
     swCanvas.ellipse(x,y,x+w2,yh);
     swCanvas.ellipse(x+w2,y,xw,yh);
     end;
   end;
   jstDoubleOvalV:
   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+Y+h2);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y+h2,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,y+h2);
     swCanvas.ellipse(x,y+h2,xw,yh);
   end
   else begin
     swCanvas.ellipse(x,y,xw,y+h2);
     swCanvas.ellipse(x,y+h2,xw,yh);
     end;
   end;
   jstCloudRight:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateEllipticRgn(swleft+x+w4,swtop+Y,swleft+xw,swtop+Yh-h4);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y+h4,swleft+xW-w4,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x+w4,y,xw,yh-h4);
     swCanvas.ellipse(x,y+h4,xw-w4,yh);
   end
   else begin
     swCanvas.ellipse(x+w4,y,xw,yh-h4);
     swCanvas.ellipse(x,y+h4,xw-w4,yh);
     end;
   end;
   end;
end;

procedure TjanShape.DrawPistache;
var
   rgn0,rgn1,rgn2 :Hrgn;
begin
   case FShape of
   jstPistacheTop:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x,swtop+Y+h2,swleft+xw,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y+h2,xw,yh);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y+h2,xw,yh);
     end;
   end;
   jstPistacheBottom:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x,swtop+Y,swleft+xw,swtop+Y+h2);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y,xw,y+h2);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y,xw,y+h2);
     end;
   end;
   jstPistacheLeft:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x+w2,swtop+Y,swleft+xw,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x+w2,y,xw,yh);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x+w2,y,xw,yh);
     end;
   end;
   jstPistacheRight:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x,swtop+Y,swleft+x+w2,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+xW,swtop+YH);
      combineRgn(rgn0,rgn1,rgn2,RGN_OR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;
      SelectClipRgn(swCanvas.handle,0);
      DeleteObject(rgn2);
      DeleteObject(rgn1);
      DeleteObject(rgn0);
     SetPenBrushForOutLine;
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y,x+w2,yh);
   end
   else begin
     swCanvas.ellipse(x,y,xw,yh);
     swCanvas.rectangle(x,y,x+w2,yh);
     end;
   end;
   end;
end;

procedure TjanShape.Draw1Hole;
var
   rgn0,rgn1,rgn2 :Hrgn;
begin
   case FShape of
   jst1Hole:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(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.rectangle(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h4,xw-w4,yh-h4);
   end
   else begin
     swCanvas.rectangle(x,y,xw,yh);
     swCanvas.ellipse(x+w4,y+h4,xw-w4,yh-h4);
     end;
   end;
   jst1HoleBig:
   begin
   if FGradient then begin
      SetPenBrushForGradient;
      rgn0 := CreateEllipticRgn(swleft+x,swtop+Y,swleft+x+W,swtop+Y+H);
      rgn1 := CreateRectRgn(swleft+x,swtop+Y,swleft+xw,swtop+Yh);
      rgn2 := CreateEllipticRgn(swleft+x+w8,swtop+Y+h8,swleft+xW-w8,swtop+YH-h8);
      combineRgn(rgn0,rgn1,rgn2,RGN_XOR);
      SelectClipRgn(swCanvas.handle,rgn0);
      FillWithGradient;