#

Tombola!

generazione cartelle per tombola
 
unit tombola;

{ Genera cartelle casuali per tombola.
  Per la stampa richiede il set di caratteri IBM-PC codepage 437 }


interface

uses objects;

type PNumeri = ^TNumeri;
     TNumeri = object(TStringCollection)
       constructor init;
       end;

     PCartella = ^TCartella;
     TCartella = object(TObject)
       dati : array[1..10] of string[26];
       constructor init(intest : string; n : word);
       procedure fill(p : PNumeri);
       end;

procedure coppia(intest : string; n : word; var t : text);
procedure pagina(intest : string; n : word; var t : text);

implementation

{ Calcolo dei numeri da inserire nella cartella:
  vengono generati tre numeri equiprobabili in ciascuna delle fasce
  1-18 19-36 37-54 55-72 73-90

  I risultati ottenuti sono convertiti in stringhe di due caratteri
  allineati a destra e disposti in ordine alfabetico crescente
  (nel caso particolare l'ordinamento numerico corrisponde) }


constructor TNumeri.init;
var k,j,n,idx : integer;
    s : string;
    p : PString;
begin
TStringCollection.init(15,0);
for k := 0 to 4 do
  for j := 1 to 3 do begin
    p := nil;
    repeat
      if p <> nil then disposestr(p);
      n := random(18) + 1 + k*18;
      str(n:2,s);
      p := newstr(s);
      until not search(p,idx);
    AtInsert(idx,p);
    end;
end;


{ Copia multipla di caratteri }

function chars(c : char; n : byte) : string;
var s : string;
    j : byte;
begin
s[0] := char(n);
for j := 1 to n do s[j] := c;
chars := s;
end;


{ Oggetto per la gestione dell'aspetto grafico della cartella }

constructor TCartella.init(intest : string; n : word);
var j : integer;
begin
dati[1] := #201 + chars(#205,24) + #187;

dati[2] := #186 + copy(intest+chars(' ',24),1,24) + #186;

str(n,intest);
intest := 'cartella '+intest;
dati[3] := #186 + copy(intest+chars(' ',24),1,24) + #186;

dati[4] := dati[1];
dati[4,1] := #204;
dati[4,26] := #185;
for j := 0 to 3 do dati[4,j*5+6] := #209;

dati[10] := dati[4];
dati[10,1] := #200;
dati[10,26] := #188;
for j := 0 to 3 do dati[10,j*5+6] := #207;

dati[5] := #186 + chars(' ',14) + #186;
for j := 0 to 3 do dati[5,j*3+4] := #179;

dati[6] := #199 + chars(#196,24) + #182;
for j := 0 to 3 do dati[6,j*5+6] := #197;

dati[7] := dati[5];
dati[8] := dati[6];
dati[9] := dati[5];
end;

procedure TCartella.fill(p : PNumeri);
var k,j : integer;
begin
for k := 0 to 4 do
  for j := 0 to 2 do
    insert(pstring(p^.at(k*3+j))^,dati[j*2+5],k*5+3);
end;


{ Stampa un coppia di cartelle affiancate }

procedure coppia(intest : string; n : word; var t : text);
var c1,c2 : PCartella;
    num : PNumeri;
    j : integer;
begin
new(c1,init(intest,n));
new(c2,init(intest,succ(n)));

new(num,init);
c1^.fill(num);
dispose(num,done);

new(num,init);
c2^.fill(num);
dispose(num,done);

for j := 1 to 10 do
  writeln(t, chars(' ',7), c1^.dati[j], chars(' ',14), c2^.dati[j]);

dispose(c1,done);
dispose(c2,done);
end;


{ Stampa una pagina con 10 cartelle; gestisce FF }

procedure pagina(intest : string; n : word; var t : text);
var j : integer;
begin
coppia(intest,n,t);
for j := 1 to 4 do begin
  writeln(t);
  writeln(t);
  writeln(t);
  coppia(intest, n + j*2, t);
  end;
write(t,#12);
end;


end.

 

program cartelle_per_tombola;


{ Questo programma stampa una serie di pagine con 10 cartelle per
  tombola ciascuna.  Poiche' usa 62 linee per pagina e manda un FF
  alla fine puo' essere utilizzato anche su stampanti laser.

  E' necessario avere disponibili i caratteri IBM-PC codepage 437

  Questo codice e' da considerarsi esclusivamente in
  * alpha-test *
  non se ne garantisce affatto la funzionalita' e la manutenzione

  Tutti i diritti sono riservati all'autore:
  Roberto Ceccarelli  2:332/[email protected] }



uses tombola,app,dialogs,objects,views;

var t : text;
    j,w : integer;
    a : TApplication;
    d : PDialog;


{ Dialogs box per la richiesta dei dati }

type RMaschera = record
       nome : string[24];
       pag : string[4];
       filename : string[80];
       end;

var dati : RMaschera;

procedure Maschera;
var r : Trect;
    l : PInputLine;
begin
r.assign(1,1,50,15);
new(d,init(r,'CASASOFT Cartelle 0.10'));
d^.options := d^.options or ofCentered;

r.a.x := r.b.x - 11;
r.a.y := r.b.y - 4;
dec(r.b.y,2);
dec(r.b.x,3);
d^.insert(new(PButton,init(r,'Ok',cmOk,bfDefault)));

d^.getextent(r);
r.grow(-3,-3);
inc(r.a.x,5);
r.b.y := succ(r.a.y);
new(l,init(r,24));
l^.data := newstr('Gran Tombolone CASASOFT');
d^.insert(l);
r.b.x := r.a.x + 5;
r.move(-6,0);
d^.insert(new(PLabel,init(r,'~N~ome',l)));

d^.getextent(r);
r.grow(-3,-3);
r.move(0,2);
inc(r.a.x,5);
r.b.y := succ(r.a.y);
new(l,init(r,4));
l^.data := newstr('1');
d^.insert(l);
r.b.x := r.a.x + 5;
r.move(-6,0);
d^.insert(new(PLabel,init(r,'~P~ag.',l)));

d^.getextent(r);
r.grow(-3,-3);
r.move(0,4);
inc(r.a.x,5);
r.b.y := succ(r.a.y);
new(l,init(r,80));
l^.data := newstr('CON');
d^.insert(l);
r.b.x := r.a.x + 5;
r.move(-6,0);
d^.insert(new(PLabel,init(r,'~F~ile',l)));
end;


{ Welcome dialog box }

procedure About;
var r : TRect;
begin
r.assign(1,1,50,15);
new(d,init(r,'CASASOFT Cartelle 0.10'));
d^.options := d^.options or ofCentered;

r.a.x := r.b.x - 11;
r.a.y := r.b.y - 4;
dec(r.b.y,2);
dec(r.b.x,3);
d^.insert(new(PButton,init(r,'Ok',cmOk,bfDefault)));

d^.getextent(r);
r.grow(-2,-2);
r.b.y := r.a.y + 3;
d^.insert(new(PStaticText,init(r,
  ^C'(c) 1992 Roberto Ceccarelli'#13#10 +
  ^C'2:332/[email protected]')));

r.move(0,4);
inc(r.b.y);
d^.insert(new(PStaticText,init(r,
  ^C'Dear Simona,'#13#10 +
  ^C'as you can see I can make everything'#13#10 +
  ^C'I could need using a computer or a camera'#13#10 +
  ^C'...except you!')));
j := a.execview(d);
end;

{ ************************  MAIN  ***************************** }

begin
a.init;
about;
maschera;
if a.execview(d) <> cmCancel then begin;
  d^.getdata(dati);
  randomize;
  assign(t,dati.filename);
  rewrite(t);
  val(dati.pag,w,j);
  if j = 0 then
    for j := 0 to pred(w) do
      pagina(dati.nome,1+j*10,t);
  close(t);
  end;
a.done;
end.
Inizio pagina
Home page
 
Creative Commons  License BY-NC-SA
Ove non diversamente specificato i contenuti del sito sono rilasciati con licenza Creative Commons BY-NC-SA 4.0 

Copyright © 2007-2020 The Strawberry Field - Roberto Ceccarelli