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

{ TRSEK.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit pre zobrazovanie na obrazovku, citanie z klavesnice.         }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
unit TRSEK;
interface
uses kniznic;
 var strana:array[1..2,1..80,1..24] of byte;
 procedure KurzorZap(ZapVyp:boolean);
 procedure farba(x,y:integer);
 function  tread(x,y:integer;d:byte;s,old:string;sedy,znak:char):string;
 procedure open_win(xl,yl,xp,yp:integer;text:string;color:integer);
 procedure vezmi(x1,y1,x2,y2:integer);
 procedure poloz(x1,y1,x2,y2:integer);
 procedure koniec(naz_prog,rok:string);
 function get_znak(x,y:byte;var farba:byte):byte;
 procedure put_znak(x,y,farba,znak:byte);
 procedure clear_keyb;
 
 implementation
 uses crt,dos;
 
procedure KurzorZap(ZapVyp:boolean);
  var
    Regs : Registers;
  begin
     with Regs do
     begin
        AH := $03;
        BH := $00;
        Intr($10,Regs);
        If not (Zapvyp) then
        CH := CH or $20
        else
        CH := CH and $DF;
        AH := $01;
        Intr($10,Regs);
     end;
  end;
 
procedure farba(x,y:integer);
begin
 if x in [0..15] then textbackground(x);
 if y in [0..15] then textcolor(y);
end;
 
