; verze z 31.3.2002
; Autor: WinDUO Team

Name('Individuální slevy')      ; pod tímto názvem bude sestava v menu
Designed('Adrman')                ; sestava bude dostupná z okna Adrman
Author('Winduo Team','EMail: winduo@winduo.cz','http://www.winduo.com','http://www.winduo.cz')  ;informace o autorovi
Descr('Výpis slev evidovaných u položek adresáře')  ;popis sestavy, tento text bude v bublince

UsageFilter(Program.Sklady);

WnsType(1);

ASort:Byte;
SSort:Byte;

DefDialog('Zvolte třídění',210,132)
DlgShade(-1,'',4,4,200,60)
DlgStatic(-1,'&Adresář',16,12,78)
DlgCombo(101,ASort,100,8,100,256,10,cbs_DropDownList,'Název','IČ');
DlgOnlineHelp(101,'Zde zvolíte, jak si přejete třídit firmy v rámci sestavy');
DlgStatic(-1,'&Sklad',16,40,78)
DlgCombo(102,SSort,100,36,100,256,10,cbs_DropDownList,'Název','Číslo');
DlgOnlineHelp(102,'Zde zvolíte, jak si přejete třídit skladové karty v rámci jedné firmy');

DlgButton(id_OK,,72,66);
DlgButton(id_Cancel,,138,66);
if(DlgExecute(True)<>id_OK)
   Halt;

DeclareRec('Sleva');
DeclareRec('KeySleva1');
DeclareRec('Adresar')             ; přiřadí a definuje větu z adresáře
DeclareRec('KeyAdresar1')         ; přiřazení a definice třídícího klíče
DeclareRec('Sklad');
DeclareRec('KeySklad10')
DeclareRec('Ciselnik');
DeclareRec('KeyCiselnik1')

Veta:LongInt                      ; definuje proměnnou
VetaA:LongInt
VetaS:LongInt
VetaC:LongInt

Record TempKey_0_0
  Length  :Byte
  Nazev_A :Array[1..35] of Char;
  Typ     :Byte
  Nazev   :Array[1..35] of Char;
  VetaA   :LongInt;
  Veta    :LongInt;
end;

Record TempKey_0_1
  Length  :Byte
  Nazev_A :Array[1..35] of Char;
  Typ     :Byte
  Kod     :Array[1..14] of Char;
  VetaA   :LongInt;
  Veta    :LongInt;
end;

Record TempKey_1_0
  Length  :Byte
  ICO     :LongInt;
  Typ     :Byte
  Nazev   :Array[1..35] of Char
  VetaA   :LongInt;
  Veta    :LongInt
end;

Record TempKey_1_1
  Length  :Byte
  ICO     :LongInt
  Typ     :Byte
  Kod     :Array[1..14] of Char
  VetaA   :LongInt;
  Veta    :LongInt
end;

if(ASort=1)
  begin
    if(SSort=1)
      begin
        TempKey:TempKey_1_1
      end else
      begin
        TempKey:TempKey_1_0
      end;
  end else
  begin
    if(SSort=1)
      begin
        TempKey:TempKey_0_1
      end else
      begin
        TempKey:TempKey_0_0
      end;
  end;

MakeTempFile(,TempKey,False,False);

LastICO:LongInt
Pozice:LongInt

InitStatus(UsedKeys(KeySleva1),'Třídím data');

ClearKey(KeySleva1)             ; resetuje ukazatel aktuální věry v souboru
While(NextKey(KeySleva1,Veta))  ; začátek cyklu přes celý soubor
  begin                           ; začátek příkazu pro zpracování jedné věty
     ReadRec(Sleva,Veta)        ; přečte větu ze souboru
     if(Sleva.ICO<>LastICO)
       begin
         KeyAdresar1.Length=4
         KeyAdresar1.ICO=SwapL(Sleva.ICO)
         if(FindKey(KeyAdresar1,VetaA))
           begin
             ReadRec(Adresar,VetaA);
           end else
           begin
             ClearRec(Adresar);
             VetaA=0
           end;
         LastICO=Sleva.ICO
       end;
     if(InFilter(Adresar))        ; dotaz, zda věta prošla filtrem
       begin                      ; začátek příkazu pro operace s těmi, které prošly filtrem
         if(Sleva.Typ=0)
           begin
             KeySklad10.Length=4
             KeySklad10.Cislo=SwapL(Sleva.Material)
             if(FindKey(KeySklad10,VetaS))
               begin
                 ReadRec(Sklad,VetaS);
                 ClearRec(TempKey);
                 TempKey.Length=SizeOf(TempKey)-1;
                 if(ASort=1)
                   TempKey.ICO=SwapL(Adresar.ICO)
                 else
                   StrToChars(TempKey.Nazev_A,XTransStr(Adresar.Nazev))
                 if(SSort=1)
                   StrToChars(TempKey.Kod,Sklad.Material)
                 else
                   StrToChars(TempKey.Nazev,XTransStr(Sklad.Nazev))
                 TempKey.VetaA=SwapL(VetaA)
                 TempKey.Veta=SwapL(VetaS)
                 AddKey(TempKey,Veta);
               end;
           end else
         if((Sleva.Typ=1) or (Sleva.Typ=2))
           begin
             ClearRec(KeyCiselnik1);
             KeyCiselnik1.Length=SizeOf(KeyCiselnik1)-1;
             KeyCiselnik1.Druh=Swap(Sleva.Typ);
             KeyCiselnik1.Kod=SwapL(Sleva.Druh);
             if(FindKey(KeyCiselnik1,VetaC))
               begin
                 ReadRec(Ciselnik,VetaC);
                 ClearRec(TempKey);
                 TempKey.Length=SizeOf(TempKey)-1;
                 if(ASort=1)
                   TempKey.ICO=SwapL(Adresar.ICO)
                 else
                   StrToChars(TempKey.Nazev_A,XTransStr(Adresar.Nazev))
                 if(SSort=1)
                   StrToChars(TempKey.Kod,Str(Ciselnik.Kod,14))
                 else
                   StrToChars(TempKey.Nazev,XTransStr(Ciselnik.Popis))
                 TempKey.Typ=Sleva.Typ;
                 TempKey.VetaA=SwapL(VetaA)
                 TempKey.Veta=SwapL(VetaC)
                 AddKey(TempKey,Veta);
               end;
           end;
       end;
     Inc(Pozice);
     SetStatus(Pozice)
  end                             ; konec příkazu pro zpracování jedné věty

InitStatus(UsedKeys(TempKey),'Tvořím sestavu');

NewWns('AdrSlevy.WNS');

SetDescr(0,0,TA_Right|descr_PageNum,'Strana: ');
SetDescr(1,1,TA_Center,'Výpis individuálních slev v adresáři');
SetDescr(2,0,TA_Left|descr_Date,'Datum: ');
SetDescr(3,2,TA_Left|descr_UserDescr,''); pokud je pouzit descr_UserDescr, tak si program vyzada dodatecny popis
if(IsFilter(Adresar))             ; dotaz, zda je aktivní filtr do sestav
  begin
    SetDescr(4,2,TA_Right,'Aktívní filtr');
  end

SetColumn(0,ta_Left,10); {typ}
SetColumn(1,ta_Right,4); {Sklad}
SetColumn(2,ta_Left,14); {Cislo}
SetColumn(3,ta_Left,35); {Nazev}
SetColumn(4,ta_Left,11); {Sleva}
SetColumn(5,ta_Right,12);{Cena}
SetColumn(6,ta_Right,12);{Cena}

SetHead('Typ\tSklad\tČíslo\tNázev\tSleva\tCena\tIndiv.cena');

LastVetaA:LongInt;
LocD:Double;
Sleva:Double;
ClearRec(Adresar);
LastTyp:Byte;

ClearKey(TempKey)
While(NextKey(TempKey,Veta))
  begin
    ReadRec(Sleva,Veta);
    if(TempKey.VetaA<>LastVetaA)
      begin
        if(Veta<>0)
          ReadRec(Adresar,SwapL(TempKey.VetaA));
        else
          ClearRec(Adresar);
        LastVetaA=TempKey.VetaA;
        LastTyp=TempKey.Typ;
        AddComment();
        AddComment(Adresar.Nazev,,'IČ: '+Str(Adresar.ICO));
      end else
    if(TempKey.Typ<>LastTyp)
      begin
        LastTyp=TempKey.Typ;
        AddComment();
      end;
    if(Sleva.Typ=0)
      begin
        if(TempKey.Veta<>0)
          begin
            ReadRec(Sklad,SwapL(TempKey.Veta));
          end else
          begin
            ClearRec(Sklad);
          end;
        AddText('Položka\t')
        AddText(Str(Sklad.Sklad,0,0,True),Sklad.Material,Sklad.Nazev);
        if(Sleva.AktCena)
          begin
            AddText(,,,StrPrice(Sleva.Cena))
          end else
          begin
            AddText(,StrNative(Sleva.Sleva,2)+'%'+' z ceny '+Char(Sleva.ZCeny+Asc('A')))
            if(Sleva.ZCeny<4)
              begin
                Sleva=RoundFloat((100-Sleva.Sleva)/100,-2);
                if(Sleva.ZCeny=0)
                  LocD=Sklad.CenaA;
                else
                if(Sleva.ZCeny=1)
                  LocD=Sklad.CenaB;
                else
                if(Sleva.ZCeny=2)
                  LocD=Sklad.CenaC;
                else
                if(Sleva.ZCeny=4)
                  LocD=Sklad.CenaD;
                LocD=RoundPrice(LocD*Sleva)
                AddText(,StrPrice(LocD))
              end;
          end;
      end else
    if((Sleva.Typ=1) or (Sleva.Typ=2))
      begin
        if(TempKey.Veta<>0)
          begin
            ReadRec(Ciselnik,SwapL(TempKey.Veta));
          end else
          begin
            ClearRec(Ciselnik);
          end;
        if(Sleva.Typ=1)
          begin
            AddText('Druh\t\t')
          end else
        if(Sleva.Typ=2)
          begin
            AddText('Sklad\t\t')
          end;
        AddText(Str(Ciselnik.Kod),Ciselnik.Popis,StrNative(Sleva.Sleva,2)+'%'+' z ceny '+Char(Sleva.ZCeny+Asc('A')),'xxx','xxx')
      end;
    NextLine;
  end;

END                               ; konec programu