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

Program: 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é).

{ READ_DBF.PAS              Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit urceny pre citanie DBF citanie/zapis suborov, reindexaciu.   }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
unit READ_DBF;
 
interface
uses crt,dos,kniznic;
const max_viet=80;    { max - kolko moze byt maximalne premennych v 1 vete }
      k_index='.ind';                                   { koncovka pre subor s indexami }
      k_dbf='.dbf';                                     { koncovka pre DBF subor }
      max_ind=5000;
 
type premenna=(C,L,N,D);
                       { typ premennej C-retazec, L-logicka, N-numericka }
                       {               D-datum }
   hlava=record                     { typ tzv. hlavy DBF blizie informacie }
     nazov: array[1..11] of char;   { na horeuvedenej adrese }
     typep: char;
       zac: word;
     none2: array[1..2] of byte;
      size: byte;
     desat: byte;
     none3: array[1..14] of byte;
     end;
 
type   index = word;               { typ indexoveho suboru                 }
 
 
var         base : array[1..max_viet] of string;   { polozky jednej vety                  }
           hlavy : array[1..max_viet] of hlava;    { hlavy (popisy) kazdej z poloziek     }
          indexy : array[1..max_ind]  of index;    { Global indexov }
 
         {  base : tbase;
           hlavy : thlavy;
          indexy : tindexy;}
                f: file of char;   { nacitava jednotlive vety DBF          }
               ff: file of hlava;  { nacitava hlavy DBF                    }
    poc,dtab,dvet: word;           { poc-pocet viet, dtab-dlzka tabulky    }
                                   { hlavy, dvet-velkost jednej vety v kB  }
             spoc: word;           { Realny, skutocny pocet viet           }
      den,mes,rok: byte;           { den,mesiac,rok z DBF                  }
           typdbf: byte;           { typ dBase, prvy byt DBF               }
               pp: integer;        { pp-pocet premennych vo vete           }
                                   { rpp-kolko premennych vypisat z vety   }
          AllSize: LongInt;        { celkova velkost suboru DBF            }
         SAllSize: LongInt;        { Skutocna celkova velkost suboru DBF   }
              i,x: integer;        { pomocne premenne                      }
           fyzvet: word;           { cislo aktualnej (fyzickej) vety v DBF }
           relvet: word;           { cislo relativnej vety                 }
 r_od,r_do,r_size: longint;        { od,do fyzicky precital dbf            }
            quick: pointer;        { pointer na fyzicke citanie dbf        }
            kolko: longint;        { kolko je fyzicky citane               }
 
 
function  nothing    ( i :integer) :string;
procedure closebase;
procedure opendbase  ( meno :string );
function  get_index  ( i_subor :string; i:word ) :word;
procedure put_index  ( i_subor :string; p,i:word );
procedure r_read     ( subor:string; r_seek:longint);
procedure r_write    ( subor:string );
procedure write_poc  ( meno:string; poc:word );
procedure cit_mem    ( meno:string; dbf_veta:longint );
procedure zap_mem    ( meno:string; dbf_veta:longint );
procedure cit_vety   ( meno :string; dbf_veta:word );
procedure zap_vety   ( meno :string; dbf_veta:word );
procedure clear_all_index;
procedure put_all_index ( meno :string );
implementation
 
function nothing(i:integer):string;
begin
 nothing:=copy('                                                                                ',1,i);
end;
 
procedure closebase;
begin
 freemem(quick,kolko);
 kolko:=0;
end;
 
procedure opendbase(meno:string);                    { otvor DBF a precitaj z nej hlavy }
var sub:SearchRec;
     ch:char;
     p:word;
   i_f:file of index;
   akt:integer;
