unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, CheckLst, Math;

const
  FaktorNetto    : double = 1.047;
  FaktorLogistik : double = 0.0375;


type

  arr = Array[1..10] of string;
  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    clbFiles: TCheckListBox;
    Edit1: TEdit;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    dFaktorNetto : double;
    dFaktorLogistik: double;
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  fIn, fOut : TextFile;
  sPath : string;


implementation

{$R *.lfm}

{ TForm1 }

function Parse(Char, S: string; Count: Integer): string;
  var
   I: Integer;
   T: string;
 begin
   if S[Length(S)] <> Char then
     S := S + Char;
   for I := 1 to Count do
   begin
     T := Copy(S, 0, Pos(Char, S) - 1);
     S := Copy(S, Pos(Char, S) + 1, Length(S));
   end;
   Result := T;
end;

function RundeAufStelle(zahl: double; stellen: integer): double;
var multi: double;
begin
  multi:=IntPower(10, stellen);
  zahl:=round(zahl*multi);
  result:=zahl/multi;
end;

procedure SchreibeArray(arrOut: arr);
var sOut: String;
    i : Integer;
begin
  sOut := '';
  for i := 1 to 10 do sOut := sOut + arrOut[i] + ';';
  sOut := copy(sOut,1,length(sOut)-1);
  writeln(fOut,sOut);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, iMax, ip : Integer;
    s, fName: String;
    dWert, dLogistik, dVerwaltung, dNetto, dAufschlag : Double;
    arrSource : arr;
    arrNew : arr;
    arrLogistik : arr;
    arrVerwaltung : arr;
begin

  dFaktorNetto := FaktorNetto;
  dFaktorLogistik := FaktorLogistik;

  OpenDialog1.InitialDir := ExtractFilepath(Application.ExeName);
  OpenDialog1.Filter := '*.txt';

  for i := 0 to clbFiles.Count-1 do
  begin
    if clbFiles.Checked[i] then
    begin
      fName := sPath + 'Daten\' + clbFiles.Items.Strings[i];
      edit1.Text := fName;
      edit1.refresh;

      iMax := 0;

      assignfile(fIn,fName);
      reset(fIn);
      while not eof(fIn) do
      begin
        readln(fIn,s);
        inc(iMax);
      end; {while not eof(fIn) do}
      closefile(fIn);

      fName := sPath + 'Daten\neu ' + clbFiles.Items.Strings[i];
      AssignFile(fOut,fName);
      rewrite(fOut);

      ProgressBar1.Max := iMax;
      ProgressBar1.Min := 0;
      ProgressBar1.Position := 0;

      reset(fIn);
      iMax := 0;
      while not eof(fIn) do
      begin
        Progressbar1.Position := Progressbar1.Position + 1;
        readln(fIn,s);

        for ip := 1 to 10 do
        begin
          arrSource[ip]    :=parse(';',s,ip);
          arrNew[ip]       :=parse(';',s,ip);
          arrLogistik[ip]  :=parse(';',s,ip);
          arrVerwaltung[ip]:=parse(';',s,ip);
        end; {for ip := 1 to 10 do}

        dWert := StrToFloat(arrSource[10]);

        case arrSource[5] of
        'WEKGLDBW':     begin     { Wareneinsatz Kasse }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'WEKGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COWEVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COWELG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        'VEGLDBW':   begin     { Verluste  Bruch und Verderb aus Anschriften }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'VEGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COVEVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COVELG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        'VBGLDBW':   begin     { Verluste aus Bestandserfassung / Bruch und Verderb aus Bestandserfassung }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'VBGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COVBVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COVBLG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        'VKGLDBW':   begin     { Verkostung }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'VKGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COVKVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COVKLG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        'MBGLDBW': begin     { Manko aus Bestandserfassung }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'MBGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COMBVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COMBLG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        'WVGLDBW':     begin     { Manko aus Bestandserfassung }
                     dNetto := dWert / dFaktorNetto;
                     dAufschlag := dWert - dNetto;
                     dLogistik := dNetto * dFaktorLogistik;
                     dVerwaltung := dAufschlag - dLogistik;
                     dWert := dNetto + dLogistik;
                     arrNew[5] := 'WVGLDBW';
                     arrVerwaltung[10] := FloatToStr(RundeAufStelle(dVerwaltung*-1,4));
                     arrVerwaltung[5] := 'COWVVW2013';
                     arrLogistik[10] := FloatToStr(RundeAufStelle(dLogistik*-1,4));
                     arrLogistik[5] := 'COWVLG2013';
                     SchreibeArray(arrNew);
                     SchreibeArray(arrVerwaltung);
                     SchreibeArray(arrLogistik);
                   end;
        else
          SchreibeArray(arrSource);

        end; {case arrSource[5] of}


      end; {while not eof(fIn) do}

      closefile(fIn);
      closeFile(fOut);

    end; {if clbFiles.Checked[i] then}
  end; {for i := 0 to clbFiles.Count-1 do}

  MessageDlg('Bearbeitung abgeschlossen',mtConfirmation,[mbOk],0)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close
end;

procedure TForm1.FormCreate(Sender: TObject);
var tsr : TSearchrec;
begin
  clbFiles.Clear;
  sPath := ExtractFilePath(paramstr(0));
  if FindFirst(sPath + '\Daten\*.*',faArchive,tsr) = 0 then
  begin
     repeat
       clbFiles.AddItem(tsr.Name,nil);
     until FindNext(tsr) <> 0;
  end;
end;

end.