Как начертить hexagon?

procedure PlotPolygon(const Canvas: TCanvas; const N: Integer; const R: Single;
 const XC: Integer; const YC: Integer);
type
 TPolygon = array of TPoint;
var
 Polygon: TPolygon;
 I: Integer;
 C: Extended;
 S: Extended;
 A: Single;
begin
 SetLength(Polygon, N);
 A := 2 * Pi / N;
 for I := 0 to (N - 1) do
 begin
  SinCos(I * A, S, C);
  Polygon[I].X := XC + Round(R * C);
  Polygon[I].Y := YC + Round(R * S);
 end;
 Canvas.Polygon(Polygon);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 W: Single;
 H: Single;
 X: Integer;
 Y: Integer;
const
 N = 6;
 R = 10;
begin
 W := 1.5 * R;
 H := R * Sqrt(3);
 for X := 0 to Round(ClientWidth / W) do
  for Y := 0 to Round(ClientHeight / H) do
  if Odd(X) then
  PlotPolygon(Canvas, N, R, Round(X * W), Round((Y + 0.5) * H))
  else
  PlotPolygon(Canvas, N, R, Round(X * W), Round(Y * H));
end;

unit HexGrid;
interface
uses
 Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Math;
type
 TOrientation = (hxVertical, hxhorizontal);
 THexGrid = class(TCustomPanel)
 private
  FOrientation: TOrientation;
  FHexSize: Integer;
  FPoints: array[0..5] of TPoint;
  FDisplayCaption: Boolean;
  procedure ChangedDimensions;
  procedure SetOrientation(Value: TOrientation);
  procedure SetHexSize(const Value: Integer);
  procedure DrawVerticalGrid;
  procedure DrawhorizontalGrid;
  procedure SetDisplayCaption(Value: Boolean);
 protected
 public
  constructor Create(AOwner: TComponent); override;
  procedure Paint; override;
  property Orientation: TOrientation read FOrientation write SetOrientation;
 published
  property Align;
  property Alignment;
  property Anchors;
  property AutoSize;
  property BevelInner;
  property BevelOuter;
  property BevelWidth;
  property BiDiMode;
  property BorderWidth;
  property BorderStyle;
  property Caption;
  property Color;
  property Constraints;
  property Ctl3D;
  property UseDockManager default True;
  property DockSite;
  property DragCursor;
  property DragKind;
  property DragMode;
  property Enabled;
  property FullRepaint;
  property Font;
  property Locked;
  property ParentBiDiMode;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property TabOrder;
  property TabStop;
  property Visible;
  property OnCanResize;
  property OnClick;
  property OnConstrainedResize;
  property OnContextPopup;
  property OnDockDrop;
  property OnDockOver;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDock;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnGetSiteInfo;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnResize;
  property OnStartDock;
  property OnStartDrag;
  property OnUnDock;
  property Left;
  property ;
  property Width;
  property Height;
  property Cursor;
  property Hint;
  property HelpType;
  property HelpKeyword;
  property HelpContext;
  property HexSize: Integer read FHexSize write SetHexSize;
  property DisplayCaption: Boolean read FDisplayCaption write SetDisplayCaption;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Samples', [THexGrid]);
end;
procedure THexGrid.ChangedDimensions;
var
 I: Integer;
begin
 for I := 0 to High(FPoints) do
 begin
  FPoints[I].X := 0;
  FPoints[I].Y := 0;
 end;
 if Orientation = hxhorizontal then
 begin
  FPoints[0].X := Hexsize div 4;
  FPoints[1].X := HexSize - (Hexsize div 4);
  FPoints[2].X := HexSize;
  FPoints[2].Y := HexSize div 2;
  FPoints[3].X := HexSize - (Hexsize div 4);
  FPoints[3].Y := HexSize;
  FPoints[4].X := HexSize div 4;
  FPoints[4].Y := HexSize;
  FPoints[5].Y := HexSize div 2;
 end;
 if Orientation = hxVertical then
 begin
  FPoints[0].X := HexSize div 2;
  FPoints[1].X := HexSize;
  FPoints[1].Y := HexSize div 4;
  FPoints[2].X := HexSize;
  FPoints[2].Y := HexSize - (Hexsize div 4);
  FPoints[3].X := HexSize div 2;
  FPoints[3].Y := HexSize;
  FPoints[4].Y := HexSize - (Hexsize div 4);
  FPoints[5].Y := HexSize div 4;
 end;
end;
procedure THexGrid.SetOrientation(Value: TOrientation);
begin
 if FOrientation <> Value then
 begin
  FOrientation := Value;
  ChangedDimensions;
  invalidate;
 end;
end;
procedure THexGrid.SetHexSize(const Value: Integer);
begin
 if FHexSize <> Value then
 begin
  FHexSize := Value;
  ChangedDimensions;
  invalidate;
 end;
end;
constructor THexGrid.Create(AOwner: TComponent);
begin
 inherited;
 FOrientation := hxVertical;
 FHexSize := 64;
 ChangedDimensions;
 Width := 128;
 Height := 128;
end;
procedure THexGrid.Paint;
begin
 inherited;
 if Orientation = hxhorizontal then
  DrawhorizontalGrid
 else
  DrawVerticalGrid;
end;
procedure THexGrid.DrawhorizontalGrid;
var
 I: Integer;
 X, Y, Offset: Integer;
 FHex: array[0..5] of TPoint;
begin
 X := 0;
 Y := 0;
 Offset := 0;
 while X + HexSize < Width do
 begin
  Y := 0;
  while Y + HexSize < Height do
  begin
  with Self.Canvas do
  begin
  for I := 0 to High(FPoints) do
  begin
  FHex[I].X := X + FPoints[I].X;
  FHex[I].Y := Y + FPoints[I].Y + Offset;
  end;
  Polygon(FHex);
  end;
  Y := Y + HexSize;
  end;
  if Offset = 0 then
  Offset := (0 - (HexSize div 2))
  else
  Offset := 0;
  X := X + (HexSize - (HexSize div 4));
 end;
end;
procedure THexGrid.DrawVerticalGrid;
var
 I: Integer;
 X, Y, Offset: Integer;
 FHex: array[0..5] of TPoint;
begin
 X := 0;
 Y := 0;
 Offset := 0;
 while Y + HexSize < Height do
 begin
  X := 0;
  while X + HexSize < Width do
  begin
  with Self.Canvas do
  begin
  for I := 0 to High(FPoints) do
  begin
  FHex[I].X := X + FPoints[I].X + Offset;
  FHex[I].Y := Y + FPoints[I].Y;
  end;
  Polygon(FHex);
  end;
  X := X + HexSize;
  end;
  if Offset = 0 then
  Offset := (0 - (HexSize div 2))
  else
  Offset := 0;
  Y := Y + (HexSize - (HexSize div 4));
 end;
end;
procedure THexGrid.SetDisplayCaption(Value: Boolean);
begin
end;
end.

Взято с Delphi Knowledge Base: http://www.baltsoft.com/

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...