begin
 
 if kolko>0 then closebase;
 assign(f,meno+k_dbf);
 {$I-}
 reset(f);
 {$I+}                                  { ak DBF nejestvuje }
 if ioresult<>0 then begin
    writeln('Subor bud nejestvuje, alebo nieje spravna cesta.');
    halt(0);
    end;
 
 findfirst(meno+k_dbf,Archive,Sub);           { zisti jeho velkost }
 AllSize:=Sub.Size;
 SAllSize:=Sub.Size;
 read(f,ch);typdbf:=ord(ch);            { precitaj uvodne info typ dBase      }
 read(f,ch);rok:=ord(ch);               { den, mesiac, rok poslednej editacie }
 read(f,ch);mes:=ord(ch);
 read(f,ch);den:=ord(ch);
 
 read(f,ch);poc:=ord(ch);
 read(f,ch);poc:=poc+256*ord(ch);
 spoc:=poc;                             { Aky je skutocny pocet viet }
 for i:=1 to 3 do read(f,ch);
                                        { zisti velkost tabulky hlav }
 dtab:=ord(ch);read(f,ch);dtab:=dtab+256*ord(ch);
 pp:=round(dtab/32)-1;                  { dtab/32-1= pocet premennych }
                                        { ale vypisuje najviac 20 z jednej vety }
 read(f,ch);dvet:=ord(ch);
 read(f,ch);dvet:=dvet+256*ord(ch);     { zisti dlzku jednej vety }
 close(f);
 
 assign(ff,meno+k_dbf);
 reset(ff);
 read(ff,hlavy[1]);                     { toto precita hlavu hlav }
                                        { pekne sprosto som to nazval }
 for i:=1 to pp do
  read(ff,hlavy[i]);                    { toto cita hlavu kazdej premennej }
 close(ff);                             { co vsetko obsahuje ??? }
                                        { kontakt na programatora je v zahlavy }
 for i:=1 to pp do
  case hlavy[i].typep of                { nastavi velkost premennych pre jednotlive }
                                        { premenne podla hlavy }
   'C':base[i]:=nothing(hlavy[i].size);
   'L':base[i]:=nothing(1);
   'N':if hlavy[i].desat>0 then base[i]:=nothing(hlavy[i].size)
                           else base[i]:=nothing(hlavy[i].size+hlavy[i].desat);
   'D':base[i]:=nothing(8);
   end;
 
   FindFirst(meno+k_index,Archive,Sub);
   if DosError<>0 then begin
      hlaska('Vytvaram INDEXOVY subor '+meno+k_index,-1);
      akt:=0;clear_all_index;
      for p:=1 to poc do begin
          inc(akt);indexy[akt]:=p;
          if akt>=max_ind then begin
             put_all_index(meno);
             akt:=0;
             end;
          end;
      put_all_index(meno);
      hlaska('                                     ',-1);
      end
     else begin
      assign(i_f,meno+k_index);
      reset(i_f);
      poc:=FileSize(i_f)-1;
      AllSize:=dtab+1+longint(poc)*longint(dvet);
      close(i_f);
      end;
{ Kvoli rychlosti ...}
 
  FindFirst(meno+k_dbf,Archive or Hidden or ReadOnly,sub);
  kolko:=MaxAvail;
  if MaxAvail>66035 then kolko:=65535
                    else kolko:=MaxAvail-500;
 
  if kolko>Sub.Size then kolko:=Sub.Size;
  kolko:=round(MaxAvail/2);
  r_size:=Sub.Size;
  getmem(quick,kolko);
  r_od:=0;r_do:=0;
end;
 
function get_index(i_subor:string;i:word):word;
var   i_f:file of index;
  p_index:index;
begin
 p_index:=0;
 assign(i_f,i_subor+k_index);
 {$I-}
 reset(i_f);
 if FileSize(i_f)>i then begin
    seek(i_f,i);
    read(i_f,p_index);
 
    { Dodatocne uprav Globalne premenne pocet a Velkost DBF }
    poc:=FileSize(i_f)-1;
    AllSize:=dtab+1+longint(poc)*longint(dvet);
   end                          { Co ak sa pyta na neexistujuci index ??? }
   else p_index:=0;
 {$I+}
 if IoResult=0 then close(i_f);
 
 get_index:=p_index
end;
 
procedure put_index(i_subor:string;p,i:word);
var   i_f:file of index;
  p_index:index;
       pp:word;
begin
  p_index:=0;
  assign(i_f,i_subor+k_index);
  {$I-}
  Reset(i_f);
  {$I-}
  if IoResult<>0 then
     ReWrite(i_f);
 
  if FileSize(i_f)<=p then
     for pp:=p to FileSize(i_f) do begin
         seek(i_f,pp);write(i_f,p_index);
         end;
  seek(i_f,p);
  write(i_f,i);
 
  { Dodatocne uprav Globalne premenne pocet a Velkost DBF }
  poc:=FileSize(i_f)-1;
  AllSize:=dtab+1+longint(poc)*longint(dvet);
 
  close(i_f);
end;
 
procedure r_read(subor:string;r_seek:longint);
var ff1:file;
    err:word;
begin
 Assign  (ff1,subor);
 {$I-}
 ReSet   (ff1,1);
 {$I+}
 if IoResult<>0 then exit;
 if r_seek>r_size then begin close (ff1);exit;end;
 
 r_od:=r_seek;r_do:=r_seek+kolko;
 if r_do>r_size then r_do:=r_size;
 
 Seek(ff1,r_od);
 BlockRead  (ff1,quick^,word(r_do-r_od),err);
 if err>word(r_do-r_od) then hlaska('Chyba fyzickeho citania DBF opusti program !!!',0);
 
 close (ff1);
end;
 
procedure r_write( subor:string );
var ff1:file;
    err:word;
begin
 Assign  (ff1,subor);
 {$I-}
 ReSet   (ff1,1);
 {$I+}
 if IoResult<>0 then exit;
 
 Seek(ff1,r_od);
 BlockWrite (ff1,quick^,word(r_do-r_od),err);
 if err>word(r_do-r_od) then hlaska('Chyba fyzickeho citania DBF opusti program !!!',0);
 
 close (ff1);
end;
 
procedure write_poc ( meno:string; poc:word );
var f:file of byte;
    b1,b2:byte;
    porov:longint;
begin
  b1:=trunc(poc/256);b2:=poc-b1*256;
 
  assign(f,meno+k_dbf);
  reset(f);
  seek(f,4);
  write(f,b2);write(f,b1);
 
  porov:=dtab+longint(poc)*longint(dvet);
  seek(f,porov);
  truncate(f);
  close(f);
 
  SAllSize:=dtab+longint(poc)*longint(dvet);
  AllSize:=SAllSize;
end;
 
procedure cit_mem( meno:string; dbf_veta:longint );
var  p:pointer;
     i:integer;
 zacni:longint;
begin
 zacni:=dtab+LongInt(dbf_veta)*LongInt(dvet)+1;
 if zacni+dvet>r_do then r_read(meno,zacni);
 if zacni     <r_od then r_read(meno,zacni);
 
 p:=Ptr(Seg(quick^),Ofs(quick^)+zacni-r_od);
 
 for x:=1 to pp do                     { nastrka to do premennych }
  for i:=1 to hlavy[x].size do begin
   base[x][i]:=chr(byte(p^));
   p:=Ptr(Seg(p^),Ofs(p^)+1);
   end;
end;
 
procedure zap_mem( meno:string; dbf_veta:longint );
var   p:pointer;
      i:integer;
  zacni:longint;
  nutne:boolean;
begin
 nutne:=false;
 zacni:=dtab+LongInt(dbf_veta)*LongInt(dvet)+1;
 p:=Ptr(Seg(quick^),Ofs(quick^)+zacni-r_od);
 
 if zacni+dvet>r_size then begin
    zacni:=r_od+dvet;
    r_read(meno,zacni);
    r_do:=r_do+dvet;
    r_size:=r_size+dvet;
    r_write(meno);
   end;
 
 for x:=1 to pp do                     { nastrka to do premennych }
  for i:=1 to hlavy[x].size do begin
   if base[x][i]<>chr(byte(p^)) then begin
      byte(p^):=ord(base[x][i]);
      nutne:=true;
     end;
   p:=Ptr(Seg(p^),Ofs(p^)+1);
   end;
 
 if nutne then r_write(meno);
end;
 
procedure cit_vety(meno:string; dbf_veta:word);
var     p:integer;
    porov:LongInt;
begin
 relvet:=dbf_veta;
 dbf_veta:=get_index(meno,dbf_veta);
 fyzvet:=dbf_veta;
 if dbf_veta<1 then exit;
 dbf_veta:=dbf_veta-1;
 
 porov:=dtab+longint(dbf_veta+1)*longint(dvet);
 if (Porov>SAllSize) then exit;
 cit_mem(meno+k_dbf,dbf_veta);
end;
 
procedure zap_vety( meno:string; dbf_veta:word);
var porov:longint;
    i:word;
    p:pointer;
begin
 relvet:=dbf_veta;
 dbf_veta:=get_index(meno,dbf_veta);
 fyzvet:=dbf_veta;
 if dbf_veta<1 then begin                 { Zapis novej vety }
    dbf_veta:=spoc+1;inc(spoc);
    put_index(meno,relvet,dbf_veta);
    end;
 dbf_veta:=dbf_veta-1;
 
 porov:=dtab+longint(dbf_veta+1)*longint(dvet);
 if (Porov>SAllSize) then begin
     inc(poc);spoc:=dbf_veta+1;
     write_poc(meno,spoc);
     AllSize:=dtab+longint(poc+1)*longint(dvet);
    end;
 
 zap_mem(meno+k_dbf,dbf_veta);
end;
 
procedure clear_all_index;
var i:integer;
begin
 for i:=1 to max_ind do indexy[i]:=0;
end;
 
procedure put_all_index( meno :string );
var   i_f:file of index;
  p_index:index;
       pp:word;
        i:integer;
begin
  p_index:=0;
  assign(i_f,meno+k_index);
  {$I-}
  Reset(i_f);
  {$I-}
  if IoResult<>0 then begin
     ReWrite(i_f);
     seek(i_f,1);
     end;
 
  for i:=1 to max_ind do
      if indexy[i]<>0 then write(i_f,indexy[i]);
 
  { Dodatocne uprav Globalne premenne pocet a Velkost DBF }
  poc:=FileSize(i_f)-1;
  AllSize:=dtab+1+longint(poc)*longint(dvet);
 
  close(i_f);
  clear_all_index;
end;
 
end.

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

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V jiných jazycích