DUzun's Web
Programare, proiecte personale, divertisment

Unit Carts;

​

interface

Uses CRT, Graph;

​

{Maste}

const c_romb    = 0;

      c_inima   = 1;

      c_frunza  = 2;

      c_canabis = 3;

      c_verso   = 4;

​

type TNumeCarte = string[2]; {numele cartii}

     TMaste     = 0..4;      {maste: c_romb, c_inima, c_frunza, c_canabis}

     TCarte = record

       maste: TMaste;

       nume : TNumeCarte;

     end;

​

var c_width, c_height: integer;{dimensiunile cartii}

    c_style          : word;   {fundalul           }

    c_style_verso    : word;

    c_text_size      : word;   {textul             }

​

procedure DrowCarte(c: TCarte; x, y: integer);

procedure DrowCart (n: TNumeCarte; m: TMaste; x, y: integer);

procedure DrowMaste(m: TMaste; x, y, h: integer);

​

implementation

​

procedure DrowCarte(c: TCarte; x, y: integer);

begin

  with c do DrowCart(nume, maste, x, y);

end;

​

procedure DrowCart(n: TNumeCarte; m: TMaste; x, y: integer);

var col, ocol: integer;

    h, w     : integer;

    c        : word;

    ofi      : FillSettingsType;

    oti      : TextSettingsType;

begin

  ocol := GetColor;     {salvam culoarea de desenare          }

  GetFillSettings(ofi); {salvam culoarea si stilul pentru Fill}

  GetTextSettings(oti); {salvam stilul textului               }

​

  if m = c_verso then begin

     col := GREEN;

     c := c_style_verso;

  end else begin

    if m in [c_romb, c_inima] then col := RED

                              else col := BLUE;

    c := c_style;

  end;

  n[0] := UpCase(n[0]);

  h    := c_width div 8;

​

  {maste}

  SetColor(col);

  SetFillStyle(1, col+8);

  Bar(x+1, y+1, x+c_width-1, y+c_height-1); {Pregatim fundalul solid}

  if(m <> c_verso) then begin

    DrowMaste(m, x+c_width-2*h, y+2*h         ,  h);                         {sus   }

    DrowMaste(m, x+2*h        , y+c_height-2*h, -h);                         {jos   }

    DrowMaste(m, x+(c_width  div 2), y+(c_height div 2), (1-2*random(2))*h); {centru}

  end;

​

  {dreptunghiul}

  Rectangle(x, y, x+c_width, y+c_height);

  SetFillStyle(c, col+8);

  if c_style <> 1 then FloodFill(x+1, y+1, col);

​

  {text}

  SetTextStyle(DefaultFont, HorizDir, c_text_size);

  SetTextJustify(CenterText, CenterText);

  w := TextWidth (n) div 2 + 1;

  h := TextHeight(n) div 2 + 2;

  if m = c_verso then begin

    SetColor(WHITE);

    OutTextXY(x+(c_width div 2), y+(c_height div 2)-h, n);

  end else begin

    OutTextXY(x+w+1, y+h+1, n);

    OutTextXY(x+c_width-w, y+c_height-h, n);

  end;

​

  {restabilim ce am modificat in modul grafic}

  SetColor(ocol);

  with ofi do SetFillStyle(Pattern, Color);

  with oti do

  begin

    SetTextJustify(Horiz, Vert);

    SetTextStyle(Font, Direction, CharSize);

  end;

end;

​

procedure inima(x, y, h: integer);

var r, g: integer;

begin

   h := h div 2;

   r := trunc(h*sqrt(2)/2);

   if h > 0 then g := 180 else g := 0;

   Arc      (x+h, y-h, 135+g,    g, abs(h));

   Arc      (x-h, y-h, 180-g, 45+g, abs(h));

   Line     (x-h-r, y-h+r, x, y+r+r);

   Line     (x+h+r, y-h+r, x, y+r+r);

   FloodFill(x, y, GetColor);

end;

​

procedure frunza(x, y, h: integer);

var r, g: integer;

begin

   h := h * 5 div 12;

   r := trunc(h*sqrt(2)/2);

   dec(y, r);

   if h < 0 then g := 180 else g := 0;

   Arc (x-h, y+h, 135+g, g   , abs(h));

   Arc (x+h, y+h, 180-g, 45+g, abs(h));

   Line(x-h-r, y+h-r, x, y-r-r);

   Line(x+h+r, y+h-r, x, y-r-r);

   inc(y, r);

   h := 2*h;

   Bar (x-1, y    , x+1, y+h);

   Bar (x-r, y+h-1, x+r, y+h);

   Line(x-1, y+r  , x-1, y+h);

   Line(x+1, y+r  , x+1, y+h);

   Line(x-r, y+h-1, x+r, y+h-1);

   Line(x-r, y+h  , x+r, y+h);

   FloodFill(x  , y    , GetColor);

end;

​

procedure romb(x, y, h: integer);

var   t: integer;

begin

   t := h*3 div 4;

   Line(x, y-h, x-t, y);

   Line(x, y-h, x+t, y);

   Line(x, y+h, x-t, y);

   Line(x, y+h, x+t, y);

   FloodFill(x, y, GetColor);

end;

​

procedure canabis(x, y, h: integer);

var r, c: integer;

begin

   c := h div 3;

   dec(h, c);

   r := abs(c);

   Circle   (x  , y-h, r);

   Circle   (x-h, y  , r);

   Circle   (x+h, y  , r);

   r := GetColor;

   FloodFill(x  , y-h, r);

   FloodFill(x-h, y  , r);

   FloodFill(x+h, y  , r);

   Bar (x-1  , y-h  , x+1  , y+h);

   Bar (x-h  , y+1  , x+h  , y  );

   Bar (x-c  , y+h-1, x+c  , y+h);

   Line(x-1  , y-h+c, x-1  , y+h);

   Line(x+1  , y-h+c, x+1  , y+h);

   Line(x-h+c, y+1  , x+h-c, y+1);

   Line(x-h+c, y    , x+h-c, y);

   Line(x-c  , y+h-1, x+c  , y+h-1);

   Line(x-c  , y+h  , x+c  , y+h);

end;

​

procedure DrowMaste(m: TMaste; x, y, h: integer);

begin

  case m of

    c_inima  : Inima  (x, y, h);

    c_romb   : Romb   (x, y, h);

    c_frunza : Frunza (x, y, h);

    c_canabis: Canabis(x, y, h);

  end;

end;

​

BEGIN

  c_width  := 100;

  c_height := c_width * 3 div 2;

  c_style  := 9;

  c_style_verso := 6;

  c_text_size := 2;

END.

​

​