Program pre spr8vu objednávok žalúzií.

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: Programy v Pascalu
zaluzie.pngProgram: Zaluzie.pas,  Archiv.pas,  Dealer.pas,  Farba.pas,  Fax.pas,  Filter.pas,  Formul.pas,  Fyzic.pas,  Help.pas,  Kniznic.pas,  Miesto.pas,  Mzdy.pas,  Option.pas,  Pr_zal.pas,  Read_dbf.pas,  Redef.pas,  Sdv.pas,  Tlac.pas,  Trsek.pas,  Zaluz.pas,  Zostavy.pas
Soubor exe: Zaluzie.exe
Potřebné: Zaluzie.zip,  Help.dat,  Dealer,  Dealer.$$$,  Fax.dat,  Kumuly.$$$,  Kumuly.frm,  Kumuly.kum,  Merac,  Montaz,  Option.dbf,  Option.frm,  Option.ind,  Poradie.dat,  Vystup.txt,  Zaluzie.dbf,  Zaluzie.dat,  Zaluzie.frm,  Zaluzie.ind,  Zaluzie.txt,  Zostava.frm

Program bol vytvorený pre vnutorné potreby firmy KOMA pre spravu objednávok žalúzií.

Bližší popis jednotlivých funkcií:
F2 - Zalúzia
Slúži ako nosná časť celého tohto programu dajú sa v ňom zadávať informácie o objednávateľovi ako jeho MENO, ADRESA, PODLAŽIE.
Kvôli neskorším rozpisom je možné vyplniť (ŠTVRŤ) program sa potom bude týmto riadiť.
Ďalej informácie o tom kto bol dohadzovač (DEALER), kto odmeriaval žalúziu (MERAČ) a nakoniec mená až troch (MONTÁŽNIKOV).
Je možné ďalej vyplniť DATUM OBJEDNAVKY, s tým, že program okamžite prepočíta kedy uplyie doba 14 dní na vykonanie montáže (LEHOTA).
Ak je nám známa CENA žalúzie po je vyplnení okamžite vypočítava DOPLATOK. Po vyplnení ZALOHY je vypočítaný doplatok znova.
Pri vyplňovaní mzdových nákladov máme približný mzdový charakter pre jednotlivých zainteresovaných.
Žalúzie sa vypĺňajú intuitívne pričom ak nie je zadaná farba nie je možné vyplniť žalúziu ďalšiu.

Číselníky pre STVRT, DEALER, MERAC, MONTAZNIK, FARBA sú aktivované okamžite po stlačení klávesy ENTER. Potom si stačí vybrať potrebné a znova stlačiť ENTER. Ak však má užívateľ čísla v krvi stačí napísať priamo číslo program si už neako poradí sám.

F3 - DEALER, F5 - MERAC, F6 - MONTAZ, F4 - FARBA
Okno pre doplnenie číselníka dealerov (meračov, montážnikov farieb). Pohyb šipkami, ESC - koniec práce, DEL - označ dealera na zmazanie.

F4 - ULICA
Okno pre doplnenie číselníka ulíc. Ostatné ako u DEALER. Ak však stlacíte ENTER na položke vpravo objaví sa vám okno MESTO, kde si vyberiete do akého mesta potrí ulica. Aj v meste je ešte možné vybrať KRAJ. ( Upozorňujem, že názvy sú pracovné. Znamená, že ich použitie môže byť iné). 
{ ARCHIV.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{ Archivovanie databaz programu zaluzie.                            }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
procedure teplomer(kolko,ostava:longint);
const tep_e='ŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰŰ';
      tep_u='źźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźźź';
var perc:integer;
begin
 perc:=round((kolko/ostava)*100);
 hlaska('Copy ARCHIV.EXE '+copy(tep_u,1,round( perc     /2.5))+
        copy(tep_e,1,round((100-perc)/2.5))+' '+stri(perc,3)+' %',-1);
end;
 
procedure t_copy(subor,subor2,cesta:string);
var ff1,ff2:file;
    quick:pointer;
    naozaj,ostava:longint;
    sub:SearchRec;
    kolko,err:word;
    ch:char;
begin
 ostava:=0;
 if ostava=0 then begin
    Assign  (ff1,subor);
    { $I-}
    ReSet   (ff1,1);
    { $I+}
    if IoResult<>0 then begin hlaska('Archiv nejestvuje na disku.',-1);exit;end;
   end;
 
 Assign  (ff2,cesta+'\'+subor2);
 { $I-}
 ReWrite (ff2,1);
 { $I+}
 if IoResult<>0 then begin hlaska('Nemozny pristup na disk.',-1);exit;end;
 
 FindFirst(subor,Archive or Hidden or ReadOnly,sub);
 if MaxAvail>65535 then kolko:=65535
                   else kolko:=MaxAvail;
 if kolko>sub.size then kolko:=sub.size;
 ostava:=sub.size;naozaj:=kolko;ch:=#0;
 getmem(quick,naozaj);
 teplomer(sub.size-ostava+round(kolko/2),sub.size);
 
 repeat
  BlockRead  (ff1,quick^,kolko,err);
  if keypressed then ch:=readkey;
  if err<>kolko then hlaska('Malo miesta na cielovom disku.',-1);
  teplomer(sub.size-ostava+round(kolko/2),sub.size);
 
  BlockWrite (ff2,quick^,kolko,err);
  if keypressed then ch:=readkey;
  if err<>kolko then exit;
  teplomer(sub.size-ostava+kolko,sub.size);
 
  ostava:=ostava-kolko;
  if kolko>ostava then kolko:=ostava;
 until ((ostava=0) or (ch=#27));
 
 if ostava=0 then close (ff1);
 close (ff2);
 teplomer(sub.size,sub.size);
 freemem(quick,naozaj);
 if (ch=#27) then begin hlaska('Archivacia prerusena uzivatelom.',-1);exit;end;
end;
 
procedure archiv(typ:integer);
var ch,ch1:char;
begin
 if (typ=1) then begin
    repeat
     hlaska('Archiv na disk A B C D',-1);
     ch:=UpCase(readkey);
     if (ch=#27) then begin hlaska('',-2);exit;end;
    until (ch in ['A','B','C','D']);
    hlaska('Archiv na disk '+ch+'  [A/..]',-1);
    ch1:=UpCase(readkey);
    hlaska('',-2);
    if (ch1='A') then begin
       prikaz('pkzip archiv '+dsubor+' '+subor+k_dbf+'>nul');
       prikaz('zip2exe archiv >nul');
{       prikaz('del archiv.zip');}
       prikaz('md '+ch+':\archiv');
       if DosError<>0 then begin
                           hlaska('Disk chraneny proti zapisu, alebo vadny disk.',-1);
                           exit;
                           end;
       t_copy('archiv.exe','archiv.exe',ch+':\archiv');
       prikaz('del archiv.exe');
      end;
    end
    else begin
    repeat
     hlaska('Obnovit archiv z disku A B C D',-1);
     ch:=UpCase(readkey);
     if (ch=#27) then begin hlaska('',-2);exit;end;
    until (ch in ['A','B','C','D']);
    hlaska('Archiv na disk '+ch+'  [A/..]. Obnovit ??? ',-1);
    ch1:=UpCase(readkey);
    hlaska('',-2);
    if (ch1='A') then begin
        t_copy(ch+':\archiv\archiv.exe','archiv.exe','');
        prikaz('archiv.exe -o >nul');
        prikaz('del archiv.exe');
       end;
   end;
 hlaska('',-2);
end;