AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi CPU Auslastung für ein Programm begrenzen
Thema durchsuchen
Ansicht
Themen-Optionen

CPU Auslastung für ein Programm begrenzen

Ein Thema von Andidreas · begonnen am 18. Jul 2006 · letzter Beitrag vom 19. Jul 2006
Antwort Antwort
Benutzerbild von Andidreas
Andidreas

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

Re: CPU Auslastung für ein Programm begrenzen

  Alt 18. Jul 2006, 11: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
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:49 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz