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

Previous  Top  Next

    
 

 

 

Code:

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;

©Drkb::03906

 


 

Code:

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.

 

 

©Drkb::03907

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