Chip 1997 April/Chip_1997-04_cd.bin/tema/602propc/disk5/data.5/WINTIME/APPS/I_TISK.PGM

Text File | 1996-12-03 | 13KB | 354 lines

INCLUDE

procedure NastaveniTiskarny;
{**************************************}
begin
  Printer_dialog(0);
end;

procedure KontrolaUzivSt(idpom : window_id);
{**************************************}
var
 pozice : short;
begin
  if Parametry[0].velik = 10 then
    if Find_object("LABELXX",categ_view,pozice) then begin
     Info_box('Nenalezen navr₧en² pohled',
        'Nßvrh Ütφtku se provßdφ ve v²vojovΘm prost°edφ WinBase602.'#10''
        'Z aplikace nenφ mo₧no Ütφtek navrhnout.'#10#10''
        'Tato volba je zde proto, aby bylo mo₧no bez velkΘ nßmahy'#10''
        'doplnit aplikaci o nov² rozm∞r Ütφtku, kter² chybφ v nabφdce.'#10''
        'Jak vytvo°it vlastnφ Ütφtek se doΦtete v nßpov∞d∞.');
     Parametry[0].velik := 1;
     Reset_view(idpom,-1,5);
   end;
end;

procedure VyberStitku;
{**************************************}
var
  id_s : window_id;
begin
  Open_view("*Pdefstitku",no_redir,modal_view,0,0,id_s);
  repeat Peek_message until id_s=0;
  SmazatFrontu;

  Err_mask(true);
   labeltype := Parametry[0].typst;
   labelsize := Parametry[0].velik;
  Err_mask(false);
end;

function NoveJmenoTabulky : string[10];
{**************************************}
// vytvo°φ jedineΦnΘ jmΘno pomocnΘ tabulky _tmpx
var
  tabname : string[10];
  objnum : short;
  i : short;
begin
  i := 0;
  tabname := '_tmp0';
  if not Find_object(tabname, categ_table, objnum) then
  repeat   //tak dlouho, dokud jeÜt∞ neexistuje (pro p°φpad, ₧e souΦasn∞ tiskne vφc lidφ)
    i := i+1;
    tabname := StrCopy(tabname,1,4)+Int2Str(i);
  until Find_object(tabname, categ_table, objnum);
  NoveJmenoTabulky := tabname;
end;

function NovaTabulka : string[10];
{**************************************}
// vytvo°φ pomocnou tabulku pro kopii dat pro tisk
// pokud se to nepovede, vrßtφ jmΘno tabulky, jinak prßzdn² string
var
  tabname : string[10];
  SQL_stat : string[1000];
  pomstr : string[30];
begin
  tabname := NoveJmenoTabulky;
  SQL_stat := ' ( CISLO SMALLINT, '
    'FIRMA CHAR(50) COLLATE CSISTRING, '
    'FIRMA2 CHAR(50) COLLATE CSISTRING, '
    'JMENO CHAR(20) COLLATE CSISTRING, '
    'PRIJMENI CHAR(20) COLLATE CSISTRING, '
    'TITUL CHAR(10) COLLATE CSISTRING, '
    'FUNKCE CHAR(50) COLLATE CSISTRING, '
    'MUZ BIT, '
    'ULICE CHAR(50) COLLATE CSISTRING, '
    'MESTO CHAR(50) COLLATE CSISTRING, '
    'PSC CHAR(6), '
    'STAT CHAR(30), '
    'TELEFON CHAR(20) PREALLOC 5 COLLATE CSISTRING, '
    'FAX CHAR(20) PREALLOC 5 COLLATE CSISTRING )';
  pomstr := 'CREATE TABLE '+ tabname;
  StrInsert(pomstr,SQL_stat,1);

  if SQL_execute(SQL_stat) then begin
    Signalize;
    NovaTabulka := "";
  end else NovaTabulka := tabname;
end;

procedure Smazat(co : string[10]);
{**************************************}
//sma₧e tabulku
var
  SQL_str : string[100];
begin
  SQL_str :='DROP TABLE '+co;
  if SQL_execute(SQL_str) then Signalize;
  SIgnalize;
end;

procedure Tisk2x(idx : window_id);
{**************************************}
//tisk Ütφtk∙ firem tlaΦφtkem z pohledu Seznam2Tis  (p°i editTisk=true)
var
  cf : cursor;
  i,j,pocet,icislo : integer;
  strpom : string[40];
begin
  Close_cursor(curtisk);
  strpom := 'SELECT * FROM '+tabul+' WHERE false';
  if Open_sql_cursor(curtisk, strpom) then Signalize;

  if Get_fcursor(idx,cf,nil) then begin
    for i := 1 to kolikpred do        // prßzdnß mφsta p°ed tiskem prvnφho
      Insert(curtisk);
    Rec_cnt(cf,pocet);
    for i := 0 to pocet-1 do begin
      Translate(cf, i, 0, icislo);    // p°epoΦet na Φφslo v tabulce _tmpx
      if icislo <> -1 then
        for j := 1 to kolikrat do
          Add_record(curtisk,icislo,1);      // p°idßnφ zßznamu do kurzoru curtisk
    end;
    Print_view(labelname,curtisk,-1,-1);
  end;
