我有一个程序:
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;
答案 0 :(得分:2)
是的,请参阅我的第二条评论:Target.Brush.Bitmap
已设置。删除该行将防止平铺效果,但也将完全阻止绘制任何图像。为了弥补这一点,请使用以下内容:
Target.Draw(x, y, FillImage);
你可能不得不摆弄坐标。