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/