function tread(x,y:integer;d:byte;s,old:string;sedy,znak:char):string;
  var s1,s2,sz:string;
     st:char;
     x1,i,ins:integer;
     prv:boolean;
     label tam;
 begin
   x1:=x;ins:=1;kurzorZap(true);prv:=true;
   if sedy=#255 then prv:=false;
   s:=copy(s,1,d);
   if length(s)<d then for i:=length(s) to d-1 do s:=s+' ';
   gotoxy(x,y);write(s);sz:=s;
   if (x>0) and (x<81) and (y>0) and (y<25) and(x+d<81) then
                              begin
                              gotoxy(x,y);
                              repeat
                              if not(prv) then st:=readkey
                                     else begin
                                       if sedy=#13 then begin
                                           prv:=false;st:=znak;
                                           end
                                          else st:=sedy;
                                      end;
 
         if (st=#27) or (st=#8) or (st=#0) or (st=#13) then
                  begin if st=#0 then
                           begin
                              if prv then st:=znak
                                     else st:=readkey;
                              prv:=false;
                              if st=#59 then s:=old;
                              if st=#75 then x1:=x1-1;
                              if st=#77 then x1:=x1+1;
                              if st=#71 then x1:=x;
                              if st=#79 then begin
                                               i:=d+1;x1:=x+d;
                                               repeat
                                                i:=i-1;
                                                s1:=copy(s,i,1);
                                                if (s1=' ') then x1:=x+i-1;
                                               until  (i=0) or (not(s1=' '));
                                              st:=#0;
                                             end;
                            end;
                        if st=#27 then begin gotoxy(x,y);write(sz);kurzorZap(false);tread:=sz;exit;end;
                        if st=#8  then begin s1:=copy(s,1,x1-x-1);
                                             s2:=copy(s,x1-x+1,d-x1+x);
                                             s:=s1+s2+' ';
                                             x1:=x1-1;
                                       end;
                        if st=#83 then begin s1:=copy(s,1,x1-x);
                                             s2:=copy(s,x1-x+2,d-x1+x);
                                             s:=s1+s2+' ';
                                       end;
                        if st=#82 then begin if ins=2 then ins:=1
                                                      else ins:=2;
                                       end;
 
                  end
                  else begin
                             s1:=copy(s,1,x1-x);
                             s2:=copy(s,x1+ins-x,d-x1+x);
                             s:=s1+copy(st,1,1)+s2;
                             s:=copy(s,1,d);st:='a';
                             x1:=x1+1;if (x1>x+d) then x1:=x+d;
                      end;
        if x1<x then x1:=x;
        if x1>x+d then x1:=x+d;
        s:=copy(s,1,d);
        gotoxy(x,y);write(s);gotoxy(x1,y);
     until ( (st in [#13,#72,#80]) or ( ((x1-x) >= d) and (st in ['0'..'9','-','+','.','A'..'z'])) );
    tread:=s;farba(0,15);kurzorZap(false);
    end;
 end;
 
procedure open_win(xl,yl,xp,yp:integer;text:string;color:integer);
 var i,xs,ys:integer;
    p:real;
 begin
  owindow(xl,yl,xp,yp);
  p:=(yp-yl)/(xp-xl);
  xs:=round((xp-xl)/2)+xl;
  ys:=round((yp-yl)/2)+yl-1;
  textbackground(color);
  for i:=1 to round((xp-xl)/2) do begin
   owindow(xs-i,ys-round(i*p-0.6),xs+i,ys+round(i*p));
   clrscr;
   kurzorzap(false);
   delay(8);
   end;
  owindow(1,1,80,24);
  for i:=xl to xp do begin
   gotoxy(i,yl);write('Í');end;
  gotoxy(xp,yl);write('ť');
  for i:=yl+1 to yp do begin
   gotoxy(xp,i);write('ş');end;
  gotoxy(xp,yp);write('ź');
  for i:=xp-1 downto xl do begin
   gotoxy(i,yp);write('Í');end;
  gotoxy(xl,yp);write('Č');
  for i:=yp-1 downto yl do begin
   gotoxy(xl,i);write('ş');end;
  gotoxy(xl,yl);write('É');
  gotoxy(xs-(length(text) div 2),yl);write(' ',text,' ');
  owindow(xl+1,yl+1,xp-1,yp-1);
end;
 
procedure vezmi(x1,y1,x2,y2:integer);
var i,y:integer;
    reg:registers;
begin
 owindow(1,1,80,25);
 for i:=x1 to x2 do
  for y:=y1 to y2 do begin
   gotoxy(i,y);
   reg.ah:=8;
   reg.bh:=0;
   intr($10,reg);
   strana[1,i,y]:=reg.ah;
   strana[2,i,y]:=reg.al;
   end;
end;
 
procedure poloz(x1,y1,x2,y2:integer);
var i,y:integer;
    reg:registers;
begin
 owindow(1,1,80,25);
 for i:=x1 to x2 do
  for y:=y1 to y2 do begin
   gotoxy(i,y);
   reg.ah:=$9;
   reg.bh:=0;
   reg.al:=strana[2,i,y];
   reg.bl:=strana[1,i,y];
   reg.cx:=1;
   intr($10,reg);
   end;
end;
 
procedure koniec(naz_prog,rok:string);
begin
 farba(BLACK,-1);
 clrscr;
 farba(BLUE,YELLOW);
 writeln;
 writeln(copy(naz_prog+'               ',1,15)+
         ' Software by TRSEK. All right reserved, copyright TRSEK (c) '+rok+'.');
end;
 
function get_znak(x,y:byte;var farba:byte):byte;
var reg:registers;
    xo,yo:integer;
begin
 xo:=wherex;yo:=wherey;
 gotoxy(x,y);
 reg.ah:=8;
 reg.bh:=0;
 intr($10,reg);
 get_znak:=reg.al;
 farba:=reg.ah;
 gotoxy(xo,yo);
end;
 
procedure put_znak(x,y,farba,znak:byte);
var reg:registers;
    xo,yo:integer;
begin
 xo:=wherex;yo:=wherey;
 gotoxy(x,y);
 reg.ah:=$9;
 reg.bh:=0;
 reg.al:=znak;
 reg.bl:=farba;
 reg.cx:=1;
 intr($10,reg);
 gotoxy(xo,yo);
end;
 
procedure clear_keyb;
var Reg:Registers;
begin
 Reg.AX:=$C06;
 Reg.DL:=$FF;
 intr($21,Reg);
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