从平铺中停止图像

时间:2012-07-04 02:04:57

标签: delphi

我有一个程序:

 procedure DrawSolidHexImage(Target: TCanvas;     { Canvas to draw hex on }
                         Fillstyle : TBrushStyle; { How to fill the hex }
                         Fillcolor : TColor;      { Color to fill it }
                         fillimage : Tbitmap;     { Image to show}
                         Linestyle : TPenStyle;   { What kind of lines }
                         LineColor : Tcolor;      { What color for lines }
                         x,y,radius: integer;     { Position and size of Hex }
                         button    : boolean);    { Make hexes look like buttons? }

当我使用它时,图像被平铺以填充该区域。有什么我可以添加或必须删除,使其不是瓷砖?因此不重复图像。也许让它成为中心?

{Solid Hexagon drawing function}
procedure THexMap.DrawSolidHeximage(Target:TCanvas;
                          Fillstyle : TBrushStyle;
                          Fillcolor : TColor;
                          Fillimage : TBitmap;
                          Linestyle : TPenStyle;
                          LineColor : Tcolor;
                          x,y,radius: integer;
                          button    : boolean);
 var
   p0,p1,p2,p3,p4,p5,p6:TPoint;
 Begin
   p0 := Point(x,y);

   {compute each point of hex based on center coordinate (p0) }
   p1.x := p0.x - round(Radius /2);
   p1.y := p0.y - Rise;
   p2.x := p0.x + round(Radius /2);
   p2.y := p1.y;
   p3.x := p0.x + Radius;
   p3.y := p0.y;
   p4.x := p2.x;
   p4.y := p0.y + rise;
   p5.x := p1.x;
   p5.y := p4.y;
   p6.x := p0.x - Radius;
   p6.y := p0.y;

   {set color / Style of lines}
   target.pen.color := linecolor;
   target.pen.style := linestyle;

   {Set color and style of hex }
   target.brush.color := FillColor;
   target.brush.style := FillStyle;
   target.Brush.Bitmap := Fillimage;

   {draw the hex}
   target.polygon([p1,p2,p3,p4,p5,p6]);

   {If Desired, draw the borders for the hex}
   if button = true then
   begin
     with target do
     begin
       pen.mode:=pmcopy;
       pen.color:=clWhite;
       moveto(p5.x+1,p5.y-1);
       lineto(p6.x+1,p6.y);
       lineto(p1.x+1,p1.y+1);
       lineto(p2.x-1,p2.y+1);
       pen.color:=clBlack;
       lineto(p3.x-1,p3.y);
       lineto(p4.x-1,p4.y-1);
       lineto(p5.x+1,p5.y-1);
     end;
   end;
 end;

1 个答案:

答案 0 :(得分:2)

是的,请参阅我的第二条评论:Target.Brush.Bitmap已设置。删除该行将防止平铺效果,但也将完全阻止绘制任何图像。为了弥补这一点,请使用以下内容:

Target.Draw(x, y, FillImage);

你可能不得不摆弄坐标。