Einzelnen Beitrag anzeigen

Benutzerbild von Andidreas
Andidreas

Registriert seit: 27. Okt 2005
1.110 Beiträge
 
Delphi 10.1 Berlin Enterprise
 
#10

Re: CPU Auslastung für ein Programm begrenzen

  Alt 18. Jul 2006, 12:56
hier noch der source code von der routine die das excel erstellt:

Delphi-Quellcode:
procedure TMain_Form.prCreateXls(iAnzRec : Integer);

var
bl : Boolean;
oleExcelApp, oleExcelSheets, oleExcelWorkb : OleVariant;
i, iCell, iCount, iRow : Integer;
sDate, sFile, sPath, sRow, sXlsFile : String;
txtFile : TextFile;
wRC : Word;

begin

  //Paths
  sDate := FormatDateTime('yyyymmdd', Date);
  sFile := 'U:\Programmierung\LOG\Router_Tab\Excel\ROUTES_TAB_' + sDate;
  sPath := '..\Output\ROUTES_Convert_' + sDate + '.txt';

  //Create .xls / Set Column Format / Create Header
  oleExcelApp := CreateOleObject('Excel.Application');
  oleExcelWorkb := oleExcelApp.Workbooks.Add;
  oleExcelSheets := oleExcelworkb.WorkSheets.Add;
  oleExcelSheets.Name := 'Router Tab vom ' + sDate;

  iRow := 1;

  For i := 1 To 7 Do
  Begin
    oleExcelSheets.Columns[i].NumberFormat := '@';
  End;


  For i := 1 To 7 Do
  Begin
    iCell := i;
    oleExcelSheets.Cells[iRow, iCell].Font.FontStyle := 'Bold';
    If i = 1 Then oleExcelSheets.Cells[iRow, iCell].Value := 'Land';
    If i = 2 Then oleExcelSheets.Cells[iRow, iCell].Value := 'PLZ Von';
    If i = 3 Then oleExcelSheets.Cells[iRow, iCell].Value := 'PLZ Bis';
    If i = 4 Then oleExcelSheets.Cells[iRow, iCell].Value := 'O - Sort';
    If i = 5 Then oleExcelSheets.Cells[iRow, iCell].Value := 'D - Depot';
    If i = 6 Then oleExcelSheets.Cells[iRow, iCell].Value := 'D - Sort';
    If i = 7 Then oleExcelSheets.Cells[iRow, iCell].Value := 'Barcode ID';
  End;


  //Assign .txt File for Input
  {$I-}
  AssignFile(txtFile, sPath);
  Reset(txtFile);
  iCount := 100;
  iRow := 2;

  While Not EOF(txtFile) Do
  Begin

    Readln(txtFile, sRow);

    //Add sRow to Excel Cells

    For i := 1 To 7 Do
    Begin
      iCell := i;
      If i = 1 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 1, 2);
      If i = 2 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 3, 9);
      If i = 3 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 12, 9);
      If i = 4 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 21, 4);
      If i = 5 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 25, 4);
      If i = 6 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 29, 4);
      If i = 7 Then oleExcelSheets.Cells[iRow, iCell].Value := Copy(sRow, 33, 3);
    End;

    iRow := iRow + 1;

    //Set Progress in Progress Bar
    If iRow = iCount Then
    Begin
      ProgBar2.Position := Round((100 * iRow) / iAnzRec);
      iCount := iCount + 100;
    End;

  End;

  CloseFile(txtFile);
  {$I+}

  //Examine whether File is present
  bl := FileExists(sFile + '.xls');
  If bl = True Then
  Begin
    wRC := MessageDlg('File is allready present!' +#13+ 'Clear File?', mtInformation, mbYesNo, 0);
    If wRC = mrYes Then
    Begin
      bl := DeleteFile(sFile + '.xls');
      If bl = False Then
      Begin
        ShowMessage('Error with File Clear!');
      End;
    End
    Else
    Begin
      ShowMessage('File would be Overwritten!');
    End;
  End;



  //Save as .xls File
  sXlsFile := ChangeFileExt(sFile, '.xls');

  Try
    oleExcelWorkb.Close(true, sXlsFile, false);
  Except
    ShowMessage('Save To File Error');
  End;

  //Excel freigeben
  oleExcelSheets := Unassigned;
  oleExcelWorkb := Unassigned;
  oleExcelApp.Quit;
  oleExcelApp := Unassigned;

  ProgBar2.Position := 0;
  lbl_sts_xls.Caption := 'Export to Excel. OK';
  lbl_sts_xls.Font.Size := 8;
  lbl_sts_xls.Font.Color := clGreen;
  Main_Form.Refresh;

  bitbtn_exit.Enabled := True;

end;
Ein Programmierer Programmiert durchschnittlich 15 Code Zeilen pro Tag
Wir sind hier doch nicht bei SAP!!!

Aber wir habens bald
  Mit Zitat antworten Zitat