; vyhodnocení odběratelů (žebříček)
; verze z 8.6.2010
; Autor: WinDUO Team

Name('Hodnocení odběratelů/dodavatelů')
Designed('ZavMan#1','PohlMan#1')
;Designed('PohlMan#1')
Author('Winduo Team','EMail: winduo@winduo.cz','http://www.winduo.com','http://www.winduo.cz')
Descr('Vyhodnotí a sestaví žebříček odběratelů / dodavatelů','Změna třídění - Ne','Filtr - Ano')  ;popis sestavy, tento text bude v bublince


NewWNS('zebrick1.WNS','Vyhodnocení odběratelů / dodavatelů')
WNSType(1);
DeclareRec('Program')
LocB:Boolean
LocB1:Boolean
LocBo:Boolean
LocW:Word
Veta:LongInt
VetaD:LongInt
VetaA:LongInt
VetaP:LongInt
LocStr:String
Pozice:LongInt
OdData:Word
DoData:Word
SOdData:String
SDoData:String
Castka:Real
SumCastka:Real
mICO:LongInt
Zpusob1:Boolean=True
Zpusob2:Boolean
BezDPH:Real
NizsiDPHZaklad:Real
VyssiDPHZaklad:Real
DatumD:Boolean=True
DatumV:Boolean
DatumS:Boolean
DatumDPH:Boolean
DatumDotaz:String
DatumHlav:String
PocetPohl:Word
ValidDatum:String='0123456789.'
ValidNumer:String='0123456789'
TiskDetaily:Boolean
VetaF:LongInt
BeruZalohy:Boolean
Beru:Boolean
Zalohovka:Boolean
Vysledek:String
Nulove:Boolean
Limit:Boolean
LimitR:Real=10000

Kniha:String
LocStrIco:String
LocStrCastka:String
LocStrCislo:String
LocStrDoklad:String
LocStrPopis:String
LocStrKeyIco:String
Text1:String
Text2:String
Zaznam2M:String
Zaznam1J:String
Zaznam1M:String
Odkud:String[1]=UpCase(Copy(GetBindName(),1,1))
if(CompareStr(Odkud,'P'))
  begin
    Zaznam1J='pohledávka'
    Zaznam1M='pohledávky'
    Zaznam2M='pohledávek'
  end else
  begin
    Zaznam1J='závazek'
    Zaznam1M='závazky'
    Zaznam2M='závazků'
  end

;definice dialogu
;DlgFollowMouse(True)
AktualCover:Integer=0
DefDialog('Upřesnění',342,372-48)
DlgShade(-1,'',4,4,332,298-46)
DlgButton(id_OK,'OK',202,306-46);
DlgOnLineHelp(id_OK,'Pokračuje ve zpracování')
DlgButton(id_Cancel,'Zpět',272,306-46);
DlgOnLineHelp(id_Cancel,'Ukončí bez zpracování')

DlgStatic(-1,'Vyhodnocení od data',10,16,140)
DlgEditDate(101,SOdData,150,11,78,22,10,,ValidDatum)
DlgOnLineHelp(101,'Vyhodnocení '+Zaznam2M+' bude provedeno za interval od data')
DlgStatic(-1,'do',234,16,18)
DlgEditDate(102,SDoData,254,11,78,22,10,,ValidDatum)
DlgOnLineHelp(102,'Vyhodnocení '+Zaznam2M+' bude provedeno za interval do data')

DlgStatic(-1,'Vyhodnotit podle:',10,40,115)
DlgRadioButton(105,DatumD,124,40,120,,'data dokladu',105,108)
DlgOnLineHelp(105,'Vyhodnocení bude podle data dokladu')
DlgRadioButton(106,DatumV,124,62,130,,'data vystavení',105,108)
DlgOnLineHelp(106,'Vyhodnocení bude podle data vystavení dokladu')
DlgRadioButton(107,DatumS,124,84,130,,'data splatnosti',105,108)
DlgOnLineHelp(107,'Vyhodnocení bude podle data splatnosti dokladu')
DlgRadioButton(108,DatumDPH,124,106,130,,'data DPH',105,108)
DlgOnLineHelp(108,'Vyhodnocení bude podle data uskutečnění DPH')

DlgStatic(-1,'Vyhodnotit podle:',10,128,115)
DlgRadioButton(111,Zpusob1,124,128,120,,'částky celkem',111,112)
DlgOnLineHelp(111,'Žebříček bude sestaven podle částky v pohledávce')
DlgRadioButton(112,Zpusob2,124,150,130,,'částky bez DPH',111,112)
DlgOnLineHelp(112,'Žebříček bude sestaven podle údajů v rozkontu. '+Zaznam1M+' musí být rozkontovány')

DlgCheckBox(114,TiskDetaily,10,172,320,,'tisknout včetně detailního rozpisu')
DlgOnLineHelp(114,'Lze tisknout pouze součtové řádky nebo i detailní rozpis ' '+Zaznam2M)

DlgCheckBox(115,BeruZalohy,10,192,320,,'zařadit zálohové '+Zaznam1M+' do výpočtu')
DlgOnLineHelp(115,'Lze tisknout pouze součtové řádky nebo i detailní rozpis ' '+Zaznam2M)

DlgCheckBox(116,Nulove,10,212,320,,'Tisknout i nulové IČ')
DlgCheckBox(117,Limit,10,232,204,,'Pouze částky celkem IČ od')
DlgEdit(118,LimitR,214,228,116,,12,ES_RIGHT,'-0123456789.',0,True);

Result:Integer=DlgExecute(True)

if(Result<>id_OK)
  Halt

if(Length(Trim(SOdData))=0)
  SOdData='1.1.1980'
OdData=ValDate(SOdData)

DoData=ValDate(SDoData)
Text2=StrDate(OdData)+' - '+StrDate(DoData)
if(DoData=0)
  begin
    DoData=65535
    Text2='od '+StrDate(OdData)
  end


if(CompareStr(Odkud,'P'))
  begin
    DeclareRec('Pohledavka')
    DeclareRec('KeyPohledavka3')
    DeclareRec('Faktura')
    DeclareRec('KeyFaktura1')
    Kniha='Pohledavka'
    LocStrIco='Pohledavka.Ico'
    LocStrCastka='Pohledavka.Castka'
    LocStrCislo='Pohledavka.Cislo'
    LocStrDoklad='Pohledavka.Doklad'
    LocStrPopis='Pohledavka.Popis'
    LocStrKeyIco='KeyPohledavka3.Ico'
    Text1='Vyhodnocení odběratelů za období '
    if(DatumD)
      begin
        DatumDotaz='Pohledavka.Datum'
        DatumHlav='data dokladu'
      end
    if(DatumV)
      begin
        DatumDotaz='Pohledavka.DatVyst'
        DatumHlav='data vystavení'
      end
    if(DatumS)
      begin
        DatumDotaz='Pohledavka.DatSpl'
        DatumHlav='data splatnosti'
      end
    if(DatumDPH)
      begin
        DatumDotaz='Pohledavka.Datum_zp'
        DatumHlav='data uskutečnění DPH'
      end
  end else
  begin
    DeclareRec('Zavazek')
    DeclareRec('KeyZavazek3')
    Kniha='Zavazek'
    LocStrIco='Zavazek.Ico'
    LocStrCastka='Zavazek.Castka'
    LocStrCislo='Zavazek.Cislo'
    LocStrDoklad='Zavazek.Doklad'
    LocStrPopis='Zavazek.Popis'
    LocStrKeyIco='KeyZavazek3.Ico'
    Text1='Vyhodnocení dodavatelů za období '
    if(DatumD)
      begin
        DatumDotaz='Zavazek.Datum'
        DatumHlav='data dokladu'
      end
    if(DatumV)
      begin
        DatumDotaz='Zavazek.DatVyst'
        DatumHlav='data vystavení'
      end
    if(DatumS)
      begin
        DatumDotaz='Zavazek.DatSpl'
        DatumHlav='data splatnosti'
      end
    if(DatumDPH)
      begin
        DatumDotaz='Zavazek.Datum_zp'
        DatumHlav='data uplatnění DPH'
      end
  end

DeclareRec('Denik')
DeclareRec('KeyDenik7')
DeclareRec('Adresar')
DeclareRec('KeyAdresar1')
Klic:String='Key'+kniha+'3'
KlicICO:String=Klic+'.ICO';

Record NovaVeta
  ico   :LongInt;
  Castka:Real;
  Pocet :Word
  nic   :String[8]
end;


Record NovyKlic
  Length:Byte;
  Castka:Real;
  ico   :LongInt;
end;
TempPohl:NovaVeta
TempKlic:NovyKlic
MakeTempFile(TempPohl,TempKlic,True)


SetDescr(0,0,TA_Right|descr_PageNum,'Strana: ');
SetDescr(1,0,TA_Center,Text1+Text2+' podle '+DatumHlav);
SetDescr(2,0,TA_Left|descr_Date,'Datum: ');
SetDescr(3,1,TA_Left|descr_UserDescr,''); pokud je pouzit descr_UserDescr, tak si program vyzada dodatecny popis
if(IsFilter(Kniha))             ; dotaz, zda je aktivní filtr do sestav
  begin
    SetDescr(4,1,TA_Right,'Aktívní filtr');
  end


SetColumn(0,ta_Right,5)    ;por.cislo
SetColumn(1,ta_Left,8)     ;ICO
SetColumn(2,ta_Left,30)    ;nazev
SetColumn(3,ta_Left,30)    ;nazev
SetColumn(4,ta_Right,12)   ;Castka
SetColumn(5,ta_Right,4)    ;Pocet
SetHead('P.č.\tIČ\tFirma\tMěsto\tČástka\tPočet');

InitStatus(UsedKeys(@Klic),,'Analyzuji záznamy pro součtovou tabulku') ; inicializace stavoveho prouzku
;ClearKey(@Klic)
;ReadRec(@Kniha,Veta)
;mICO=@LocStrIco
Castka=0
ClearKey(@Klic)
LocB=NextKey(@Klic,Veta)
While(LocB)
  begin
    ReadRec(@Kniha,Veta)
    TempPohl.Ico=@LocStrIco
    TempKlic.Length=SizeOf(TempKlic)-1;
    TempKlic.ico=Swapl(@LocStrIco)
    Castka=0
    mICO=@LocStrIco
    if((Nulove) or (mICO<>0))
      begin
        PocetPohl=0
        While((@KlicICO=SwapL(mICO))and(LocB))
          begin
            ReadRec(@Kniha,Veta)
            if(InFilter(@Kniha))        ; dotaz, zda věta prošla filtrem
              begin                      ; začátek příkazu pro operace s těmi, které prošly filtrem
                ;zjistění, zda je zálohová:
                Beru=True
                Zalohovka=False
                JeZalohovka('Zalohovka')
                if((not BeruZalohy)and(Zalohovka))
                  Beru=False

                ;cyklus pro zjištění částky
                if((@DatumDotaz>=OdData)and(@DatumDotaz<=DoData)and(beru))
                  begin
                    if(Zpusob1)
                      begin
                        Castka=Castka+@LocStrCastka
                      end
                    if(Zpusob2)
                      begin
                        KeyDenik7.Length=4
                        KeyDenik7.Cislo=SwapL(@LocStrCislo)
                        LocBo=SearchKey(KeyDenik7,VetaD)
                        if((@LocStrCislo=SwapL(KeyDenik7.Cislo)) and (LocBo))
                          begin
                            ; cyklus pres interni cislo
                            NizsiDPHZaklad=0
                            VyssiDPHZaklad=0
                            BezDPH=0
                            While((@LocStrCislo=SwapL(KeyDenik7.Cislo))and(LocBo))
                              begin
                                ReadRec(Denik,VetaD)        ; přečte větu ze souboru
                                if(Denik.DanT&$C0=$80)      ; zaklad dane
                                  begin
                                    if(Denik.DanT&$30=0)
                                      begin
                                        BezDPH=BezDPH+Denik.Castka
                                      end else
                                    if(Denik.DanT&$30=$10)
                                      begin
                                        NizsiDPHZaklad=NizsiDPHZaklad+Denik.Castka
                                      end else
                                    if(Denik.DanT&$30=$20)
                                      begin
                                        VyssiDPHZaklad=VyssiDPHZaklad+Denik.Castka
                                      end;
                                  end
                                  ;else
                                ;if(Denik.DanT&$C0=$C0)      ; dan
                                ;  begin
                                    ;if(Denik.DanT&$30=$10)
                                    ;  begin
                                    ;    NizsiDPHDan=NizsiDPHDan+Denik.Castka
                                    ;  end else
                                    ;if(Denik.DanT&$30=$20)
                                    ;  begin
                                    ;    VyssiDPHDan=VyssiDPHDan+Denik.Castka
                                    ;  end;
                                ;  end;
                                ;skok na dalsi vetu
                                LocBo=NextKey(KeyDenik7,VetaD);
                              end;
                            Castka=Castka+NizsiDPHZaklad+VyssiDPHZaklad+BezDPH
                          end else
                          begin
                            ; v případě, že není rozkont
                          end
                      end
                    Temp1:
                      Inc(PocetPohl)
                  end
              end
            LocB=NextKey(@Klic,Veta)
            Inc(Pozice)                  ; zvyseni citace zpracovanych vet
            SetStatus(Pozice)            ; nastaveni stavoveho prouzku
          end
        TempPohl.Castka=Castka
        TempPohl.Pocet=PocetPohl
        TempKlic.Castka=SwapReal(Castka)
        if(((not Limit)or(Castka>=LimitR))and(Castka<>0))
          AddKey(TempKlic,AddRec(TempPohl))
      end else
      begin
        LocB=NextKey(@Klic,Veta)
        Inc(Pozice)                  ; zvyseni citace zpracovanych vet
        SetStatus(Pozice)            ; nastaveni stavoveho prouzku
      end;
  end

ClearKey(TempKlic)
Pozice=0
InitStatus(UsedKeys(TempKlic),,'Tisk přehledu') ; inicializace stavoveho prouzku
i:Word=1
While(PrevKey(TempKlic,Veta))
  begin
    ReadRec(TempPohl,Veta)
    KeyAdresar1.Length=4
    KeyAdresar1.Ico=SwapL(TempPohl.Ico)
    Adresar.Nazev=''
    Adresar.Mesto=''
    if(FindKey(KeyAdresar1,VetaA))
      begin
        ReadRec(Adresar,VetaA)
      end
    AddLine(Str(i)+#9+Null(TempPohl.ICO,8,True)+#9+Adresar.Nazev+#9+Adresar.Mesto+#9+StrFinanc(TempPohl.Castka,2)+#9+Str(TempPohl.Pocet))
    SumCastka=SumCastka+TempPohl.Castka
    Inc(i)
    Inc(Pozice)                  ; zvyseni citace zpracovanych vet
    SetStatus(Pozice)            ; nastaveni stavoveho prouzku
    if(TiskDetaily)
      begin
        ;vyhledat pohledavky dle ICO
        if(CompareStr(Odkud,'P'))
          begin
            KeyPohledavka3.Length=4
            KeyPohledavka3.Ico=Swapl(TempPohl.Ico)
            LocB1=SearchKey(KeyPohledavka3,VetaP)
          end else
          begin
            KeyZavazek3.Length=4
            KeyZavazek3.Ico=Swapl(TempPohl.Ico)
            LocB1=SearchKey(KeyZavazek3,VetaP)
          end
        ;cyklem je vytisknout
        While((LocB1)and(@LocStrKeyIco=Swapl(TempPohl.Ico)))
          begin
              begin
                ReadRec(@Kniha,VetaP)
                ;zjistění, zda je zálohová:
                Zalohovka=False
                JeZalohovka('Zalohovka')
                Beru=True
                if((not BeruZalohy)and(Zalohovka))
                  Beru=False
                if((InFilter(@Kniha))and(@DatumDotaz>=OdData)and(@DatumDotaz<=DoData)and(Beru))        ; dotaz, zda věta prošla filtrem
                  begin
                   if(Zpusob1)
                     Castka=@LocStrCastka
                   if(Zpusob2)
                     begin
                       KeyDenik7.Length=4
                       KeyDenik7.Cislo=SwapL(@LocStrCislo)
                       LocBo=SearchKey(KeyDenik7,VetaD)
                       if((@LocStrCislo=SwapL(KeyDenik7.Cislo)) and LocBo)
                         begin
                           ; cyklus pres interni cislo
                           NizsiDPHZaklad=0
                           VyssiDPHZaklad=0
                           BezDPH=0
                           While((@LocStrCislo=SwapL(KeyDenik7.Cislo))and(VetaD<>0))
                             begin
                               ReadRec(Denik,VetaD)        ; přečte větu ze souboru
                               if(Denik.DanT&$C0=$80)      ; zaklad dane
                                 begin
                                   if(Denik.DanT&$30=0)
                                     begin
                                       BezDPH=BezDPH+Denik.Castka
                                     end else
                                   if(Denik.DanT&$30=$10)
                                     begin
                                       NizsiDPHZaklad=NizsiDPHZaklad+Denik.Castka
                                     end else
                                   if(Denik.DanT&$30=$20)
                                     begin
                                       VyssiDPHZaklad=VyssiDPHZaklad+Denik.Castka
                                     end;
                                 end
                                 ;else
                               ;if(Denik.DanT&$C0=$C0)      ; dan
                               ;  begin
                                   ;if(Denik.DanT&$30=$10)
                                   ;  begin
                                   ;    NizsiDPHDan=NizsiDPHDan+Denik.Castka
                                   ;  end else
                                   ;if(Denik.DanT&$30=$20)
                                   ;  begin
                                   ;    VyssiDPHDan=VyssiDPHDan+Denik.Castka
                                   ;  end;
                               ;  end;
                               ;skok na dalsi vetu
                               LocBo=NextKey(KeyDenik7,VetaD);
                             end;
                           Castka=NizsiDPHZaklad+VyssiDPHZaklad+BezDPH
                         end else
                         begin
                           ; v případě, že není rozkont
                           Castka=0
                         end
                     end
                   ;AddLine(#9+@LocStrDoklad+#9+@LocStrPopis+#9+Null(@LocStrIco,8)+#9+StrFinanc(Castka,2)+#9)
                   AddLine(#9+Null(@LocStrIco,8)+#9+@LocStrPopis+#9+@LocStrDoklad+#9+StrFinanc(Castka,2)+#9)
                  end
              end
            LocB1=NextKey(@Klic,VetaP)
          end
        ;pro zjisteni castky znovu vyhledat z rozkontu
        AddLine(' ')

      end
  end
AddLine(#9+#9+'Celkem'+#9+#9+StrFinanc(SumCastka,2)+#9)

CloseTempFile(TempPohl)

Procedure JeZalohovka(Vysledek:String)
  @Vysledek=False
  if(CompareStr(Odkud,'P'))
    begin
      ;pohledavka
      if(Pohledavka.PohlFlags&1<>0)
        begin
          if((Pohledavka.TypD=1)or(Pohledavka.TypD=3))
            @Vysledek=True
        end else
        begin
          KeyFaktura1.Length=6
          KeyFaktura1.Cislo=SwapL(Pohledavka.Cislo)
          KeyFaktura1.Radek=0
          if(FindKey(KeyFaktura1,VetaF))
            begin
              ReadRec(Faktura,VetaF);
              if((Faktura.Typ=1)or(Faktura.Typ=3))
                @Vysledek=True
            end
        end
    end else
    begin
      ;závazky
      if(Zavazek.TypD=1)
        @Vysledek=True
    end
  end

END;