Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program Meh;
- type
- TTile = record
- t: TPoint;
- o: Boolean;
- end;
- TBoard = record
- t: array of array of TTile;
- h, w: Integer;
- end;
- TPiece = record
- t: array of Integer;
- h: Integer;
- end;
- TPieceSet = record
- p: array of TPiece;
- s: TPoint;
- h: Integer;
- end;
- var
- frmMain: TForm;
- imgBoard: TImage;
- board: TBoard;
- pieceset: TPieceset;
- procedure Write(v: TVariantArray);
- var
- i: Integer;
- s: string;
- begin
- if False then
- exit;
- if High(v) < 0 then
- exit;
- for i := 0 to High(v) do
- s := s + v[i];
- Writeln(s);
- end;
- procedure SetupBoard(var brd: TBoard; w, h: Integer);
- var
- x, y: Integer;
- begin
- brd.w := w - 1;
- brd.h := h - 1;
- SetLength(brd.t, h);
- for y := 0 to brd.h do
- begin
- SetLength(brd.t[y], w);
- for x := 0 to brd.w do
- begin
- brd.t[y][x].t.x := 0;
- brd.t[y][x].t.y := 0;
- brd.t[y][x].o := False;
- end;
- end;
- end;
- procedure SetupPieceset(var pce: TPieceSet; bmp, tw, th: Integer);
- var
- l, wl, hl, m, x, y, tb, ii, i: Integer;
- c, ts: TCanvas;
- p: TPointArray;
- begin
- l := 10;
- pce.s.x := Round(Sin(Radians(30)) * l);
- pce.s.y := Round(Cos(Radians(30)) * l);
- wl := (2 * pce.s.x) + l;
- hl := 2 * pce.s.y;
- m := BitmapFromString(wl, hl, '');
- FastDrawClear(m, clBlack);
- c := GetBitmapCanvas(m);
- c.Pen.Color := clWhite;
- c.Brush.Color := clWhite;
- with pce.s do
- c.Polygon([Point(0, y), Point(x, y + y), Point(x + l, y + y), Point(x + l + x, y), Point(x + l, 0), Point(x, 0)]);
- SetTransparentColor(m, clWhite);
- GetBitmapSize(bmp, x, y);
- x := x / tw;
- y := y / th;
- tb := BitmapFromString(x, y, '');
- FastDrawClear(tb, 0);
- SetTargetBitmap(bmp);
- ts := GetBitmapCanvas(bmp);
- pce.h := th;
- SetLength(pce.p, th);
- for ii := 0 to th - 1 do
- with pce.p[i] do
- begin
- h := -1;
- for i := 0 to tw - 1 do
- begin
- SetLength(p, 0);
- FindColorsTolerance(p, clBlack, x * i, y * ii, (x * i) + wl, (y * ii) + hl, 1);
- if Length(p) >= (wl * hl) then
- Break;
- Inc(h);
- SetLength(t, h + 1);
- t[h] := BitmapFromString(wl, hl, '');
- SafeCopyCanvas(ts, GetBitmapCanvas(t[h]), x * i, y * ii, x * i + wl, y * ii + hl, 0, 0, wl, hl);
- FastDrawTransparent(0, 0, m, t[h]);
- SetTransparentColor(t[h], clBlack);
- end;
- end;
- FreeBitmap(m);
- ResetDc;
- end;
- procedure DrawBoard(var img: TImage; brd: TBoard; pce: TPieceSet);
- var
- t, i, ii, w, h, l, o: Integer;
- begin
- t := BitmapFromString(img.Width, img.Height, '');
- FastDrawClear(t, clBlack);
- GetBitmapSize(pce.p[0].t[0], w, h);
- l := w - (pce.s.x * 2);
- w := w + l;
- h := h / 2 - 1;
- Write([l, ',', w, ',', h]);
- for ii := 0 to brd.h do
- begin
- if ii mod 2 = 0 then
- o := 0
- else
- o := pce.s.x + l;
- for i := 0 to brd.w do
- begin
- if o > 0 then
- if i = brd.w then
- Break;
- if (brd.t[ii][i].t.y > pce.h) then
- Continue;
- if (brd.t[ii][i].t.x > pce.p[brd.t[ii][i].t.y].h) then
- Continue;
- FastDrawTransparent((i * w) + o, (ii * h), pce.p[brd.t[ii][i].t.y].t[brd.t[ii][i].t.x], t);
- end;
- end;
- SafeDrawBitmap(t, img.Canvas, 0, 0);
- end;
- procedure SetupForm;
- var
- i, a: Integer;
- c: TCanvas;
- 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;
- DrawBoard(imgBoard, board, pieceset);
- end;
- frmMain.ShowModal;
- end;
- procedure LaunchForm;
- var
- v: TVariantArray;
- begin
- ThreadSafeCall('SetupForm', v);
- end;
- var
- t, i, ii: Integer;
- begin
- Write(['Begin']);
- t := BitmapFromString(100, 200, '');
- for i := 0 to 7 do
- for ii := 0 to 3 do
- begin
- if (ii > 0) then
- if Random(3) = 0 then
- Break;
- GetBitmapCanvas(t).Brush.Color := Random(clWhite);
- GetBitmapCanvas(t).Rectangle(ii * 25, i * 25, ii * 25 + 25, i * 25 + 25);
- end;
- DisplayDebugImgWindow(100, 200);
- SafeDrawBitmap(t, GetDebugCanvas, 0, 0);
- SetupPieceset(pieceset, t, 4, 8);
- SetupBoard(board, 8, 19);
- LaunchForm;
- Write(['End']);
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement