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

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: Programy v Pascale
zaluzie.pngProgram: Zaluzie.pasArchiv.pasDealer.pasFarba.pasFax.pasFilter.pasFormul.pasFyzic.pasHelp.pasKniznic.pasMiesto.pasMzdy.pasOption.pasPr_zal.pasRead_dbf.pasRedef.pasSdv.pasTlac.pasTrsek.pasZaluz.pasZostavy.pas
Súbor exe: Zaluzie.exe
Potrebné: Zaluzie.zipHelp.datDealerDealer.$$$Fax.datKumuly.$$$Kumuly.frmKumuly.kumMeracMontazOption.dbfOption.frmOption.indPoradie.datVystup.txtZaluzie.dbfZaluzie.datZaluzie.frmZaluzie.indZaluzie.txtZostava.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é).
{ KNIZNIC.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Rutiny pre jednoduchsiu pracu s oknami a retazcami.               }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
unit kniznic;
interface
uses dos,crt;
 
const map_mes:array[1..12] of integer =
              (0,31,59,90,120,151,181,212,243,273,304,334);
 
var xw1,yw1,xw2,yw2:integer;
    z_sound:boolean;            { zapnuty/vypnuty zvuk pre hlasku }
 
procedure twindow(x1,y1,x2,y2:integer);
procedure owindow(x1,y1,x2,y2:integer);
procedure okno(x1, y1, x2, y2:integer; text,podpis:string; bar:integer);
procedure vypln(s:string);
procedure hlaska(s:string;del:integer);
function vali(s:string):longint;
function valr(s:string):real;
function stri(i:longint;k:integer):string;
function strr(i:real;k:integer):string;
function strri(i:real;k:integer;p:integer):string;
function strs(s:string;medzera:boolean):string;
function strsi(s:string;p:integer):string;
function nothing(i:integer):string;
procedure prikaz(s:string);
function ask_date(s:string):string;
function poc_dni(s:string):LongInt;
function get_date(pp:LongInt):string;
function get_realy_date(typ:integer):string;
function s_exist(s:string;velk:integer):boolean;
procedure z_hlava(var strana,poc_y:integer;var f:text;aky_text:string);
 
implementation
 
procedure twindow(x1,y1,x2,y2:integer);
begin
 window(x1,y1,x2,y2);
end;
 
procedure owindow(x1,y1,x2,y2:integer);
begin
 twindow(x1,y1,x2,y2);
 xw1:=x1;yw1:=y1;xw2:=x2;yw2:=y2;
end;
 
procedure okno(x1, y1, x2, y2:integer; text,podpis:string; bar:integer);
var x,y:integer;
begin
 owindow(x1+1,y1+1,x2-1,y2-1);
 textbackground(bar);
 clrscr;
 owindow(1,1,80,25);
 
 for x:=x1+1 to x2-1 do begin
     gotoxy(x,y1);write('Ä');
     gotoxy(x,y2);write('Ä');
     end;
 
 for y:=y1+1 to y2-1 do begin
     gotoxy(x1,y);write('ł');
     gotoxy(x2,y);write('ł');
     end;
 
 gotoxy(x1,y1);write('Ú');
 gotoxy(x2,y1);write('ż');
 gotoxy(x1,y2);write('Ŕ');
 gotoxy(x2,y2);write('Ů');
 textbackground(bar);
 gotoxy(x1+round((x2-x1-length(text))/2),y1);write(text);
 gotoxy(x2-length(podpis)-2,y2);write(podpis);
 owindow(x1+1,y1+1,x2-1,y2-1);
end;
 
procedure vypln(s:string);
var i:integer;
begin
 owindow(xw1+3,yw1+1,xw2-3,yw2-1);
 textbackground(BLUE);textcolor(LIGHTGRAY);
 gotoxy(1,1);
 for i:=1 to round(((xw2-xw1)*(yw2-yw1+2)+18)/length(s)) do write(s);
 textcolor(YELLOW);
end;
 
procedure hlaska(s:string;del:integer);
var i:integer;
    odloz:array[1..2,1..80] of byte;
    reg:registers;
    xo1,yo1,xo2,yo2:integer;
begin
 xo1:=xw1;yo1:=yw1;xo2:=xw2;yo2:=yw2;
 owindow(1,1,80,25);
 textbackground(DARKGRAY);
 for i:=1 to length(s) do begin
   gotoxy(xw1+i,25);
   reg.ah:=8;
   reg.bh:=0;
   intr($10,reg);
   odloz[1,i]:=reg.ah;
   odloz[2,i]:=reg.al;
   end;
 gotoxy(xw1+1,25);
 if del=-2 then write(nothing(78))
           else write(s);
 if z_sound then begin sound(500);delay(3);nosound;end;
 if del=-1 then begin
    owindow(xo1,yo1,xo2,yo2);
    exit;
    end;
 
 if del=0 then repeat until keypressed
          else delay(abs(del)*10);
 
 for i:=1 to length(s) do begin
   gotoxy(xw1+i,25);
   reg.ah:=$9;
   reg.bh:=0;
   reg.al:=odloz[2,i];
   reg.bl:=odloz[1,i];
   reg.cx:=1;
   intr($10,reg);
   end;
 owindow(xo1,yo1,xo2,yo2);
end;
 
function vali(s:string):longint;
var vys:longint;
    err:integer;
begin
 if length(s)<2 then s:='0'+s;                          { Len aby !!! }
 while (pos(' ',s)>0) do delete(s,pos(' ',s),1);
 val(s,vys,err);
 while ( (err<>0) and (s<>'') ) do begin
       delete(s,err,1);
       val(s,vys,err);
       end;
 vali:=vys;
end;
 
function valr(s:string):real;
var err:integer;
    vys:real;
begin
 while (pos(' ',s)>0) do delete(s,pos(' ',s),1);
 val(s,vys,err);
 while ( (err<>0) and (s<>'') )do begin
       delete(s,err,1);
       val(s,vys,err);
       end;
 valr:=vys;
end;
 
function stri(i:longint;k:integer):string;
var s:string;
begin
 str(i:k,s);
 stri:=s;
end;
 
function strr(i:real;k:integer):string;
var s:string;
begin
 str(i:k:2,s);
 strr:=s;
end;
 
function strri(i:real;k:integer;p:integer):string;
var s:string;
begin
 str(i:k:p,s);
 strri:=s;
end;
 
function strs(s:string;medzera:boolean):string;
var i:integer;
    sp:string;
begin
 sp:='';i:=1;
 if medzera then
    while ( (s[i] in [' '..'z']) and (i<=length(s)) ) do
      begin
       sp:=sp+s[i];
       i:=i+1;
      end
   else
    while ( (s[i] in ['!'..'z']) and (i<=length(s)) ) do
      begin
       sp:=sp+s[i];
       i:=i+1;
      end;
 
 strs:=sp;
end;
 
function strsi(s:string;p:integer):string;
var i:integer;
    sp:string;
begin
 sp:='';i:=1;
 while ( (s[i] in [' '..'ţ']) and (i<=length(s)) ) do
  begin
   sp:=sp+s[i];
   i:=i+1;
  end;
 while ( (pos(' ',sp)>0) and (length(sp)>0) ) do delete(sp,pos(' ',sp),1);
 strsi:=nothing(p-length(sp))+copy(sp,1,p);
end;
 
function nothing(i:integer):string;
begin
 nothing:=copy('                                                                                ',1,i);
end;
 
procedure prikaz(s:string);
begin
  SwapVectors;
  Exec(GetEnv('COMSPEC'), '/C '+s);
  SwapVectors;
  if doserror<>0 then hlaska(' Chyba '+stri(doserror,0)+' ',0);
end;
 
function ask_date(s:string):string;
begin
 ask_date:=s[7]+s[8]+'.'+s[5]+s[6]+'.'+copy(s,1,4);
end;
 
function poc_dni(s:string):LongInt;
var p:LongInt;
    r,m,d:integer;
begin
 r:=vali(copy(s,1,4));m:=vali(s[5]+s[6]);d:=vali(s[7]+s[8]);
 poc_dni:=LongInt(r)*365+map_mes[m]+d;
end;
 
function get_date(pp:LongInt):string;
var r,m,d:integer;
        i:integer;
        s:string;
begin
 r:=trunc(pp/365);
 d:=pp-r*365;
 i:=1; while ( (map_mes[i]<=d) and (i<=12) ) do i:=i+1;
 m:=i-1;
 d:=d-map_mes[m]+1;
 s:=stri(r,4);
 if m<10 then s:=s+'0'+stri(m,1)
         else s:=s+stri(m,2);
 
 if d<10 then s:=s+'0'+stri(d,1)
         else s:=s+stri(d,2);
 
 get_date:=s;
end;
 
function get_realy_date(typ:integer):string;
const
  days : array [0..6] of String[8] =
    ('Nede-a','Pondelok','Utorok',
     'Streda','ćtvrtok','Piatok','Sobota');
var
  y, m, d, dow : Word;
  s,c:string;
begin
  GetDate(y,m,d,dow);
  if typ=1 then
     get_realy_date:= days[dow]+'  '+stri(d,0)+ '/'+ stri(m,0)+ '/'+ stri(y,0)
    else
     begin
      c:= copy(stri(y,4),3,2);
      s:= stri(m,0); if length(s)<2 then s:='0'+s;
      c:=c+s;
      s:= stri(d,0); if length(s)<2 then s:='0'+s;
      c:=c+s;
      get_realy_date:=c;
     end;
end;
 
function s_exist(s:string;velk:integer):boolean;
var s_find:SearchRec;
begin
 FindFirst(s,Archive,s_find);
 if velk=1 then begin
    if (DosError=0) and (s_find.size<>0) then s_exist:=true
                                         else s_exist:=false;
    end
   else begin
    if (DosError=0) then s_exist:=true
                    else s_exist:=false;
    end
end;
 
procedure z_hlava(var strana,poc_y:integer;var f:text;aky_text:string);
var err:integer;
begin
 append(f);
 err:=ioresult;
 {$I+}
 if err<>0 then begin hlaska('Chyba z pisu na disk. Pracovně disk chr neně proti z pisu.',0);exit;end;
 if strana<>0 then writeln(f,chr(12));
 poc_y:=2;inc(strana);
 writeln(f,aky_text+' Zo dĺa '+get_realy_date(1)+'           strana:'+stri(strana,0));
 writeln(f,'');
end;
 
 
end.