Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007
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 Top;
    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: https://www.baltsoft.com/