end;

procedure Tiskx(idx : window_id);
{**************************************}
//tisk seznamu firem tlaΦφtkem z pohledu SeznamTisk   (p°i editTisk=true)
begin
  if Get_fcursor(idx,curtisk,nil) then begin
     Set_printer(0,99999,1,99999,preview,"",10);
     Print_margins(0,5,10,10);
     Print_copies(kolikrat,true);
     Print_view("*Ptseznam",curtisk,-1,-1);
  end else Signalize;
end;

procedure TiskSeznamu;
{**************************************}
var
  id_kol : window_id;
  id_pom : window_id;
  pocetx,i,j,rec : integer;
  spom : string[30];
  id_seztisk : window_id;
  sss : string[30];
  idx,idx2 : window_id;
  res : integer;

begin
  Open_view("*Pkolik2",no_redir,modal_view,0,0,id_kol);
  repeat Peek_message until id_kol=0;
  SmazatFrontu;

  if not zrusitAkci then begin

    id_pom := Active_view;
    if id_pom <> 0 then begin
      Get_fcursor(id_pom, cx, nil);     //sejmutφ kurzoru z obrazovky, m∙₧e b²t zm∞n∞n dφky QBE
    end else cx := curmain;             //nenφ otev°en pohled do dat
    Rec_cnt(cx, pocetx);
    Signalize;

    if editTisk then begin                            // bude se vytvß°et pomocnß tabulka, aby v nφ Ülo editovat
      Set_cursor(1);
      Set_status_text('Vytvß°φ se kopie tabulky...');
      tabul := NovaTabulka;
      if tabul = "" then Info_box('Chyba','Nepoda°ilo se vytvo°it pomocnou tabulku.'#10'Tisk je zruÜen.')
      else begin
        spom := 'SELECT * FROM '+tabul;
        if not Open_sql_cursor(cpom,spom) then begin

          Set_status_text('Probφhß p°enos zßznam∙ do kopie tabulky...');
          for i := 0 to Pocetx-1 do begin
            Set_cursor(1);
            Set_status_nums(i+1,Pocetx);
            Translate(cx,i,0,res);
            if res <> -1 then begin          // zßznam v kurzoru nebyl zruÜen
              Start_transaction;
              rec := Insert(cpom);
              if rec <> -1 then begin
                cpom[rec].titul   := cx[i].titul;
                cpom[rec].prijmeni := cx[i].prijmeni;
                cpom[rec].jmeno   :=  cx[i].jmeno;
                cpom[rec].cislo   := cx[i].cislo;
                cpom[rec].firma   := cx[i].firma;
                cpom[rec].firma2  := cx[i].firma2;
                cpom[rec].funkce  := cx[i].funkce;
                cpom[rec].muz     := cx[i].muz;
                cpom[rec].ulice   := cx[i].ulice;
                cpom[rec].mesto   := cx[i].mesto;
                cpom[rec].psc     := cx[i].psc;
                cpom[rec].stat    := cx[i].stat;
                for j := 0 to 4 do
                  cpom[rec].telefon[j] := cx[i].telefon[j];
                for j := 0 to 4 do
                  cpom[rec].fax[j] := cx[i].fax[j];
                Commit;
              end
            end;
          end;

          Open_view('*SeznamTisk',cpom,0,0,0,id_seztisk);       // tisk prob∞hne v procedu°e volanΘ tlaΦφtkem
          repeat Peek_message until id_seztisk=0;

        end; //neotev°el se kurzor
        Close_cursor(cpom);
        Smazat(tabul);                                          // sma₧e se pomocnß tabulka
      end; //nevytvo°ila se tabulka
    end
    else begin                                        // tisk rovnou, bez ·pravy  (editTisk=false)
      Set_printer(0,99999,1,99999,preview,"",0);
      Print_margins(0,5,10,10);
      Print_copies(kolikrat,true);
      Print_view("*Ptseznam",cx,-1,-1);               // tiskne se kurzor cx sejmut² Get_fcursor

    end;
    Set_status_text('');
    Set_status_nums(-1,-1);

  end; //zrusitAkci
end;

procedure TiskStitku(cislo : integer);
{**************************************}
{cislo=-1 : tisk vÜech vybran²ch zßznam∙, }
{cislo >0 : tisk jednoho Ütφtku}
var
  id_kol : window_id;
  s : string[20];
  idp : window_id;
  id_pom : window_id;
  fx : short;
  pocetx,i,j,rec : integer;
  spom : string[30];
  id_seztisk : window_id;
  icislo : integer;
  cx : cursor;
  strpom : string[40];
  res : integer;

begin
  zrusitAkci := true;
  pomocny := cislo=-1?true: false;  // pro podmφnku aktivity v pohledu Pkolik
  Open_view("*Pkolik",no_redir,modal_view,0,0,id_kol);
  repeat Peek_message until id_kol=0;
  SmazatFrontu;

  if not zrusitAkci then begin
    if labeltype = 3 then begin
         osloveni1 := "Vß₧en² pan ";
         osloveni2 := "Vß₧enß panφ ";
    end;
    if labelsize = 10 then labelname := "*LABELXX"   // u₧ivatelem definovan² Ütφtek
    else labelname := "*LABEL"+int2str(labeltype)+int2str(labelsize);
    Set_printer(0,99999,str_od,str_do,preview,"",0);
    Print_margins(0,0,0,0);

    if cislo > -1 then begin                                         // tisk Ütφtk∙ jednΘ firmy tlaΦφtkem
      if not Get_fcursor(Active_view,cx,nil) then Info_box('Chyba','Get_fcursor')
      else begin
        if not Open_sql_cursor(curtisk,'SELECT * FROM Tfirma WHERE false') then begin
          for j := 0 to kolikpred-1 do
            Insert(curtisk);
          Translate(cx,cislo,0,icislo);
          for j := 1 to kolikrat do
            Add_record(curtisk,icislo,1);
        end;
        Print_view(labelname,curtisk,-1,-1);
        Close_cursor(curtisk);
      end;
    end else begin                                                  // tisk mno₧iny Ütφtk∙

      id_pom := Active_view;
      if id_pom <> 0 then begin
          Get_fcursor(id_pom, cx, fx);      // sejmutφ kurzoru z obrazovky, m∙₧e b²t zm∞n∞n dφky QBE
      end else cx := curmain;               // nenφ otev°en pohled do dat

      if editTisk then begin                  // bude se vytvß°et pomocnß tabulka, aby v nφ Ülo editovat
        Set_cursor(1);
        Set_status_text('Vytvß°φ se kopie tabulky...');
        tabul := NovaTabulka;
        if tabul = "" then Info_box('Chyba','Nepoda°ilo se vytvo°it pomocnou tabulku.'#10'Tisk je zruÜen.')
        else begin
          spom := 'SELECT * FROM '+tabul;
          if not Open_sql_cursor(cpom,spom) then begin

            Rec_cnt(cx, pocetx);
            Set_status_text('Probφhß p°enos zßznam∙ do kopie tabulky...');
            for i := 0 to Pocetx-1 do begin
              Set_cursor(1);
              Set_status_nums(i+1,Pocetx);
              Translate(cx,i,0,res);
              if res <> -1 then begin          // zßznam v kurzoru nebyl zruÜen
                rec := Insert(cpom);
                if rec <> -1 then begin
                  Start_transaction;
                  cpom[rec].titul   := cx[i].titul;
                  cpom[rec].prijmeni := cx[i].prijmeni;
                  cpom[rec].jmeno   :=  cx[i].jmeno;
                  cpom[rec].cislo   := cx[i].cislo;
                  cpom[rec].firma   := cx[i].firma;
                  cpom[rec].firma2  := cx[i].firma2;
                  cpom[rec].muz     := cx[i].muz;
                  cpom[rec].ulice   := cx[i].ulice;
                  cpom[rec].mesto   := cx[i].mesto;
                  cpom[rec].psc     := cx[i].psc;
                  cpom[rec].stat    := cx[i].stat;
                  Commit;
                end
              end;
            end;

            strpom := 'SELECT * FROM '+tabul+' WHERE false';
            if not Open_sql_cursor(curtisk, strpom) then begin
              Open_view('*Seznam2Tis',cpom,0,0,0,id_seztisk);       // tisk se zavolß v procedu°e volanΘ tlaΦφtkem z pohledu
              repeat Peek_message until id_seztisk=0;
              Close_cursor(curtisk);
            end;    // open cursor curtisk
            Close_cursor(cpom);
          end;      // open cursor cpom
          Smazat(tabul);
        end;        // nevytvo°ila se tabulka
      end
      else begin               // tisk rovnou, bez ·pravy  (editTisk=false)

        strpom := 'SELECT * FROM TFirma WHERE false';
        if not Open_sql_cursor(curtisk, strpom) then begin

          for i := 1 to kolikpred do        // prßzdnß mφsta p°ed tiskem prvnφho
            Insert(curtisk);
          Rec_cnt(cx,pocetx);
          for i := 0 to pocetx-1 do begin
            Translate(cx, i, 0, icislo);      // p°epoΦet na Φφslo v tabulce _tmpx
            if icislo <> -1 then
              for j := 1 to kolikrat do
                Add_record(curtisk,icislo,1);   // p°idßnφ zßznamu do kurzoru curtisk, aby byly kopie Ütφtk∙ za sebou
          end;
          Print_view(labelname,curtisk,-1,-1);
          Close_cursor(curtisk);
        end;        // open cursor curtisk
      end;
    end;          // tisk mno₧iny Ütφtk∙
    Set_status_text('');
    Set_status_nums(-1,-1);
  end;
end;