Advertisement
mixster

mixster

Jan 2nd, 2009
201
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.41 KB | None | 0 0
  1. program Meh;
  2. type
  3.   TTile = record
  4.     t: TPoint;
  5.     o: Boolean;
  6.   end;
  7.   TBoard = record
  8.     t: array of array of TTile;
  9.     h, w: Integer;
  10.   end;
  11.   TPiece = record
  12.     t: array of Integer;
  13.     h: Integer;
  14.   end;
  15.   TPieceSet = record
  16.     p: array of TPiece;
  17.     s: TPoint;
  18.     h: Integer;
  19.   end;
  20.  
  21. var
  22.   frmMain: TForm;
  23.   imgBoard: TImage;
  24.   board: TBoard;
  25.   pieceset: TPieceset;
  26.  
  27. procedure Write(v: TVariantArray);
  28. var
  29.   i: Integer;
  30.   s: string;
  31. begin
  32.   if False then
  33.     exit;
  34.   if High(v) < 0 then
  35.     exit;
  36.   for i := 0 to High(v) do
  37.     s := s + v[i];
  38.   Writeln(s);
  39. end;
  40.  
  41. procedure SetupBoard(var brd: TBoard; w, h: Integer);
  42. var
  43.   x, y: Integer;
  44. begin
  45.   brd.w := w - 1;
  46.   brd.h := h - 1;
  47.   SetLength(brd.t, h);
  48.   for y := 0 to brd.h do
  49.   begin
  50.     SetLength(brd.t[y], w);
  51.     for x := 0 to brd.w do
  52.     begin
  53.       brd.t[y][x].t.x := 0;
  54.       brd.t[y][x].t.y := 0;
  55.       brd.t[y][x].o := False;
  56.     end;
  57.   end;
  58. end;
  59.  
  60. procedure SetupPieceset(var pce: TPieceSet; bmp, tw, th: Integer);
  61. var
  62.   l, wl, hl, m, x, y, tb, ii, i: Integer;
  63.   c, ts: TCanvas;
  64.   p: TPointArray;
  65. begin
  66.   l := 10;
  67.   pce.s.x := Round(Sin(Radians(30)) * l);
  68.   pce.s.y := Round(Cos(Radians(30)) * l);
  69.   wl := (2 * pce.s.x) + l;
  70.   hl := 2 * pce.s.y;
  71.   m := BitmapFromString(wl, hl, '');
  72.   FastDrawClear(m, clBlack);
  73.   c := GetBitmapCanvas(m);
  74.   c.Pen.Color := clWhite;
  75.   c.Brush.Color := clWhite;
  76.   with pce.s do
  77.     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)]);
  78.   SetTransparentColor(m, clWhite);
  79.   GetBitmapSize(bmp, x, y);
  80.   x := x / tw;
  81.   y := y / th;
  82.   tb := BitmapFromString(x, y, '');
  83.   FastDrawClear(tb, 0);
  84.   SetTargetBitmap(bmp);
  85.   ts := GetBitmapCanvas(bmp);
  86.   pce.h := th;
  87.   SetLength(pce.p, th);
  88.   for ii := 0 to th - 1 do
  89.     with pce.p[i] do
  90.     begin
  91.       h := -1;
  92.       for i := 0 to tw - 1 do
  93.       begin
  94.         SetLength(p, 0);
  95.         FindColorsTolerance(p, clBlack, x * i, y * ii, (x * i) + wl, (y * ii) + hl, 1);
  96.         if Length(p) >= (wl * hl) then
  97.           Break;
  98.         Inc(h);
  99.         SetLength(t, h + 1);
  100.         t[h] := BitmapFromString(wl, hl, '');
  101.         SafeCopyCanvas(ts, GetBitmapCanvas(t[h]), x * i, y * ii, x * i + wl, y * ii + hl, 0, 0, wl, hl);
  102.         FastDrawTransparent(0, 0, m, t[h]);
  103.         SetTransparentColor(t[h], clBlack);
  104.       end;
  105.     end;
  106.   FreeBitmap(m);
  107.   ResetDc;
  108. end;
  109.  
  110. procedure DrawBoard(var img: TImage; brd: TBoard; pce: TPieceSet);
  111. var
  112.   t, i, ii, w, h, l, o: Integer;
  113. begin
  114.   t := BitmapFromString(img.Width, img.Height, '');
  115.   FastDrawClear(t, clBlack);
  116.   GetBitmapSize(pce.p[0].t[0], w, h);
  117.   l := w - (pce.s.x * 2);
  118.   w := w + l;
  119.   h := h / 2 - 1;
  120.   Write([l, ',', w, ',', h]);
  121.   for ii := 0 to brd.h do
  122.   begin
  123.     if ii mod 2 = 0 then
  124.       o := 0
  125.     else
  126.       o := pce.s.x + l;
  127.     for i := 0 to brd.w do
  128.     begin
  129.       if o > 0 then
  130.         if i = brd.w then
  131.           Break;
  132.       if (brd.t[ii][i].t.y > pce.h) then
  133.         Continue;
  134.       if (brd.t[ii][i].t.x > pce.p[brd.t[ii][i].t.y].h) then
  135.         Continue;
  136.       FastDrawTransparent((i * w) + o, (ii * h), pce.p[brd.t[ii][i].t.y].t[brd.t[ii][i].t.x], t);
  137.     end;
  138.   end;
  139.  
  140.   SafeDrawBitmap(t, img.Canvas, 0, 0);
  141. end;
  142.  
  143. procedure SetupForm;
  144. var
  145.   i, a: Integer;
  146.   c: TCanvas;
  147. begin
  148.   frmMain := CreateForm;
  149.   with frmMain do
  150.   begin
  151.     ClientWidth := 600;
  152.     ClientHeight := 500;
  153.     Position:= poScreenCenter;
  154.     Caption := 'Strategy Game by mixster';
  155.   end;
  156.  
  157.   imgBoard := TImage.Create(frmMain);
  158.   with imgBoard do
  159.   begin
  160.     Parent := frmMain;
  161.     Width := 501;
  162.     Height := 401
  163.     Left := 50;
  164.     Top := 50;
  165.     DrawBoard(imgBoard, board, pieceset);
  166.  
  167.   end;
  168.  
  169.   frmMain.ShowModal;
  170. end;
  171.  
  172. procedure LaunchForm;
  173. var
  174.   v: TVariantArray;
  175. begin
  176.   ThreadSafeCall('SetupForm', v);
  177. end;
  178.  
  179. var
  180.   t, i, ii: Integer;
  181. begin
  182.   Write(['Begin']);
  183.  
  184.   t := BitmapFromString(100, 200, '');
  185.   for i := 0 to 7 do
  186.     for ii := 0 to 3 do
  187.     begin
  188.       if (ii > 0) then
  189.         if Random(3) = 0 then
  190.           Break;
  191.       GetBitmapCanvas(t).Brush.Color := Random(clWhite);
  192.       GetBitmapCanvas(t).Rectangle(ii * 25, i * 25, ii * 25 + 25, i * 25 + 25);
  193.     end;
  194.   DisplayDebugImgWindow(100, 200);
  195.   SafeDrawBitmap(t, GetDebugCanvas, 0, 0);
  196.   SetupPieceset(pieceset, t, 4, 8);
  197.   SetupBoard(board, 8, 19);
  198.  
  199.   LaunchForm;
  200.   Write(['End']);
  201. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement