Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program Meh;
- var
- frmMain: TForm;
- imgBoard: TImage;
- const
- debug = True;
- procedure Write(v: TVariantArray);
- var
- i: Integer;
- s: string;
- begin
- if debug <> True then
- exit;
- if High(v) < 0 then
- exit;
- for i := 0 to High(v) do
- s := s + v[i];
- Writeln(s);
- end;
- procedure DrawHexagons(var img: TImage; wl, hl: Integer);
- var
- a, b, t, bg, ws, hs: Integer;
- p: TPointArray;
- tmp: TCanvas;
- begin
- ws := (img.Width - 1) / wl;
- hs := (img.Height - 1) / hl;
- bg := BitmapFromString(img.Width, img.Height, '');
- t := BitmapFromString(ws, hs, '');
- tmp := GetBitmapCanvas(t);
- FastDrawClear(t, clWhite);
- FastDrawClear(bg, clWhite);
- with tmp do
- begin
- Pen.Color := clBlack;
- Brush.Color := clWhite;
- SetLength(p, 7);
- p[0].x := 0;
- p[0].y := hs / 4;
- p[1].x := 0;
- p[1].y := (hs * 2) / 4;
- p[2].x := ws / 2;
- p[2].y := (hs * 3) / 4;
- p[3].x := ws;
- p[3].y := (hs * 2) / 4;
- p[4].x := ws;
- p[4].y := hs / 4;
- p[5].x := ws / 2;
- p[5].y := 0;
- p[6].x := 0;
- p[6].y := hs / 4;
- Polygon(p);
- end;
- SetTransparentColor(t, clWhite);
- for b := 0 to hl - 1 do
- for a := 0 to wl - 1 do
- FastDrawTransparent(a * ws, b * hs, t, bg);
- for b := 0 to hl - 2 do
- for a := 0 to wl - 1 do
- FastDrawTransparent((a * ws) + (ws / 2), (b * hs) + (hs / 2), t, bg);
- tmp := GetBitmapCanvas(bg);
- SafeCopyCanvas(tmp, img.Canvas, 0, 0, img.Width, img.Height, 0, 0, img.Width, img.Height);
- end;
- procedure SetupForm;
- begin
- frmMain := CreateForm;
- with frmMain do
- begin
- ClientWidth := 600;
- ClientHeight := 500;
- Position:= poScreenCenter;
- Caption := 'Strategy Game by mixster';
- end;
- imgBoard := TImage.Create(frmMain);
- with imgBoard do
- begin
- Parent := frmMain;
- Width := 501;
- Height := 401
- Left := 50;
- Top := 50;
- DrawHexagons(imgBoard, 2, 2);
- end;
- frmMain.ShowModal;
- end;
- procedure LaunchForm;
- var
- v: TVariantArray;
- begin
- ThreadSafeCall('SetupForm', v);
- end;
- begin
- Write(['Begin']);
- LaunchForm;
- Write(['End']);
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement