mORMot Open Source

procedure TFZamkniecia_CykleOrganizacji.pGenerujPociagiPrzewoznikow(IdCykluOrgZamk: Integer);
var
  i: Integer;
  j: Integer;
  PDF: TGDIPages;
  Txt: String;
  CyklObowOd: String;
  CyklObowDo: String;
  Lp: Integer;
  k: Integer;
  r: Integer;
  NazwaPliku: String;
  NrZarzadzenia: String;
  DataZarzadzenia: String;
  p: String;
  TypZmiany: Integer;
  KomZastFound: Integer;
  KomZastBeg: String;
  KomZastEnd: String;
  ZmiTrasBeg: String;
  ZmiTrasEnd: String;
begin

  adospPZ_PR.Active := False;
  adospPZ_PR.Parameters.ParamByName('@IdCykluOrgZamk').Value := IdCykluOrgZamk;
  adospPZ_PR.Parameters.ParamByName('@IlePociagow').Value := 0;
  adospPZ_PR.Active := True;
  pbc.Max := OT.NullToZero(adospPZ_PR.Parameters.ParamByName('@IlePociagow').Value);

  if adospPZ_PR.RecordCount = 0 then
  begin
    Application.MessageBox('Nie znaleziono żadnych pociągów do wygenerowania', PChar(Caption), MB_ICONWARNING);
    Exit;
  end
  else if adospPZ_PR.RecordCount = 1 then
    p := 'przewoźnika'
  else
    p := 'przewoźników';

  memLog.Lines.Add('Rozpoczynam generowanie pociągów dla ' + IntToStr(adospPZ_PR.RecordCount) + ' ' + p + ' ...');
  memLog.Lines.Add(' ');
  Application.ProcessMessages;

  pbc.Max := 0;
  RichEdit.Text := '';

  for i := 0 to adospPZ_PR.RecordCount - 1 do
  begin

    TypZmiany := -1;

    if CancelGenerate then
      Exit;

    memLog.Lines.Add('Przewoźnik: ' + adospPZ_PR['NazwaPrzewoznika']);
    Application.ProcessMessages;

    adospPZ_LP.Active := False;
    adospPZ_LP.Parameters.ParamByName('@CentralaPrzewoznika').Value := adospPZ_PR['CentralaPrzewoznika'];
    adospPZ_LP.Parameters.ParamByName('@IdCykluOrgZamk').Value := IdCykluOrgZamk;
    adospPZ_LP.Active := True;

    cdsPZ_LP1.Active := False;
    cdsPZ_LP1.Active := True;
    adospPZ_LP.RecordSet := adospPZ_LP.NextRecordSet(r);
    cdsPZ_LP2.Active := False;
    cdsPZ_LP2.Active := True;

    memLog.Lines.Add('Liczba pociągów przewoźnika: ' + IntToStr(cdsPZ_LP1.RecordCount));
    memLog.Lines.Add(' ');

    Application.ProcessMessages;

    PDF := TGDIPages.Create(Self);
    try
      try
        //naglowek START
        PDF.Caption := 'Projekt zastępczego rozkładu jazdy - ZASTĘPCZE I DODATKOWE POCIĄGI';

        PDF.BeginDoc;

        PDF.Font.Name := 'Times New Roman';

        PDF.SaveLayout;

        PDF.Font.Name := 'Tahoma';

        PDF.DrawBMP(logo.Picture.Bitmap, 0, 190);

        PDF.TextAlign := taRight;

        PDF.AddTextToHeader(DateTimeToStr(Now));
        PDF.AddLineToHeader(false);

        PDF.AddLineToFooter(false);

        PDF.TextAlign := taRight;
        PDF.AddPagesToFooterAt('Strona %d z %d', PDF.RightMarginPos);

        PDF.TextAlign := taCenter;
        PDF.Font.Size := 7;
        PDF.Font.Color := clGray;
        PDF.AddTextToFooter('Spółka wpisana do rejestru przedsiębiorców prowadzonego przez Sąd Rejonowy dla m.st. Warszawy w Warszawie ');
        PDF.AddTextToFooter('XIII Wydział Gospodarczy Krajowego Rejestru Sądowego pod numerem ');
        PDF.AddTextToFooter('KRS 0000037568. NIP 113-23-16-427, REGON 017319027 ');
        PDF.AddTextToFooter('Kapitał zakładowy 13 043 747 000,00 w całości wpłacony.');

        PDF.TextAlign := taCenter;

        PDF.Font.Style := [fsBold];
        PDF.Font.Size := 9;
        PDF.Font.Color := clBlack;
        PDF.DrawText('CENTRUM ZARZĄDZANIA RUCHEM KOLEJOWYM');
        PDF.DrawText('Wydział ds. Organizacji Zamknięć Torowych i Indywidulanego Rozkładu Jazdy');
        PDF.Font.Style := [];
        PDF.DrawText('03-734 Warszawa, ul. Targowa 74, tel.: +48 (0-22) 473-35-65, fax: +48 (0-22) 473-39-00');
        PDF.Font.Color := clBlue;
        PDF.DrawText('mail@mail.pl');

        PDF.Font.Style := [fsBold, fsUnderline];
        PDF.Font.Size := 16;
        PDF.Font.Color := clBlack;
        PDF.NewLine;
        PDF.DrawText('PROJEKT ZASTĘPCZEGO ROZKŁADU JAZDY');

        PDF.Font.Style := [fsBold];
        PDF.Font.Size := 14;
        PDF.NewHalfLine;
        NrZarzadzenia := OT.NullToValue(ADOQ_Cykle['NrZarzadzenia'], 'BRAK NUMERU ZARZĄDZENIA');
        DataZarzadzenia := OT.NullToValue(ADOQ_Cykle['DataZarzadzenia'], 'BRAK DATY ZARZĄDZENIA');
        PDF.DrawText(NrZarzadzenia + ' z dnia ' + DataZarzadzenia);

        PDF.RestoreSavedLayout;

        PDF.NewLine;

        CyklObowOd := ADOQ_Cykle['ObowOd'];
        CyklObowDo := ADOQ_Cykle['ObowDo'];

        PDF.Font.Size := 12;
        Txt := 'IDDRZ Warszawa - z powodu zamknięć torowych na sieci PKP PLK S.A.' +
        ' w terminie od ' + CyklObowOd + ' do ' + CyklObowDo +
        ' zarządzam organizację ruchu dla następujących pociągów:';
        PDF.DrawText(Txt);

        PDF.Font.Style := [fsBold];
        PDF.Font.Size := 16;
        PDF.Font.Color := clBlack;
        PDF.NewLine;
        PDF.DrawTitle(adospPZ_PR['NazwaPrzewoznika'], true);

        //naglowek - END

        { *********************************** }

        pbp.Position := 0;

        PDF.LineSpacing := lsOneAndHalf;

        PDF.Font.Style := [];
        PDF.Font.Size := 12;
        PDF.TextAlign := taJustified;

        Lp := 0;
        for j := 0 to cdsPZ_LP1.RecordCount - 1 do
        begin

          if CancelGenerate then
            Exit;

          if TypZmiany <> cdsPZ_LP1['TypZmiany'] then
          begin
            TypZmiany := cdsPZ_LP1['TypZmiany'];
            Lp := 0;
            PDF.SaveLayout;
            PDF.Font.Style := [fsBold];
            PDF.Font.Size := 12;
            PDF.Font.Color := clBlack;
            case TypZmiany of
              0: PDF.DrawTitle('I. Pociągi zastępcze w organizacji zamknięciowej bez zmian w trasie pociągu', false);
              1: PDF.DrawTitle('II. Pociągi zastępcze w organizacji zamknięciowej ze skróconą relacją', false);
              2: PDF.DrawTitle('III. Pociągi zastępcze w organizacji zamknięciowej ze zmienioną relacją', false);
              3: PDF.DrawTitle('IV. Pociągi dodatkowe organizacji zamknięciowej', false);
            end;
            PDF.RestoreSavedLayout;
          end;

          cdsPZ_LP2.Filtered := False;
          cdsPZ_LP2.Filter := 'IdZam=' + VarToStr(cdsPZ_LP1['IdZam']);
          cdsPZ_LP2.Filtered := True;

          memLog.Lines[memLog.Lines.Count-1] := 'Postęp generowania pociągów przewoźnika: ' + IntToStr(Round(((j+1) / cdsPZ_LP1.RecordCount) * 100)) + '%';
          pbp.Position := Round(((j+1) / cdsPZ_LP1.RecordCount) * 100);

          pbc.Position := pbc.Position + 1;
          Application.Processmessages;

          //pociagi
          Inc(Lp);

          //naglowek
          Txt := '    ' + IntToStr(Lp) + ')  ';
          Txt := Txt + 'Nr pociągu: ';
          Txt := Txt + OT.NullToValue(cdsPZ_LP1['NrPociagu'], '?') + '; ';
          Txt := Txt + 'rodzaj pociągu: ';
          Txt := Txt + OT.NullToValue(cdsPZ_LP1['Rodzaje'], '?') + '; ';
          Txt := Txt + 'ID zamówienia: ';
          Txt := Txt + IntToStr(cdsPZ_LP1['IdZam']) + '; ';
          Txt := Txt + 'relacja: ';
          Txt := Txt + OT.NullToValue(cdsPZ_LP1['StacjaOdZamk'], '?') + ' - ' + OT.NullToValue(cdsPZ_LP1['StacjaDoZamk'], '?');

          if
          (cdsPZ_LP1['StacjaOdPierw'] <> cdsPZ_LP1['StacjaOdZamk'])
          or
          (cdsPZ_LP1['StacjaDoPierw'] <> cdsPZ_LP1['StacjaDoZamk'])
          then
            Txt := Txt + ' (' + OT.NullToValue(cdsPZ_LP1['StacjaOdPierw'], '?') + ' - ' + OT.NullToValue(cdsPZ_LP1['StacjaDoPierw'], '?') + '); '
          else
            Txt := Txt + '; ';

          Txt := Txt + 'kursuje: ';
          Txt := Txt + OT.NullToValue(cdsPZ_LP1['Opis'], '?') + '; ';
          //naglowek

          //trasa
          KomZastFound := 0;
          KomZastBeg := '';
          KomZastEnd := '';
          ZmiTrasBeg := '';
          ZmiTrasEnd := '';
          Txt := Txt + 'trasa: ';
          for k := 0 to cdsPZ_LP2.RecordCount - 1 do
          begin

            if CancelGenerate then
              Exit;

            if OT.NullToValue(cdsPZ_LP2['NazwaStacjiZamk'], '') <> '' then
            begin
              //komunikacja zastepcza
              if cdsPZ_LP2['KomZast']=1 then
                Inc(KomZastFound);
              if KomZastFound = 1 then
              begin
                KomZastBeg := '[';
                KomZastEnd := ']';
              end
              else
              begin
                KomZastBeg := '';
                KomZastEnd := '';
              end;

              //zmieniona trasa
              if OT.NullToZero(cdsPZ_LP2['NrPoprzZamk']) = 0 then
              begin
                ZmiTrasBeg := '<';
                ZmiTrasEnd := '>';
              end
              else
              begin
                ZmiTrasBeg := '';
                ZmiTrasEnd := '';
              end;

              if (KomZastFound = 0) or (KomZastFound = 1) then
              begin

                Txt := Txt + ZmiTrasBeg + KomZastBeg + OT.NullToValue(cdsPZ_LP2['NazwaStacjiZamk'], '?') + ' ' + OT.NullToValue(cdsPZ_LP2['PrzyjazdZamk'], '?');
                if (k > 0) and (k < cdsPZ_LP2.RecordCount - 1) then
                  Txt := Txt + '/' + OT.NullToValue(cdsPZ_LP2['OdjazdZamk'], '?');

                Txt := Txt + KomZastEnd + ZmiTrasEnd;

                if
                (OT.NullToZero(cdsPZ_LP2['RoznicaPrzyjazd'])<>0)
                or
                (OT.NullToZero(cdsPZ_LP2['RoznicaOdjazd'])<>0)
                then
                begin
                  Txt := Txt + ' (' + FloatToStr(cdsPZ_LP2['RoznicaPrzyjazd']);
                  if (k > 0) and (k < cdsPZ_LP2.RecordCount - 1) then
                     Txt := Txt + '/' + FloatToStr(cdsPZ_LP2['RoznicaOdjazd']) + '); '
                  else
                    Txt := Txt + '); ';
                end
                else
                  Txt := Txt + '; ';

              end;
              
            end;

            cdsPZ_LP2.Next;
          end;
          //trasa

          PDF.DrawText(Txt);
          PDF.NewHalfLine;

          TypZmiany := cdsPZ_LP1['TypZmiany'];

          //pociagi
          cdsPZ_LP1.Next;
        end;
        
        PDF.NewLine;
        PDF.Font.Style := [fsBold, fsUnderline];
        PDF.Font.Size := 10;
        PDF.DrawText('Informacje:');
        PDF.Font.Style := [];
        PDF.Font.Size := 10;
        PDF.DrawText('Podkreslenie nazwy stacji w trasie oznacza komunikację zastępczą. Pochylenie nazwy stacji w trasie oznacza zmianę trasy pociągu.');

        { *********************************** }

        PDF.EndDoc;

        NazwaPliku := IntToStr(IdCykluOrgZamk) + '_' +
          StringReplace(Trim(CyklObowOd), '.', '-', [rfReplaceAll, rfIgnoreCase]) + '_' +
          StringReplace(Trim(CyklObowDo), '.', '-', [rfReplaceAll, rfIgnoreCase]) + '_' +
          UpperCase(adospPZ_PR['CentralaPrzewoznika']) +
          '_ZMIANA_ORGANIZACJI_RUCHU.pdf';

        //Zapis
        if not PDF.ExportPDF(
          ExtractFilePath(Application.ExeName) + 'Zamkniecia\' +
          NazwaPliku,
          false,
          false
        ) then
          Application.MessageBox('Nieudane generowanie pliku PDF', PChar(Caption), MB_ICONERROR)
        else
        begin

          Inc(LProjekty);
          SetLength(Projekty, LProjekty);
          Projekty[LProjekty-1].Zamkniecia := False;
          Projekty[LProjekty-1].NazwaPliku := NazwaPliku;
          Projekty[LProjekty-1].UmowaPas := (adospPZ_PR['P'] and  1);
          Projekty[LProjekty-1].NazwaPrzew := OT.NullToValue(adospPZ_PR['NazwaPrzewoznika'], '?');
          Projekty[LProjekty-1].EmailPrzew := OT.NullToValue(adospPZ_PR['EmailZastProjekt'], '');

        end;

        pbp.Position := 0;

        if cbPokazPDF.Checked then
          PDF.ShowPreviewForm;
      except
        on E: Exception do
          Application.MessageBox(PChar(E.Message), PChar(Caption), MB_ICONERROR);
      end;
    finally
      FreeAndNil(PDF);
    end;

    memLog.Lines.Add(' ');

    adospPZ_PR.Next;

  end;

  pbc.Position := 0;

end;

procedure TPdfWrite.Save;
var L: integer;
begin
  L := B-@Tmp;
  inc(fDestStreamPosition,L);
  fDestStream.Write(Tmp,L); //<-- here comes AV
  B := @Tmp;
end;

function THeapMemoryStream.Realloc(var NewCapacity: Integer): Pointer;
// allocates memory from Delphi heap (FastMM4/SynScaleMM) and not windows.Global*()
// and uses bigger growing size -> a lot faster
var i: PtrInt;
begin
  if NewCapacity>0 then begin
    i := Seek(0,soFromCurrent); // no direct access to fSize -> use Seek() trick
    if NewCapacity=Seek(0,soFromEnd) then begin // avoid ReallocMem() if just truncate
      result := Memory;
      Seek(i,soFromBeginning);
      exit;
    end;
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
    Seek(i,soFromBeginning);
  end;
  Result := Memory;
  if NewCapacity <> Capacity then begin
    if NewCapacity = 0 then begin
      FreeMem(Memory);
      Result := nil;
    end else begin
      if Capacity = 0 then
        GetMem(Result, NewCapacity) else
        if NewCapacity > Capacity then // only realloc if necessary (grow up)
          ReallocMem(Result, NewCapacity) else
          NewCapacity := Capacity; // same capacity as before
      if Result = nil then
        raise EStreamError.Create('THeapMemoryStream'); // memory allocation bug
    end;
  end;
end;