Delphi-PRAXiS
Seite 4 von 4   « Erste     234

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Software-Projekte der Mitglieder (https://www.delphipraxis.net/26-software-projekte-der-mitglieder/)
-   -   Programm Wurzelberechnung nach Heron (https://www.delphipraxis.net/191426-programm-wurzelberechnung-nach-heron.html)

nahpets 19. Jan 2017 16:48

AW: Programm Wurzelberechnung nach Heron
 
Hab' mir den Quelltext mal angeschaut.

Wenn man einen Timer auf Enabled setzt, so wird der in Intervall befindliche Zeitraum genutzt. Wird das Intervall erst nach Enabled := True; gesetzt, so hat es keine Auswirkung mehr, bzw. erst nach dem nächsten Enabled := False; ... Enabled := True;

Hab' einfach mal ein bisserl überarbeitet:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, Math,
{$IFDEF VER150} // Delphi 7
  StdCtrls, Buttons, jpeg;
{$ELSE}
  Vcl.StdCtrls, Vcl.Buttons, Vcl.Imaging.jpeg;
{$ENDIF}

type
  TTimerNW = class(TTimer)
   private
    fOneSecond : Boolean;
    fMidnight : Boolean;
    function CalcTimerInterval(iTimerInterval : Integer) : Integer;
    function GetEnabled:boolean;
    function GetInterval: cardinal;
    procedure init;
    procedure SetEnabled(e: boolean);
    procedure SetInterval(i: cardinal);
    procedure SetMidNight(AValue : Boolean);
    procedure SetOneSecond(AValue : Boolean);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
   published
    property Enabled  : Boolean read GetEnabled write SetEnabled default False;
    property Interval : Cardinal read GetInterval write SetInterval default 1000;
    property OneSecond : Boolean read fOneSecond write SetOneSecond;
    property MidNight : Boolean read fMidNight write SetMidNight;
  end;

type
  TForm1 = class(TForm)
    BitBtnClose: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    TrackBar1: TTrackBar;
    procedure BitBtnCloseClick(Sender: TObject);
    procedure Sekundenanzeige(Sender: TObject);
    procedure Datumsanzeige(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    fTimer  : TTimerNW;
    ftmDatum : TTimerNW;
    procedure Ausgabe;
  public
    { Public-Deklarationen }
  end;

const
  iOneSecond     : Integer = 1000;    // eine Sekunde in Millisekunden
  iFiveSeconds   : Integer = 5000;    // fünf Sekunden in Millisekunden
  iFifteenSeconds : Integer = 15000;   // fünfzehn Sekunden in Millisekunden
  iOneMinute     : Integer = 60000;   // eine Minute in Millisekunden
  iFiveMinutes   : Integer = 300000;  // Fünf Minuten in Millisekunden
  iFifteenMinutes : Integer = 900000;  // Fünfzehn Minuten in Millisekunden
  iOneHour       : Integer = 3600000; // Eine Stunde in Millisekunden
  iOneDay        : Integer = 86400000; // Ein Tag in Millisekunden

  csHeute  = 'Der heutige Tag ist der %s des %s. Monates des Jahres %s.';
  csUhrzeit = '%s Stunden, %s Minuten, %s Sekunden und %s Millisekunden';

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TTimerNW.create;
begin
  inherited Create(AOwner);
  fOneSecond       := False;
  fMidnight        := False;
  init;
end;

destructor TTimerNW.Destroy;
begin
  inherited Destroy;
end;

procedure TTimerNW.init;
begin
  inherited Interval := 1000;
  inherited Enabled := True;
end;

procedure TTimerNw.SetEnabled(e: Boolean);
begin
       if fOneSecond then Interval := CalcTimerInterval(iOneSecond)
  else if fMidNight then Interval := CalcTimerInterval(iOneDay);
  inherited Enabled := e;
end;

procedure TTimerNW.SetInterval(i: Cardinal);
begin
  if i = 0 then i := 1000;
  inherited Interval := i;
end;

function TTimerNW.GetInterval;
begin
  inherited;
  Result := inherited Interval;
end;

function TTimerNW.GetEnabled;
begin
  Result := inherited Enabled;
end;

function TTimerNW.CalcTimerInterval(iTimerInterval : Integer) : Integer;
Var
  dNow : Double;
begin
  // Interval setzen
  // Tagesdatum und Uhrzeit holen
  dNow := Now;
  // Den Tagesanteil holen (= Nachkommastellen).
  dNow := dNow - Trunc(dNow);
  // Rest bis Mitternacht holen.
  dNow := 1 - dNow;
  // Nachkommastellen mal Millisekunden pro Tag
  Result := Trunc(dNow * iOneDay);
  // wir benötigen den Rest bis zum angegeben Interval, damit der Timer
  // zur nächsten Minute, Stunde, 0 Uhr ... aktive wird.
  Result := (Result mod Max(iTimerInterval,1));
end;

procedure TTimerNW.SetOneSecond(AValue : Boolean);
begin
  fOneSecond := AValue;
  if AValue then begin
    fMidNight := false;
    Interval := CalcTimerInterval(iOneSecond);
  end;
end;

procedure TTimerNW.SetMidNight(AValue : Boolean);
begin
  fMidNight := AValue;
  if AValue then begin
    fOneSecond := false;
    Interval  := CalcTimerInterval(iOneDay);
  end;
end;

function DezInRoem(n:Integer):string;
  function teil(const groessenordnung1,groessenordnung2:integer;
                var rest:integer;
                const zeichen1,zeichen2:char):string;
    begin
      result:='';
      while rest>=groessenordnung1 do
      begin
        dec(rest,groessenordnung1); //rest:=rest-groessenordnung;
        result:=result+zeichen1; //z.B. +'M'
      end;
      if rest>=groessenordnung2 then
      begin
        dec(rest,groessenordnung2);
        result:=result+zeichen2+zeichen1; //z.B. +'CM'
      End;
    end;
begin
  result := ''; //in Delphi automatisch
  result := result + teil(1000,900,n,'M','C');
  result := result + teil( 500,400,n,'D','C');
  result := result + teil( 100, 90,n,'C','X');
  result := result + teil(  50, 40,n,'L','X');
  result := result + teil(  10, 9,n,'X','I');
  result := result + teil(   5, 4,n,'V','I');
  result := result + teil(   1, 1,n,'I','I');
end;

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

procedure TForm1.Button1Click(Sender: TObject);
var
  startTime: Cardinal;
begin
  startTime := GetTickCount;
  //Befehlesfolge deren Zeitdauer bestimmt werden soll
  Ausgabe;
  // ShowMessage('Die Routine benötigte etwa ' + (IntToStr(GetTickCount - startTime)) + ' ms');
  fTimer.Enabled := true;
  // showMessage(floattostr(timer2.Interval));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  freq: Int64;
  startTime: Int64;
  endTime: Int64;
begin
  fTimer.Enabled := false;
  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(startTime);
  //Befehlesfolge deren Zeitdauer bestimmt werden soll
  Ausgabe;
  QueryPerformanceCounter(endTime);
  fTimer.Enabled := true;
//  ShowMessage('Die Routine benötigte etwa ' + IntToStr((endTime - startTime) * 1000 div freq) + ' ms');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  // Damit der Timer zur nächsten vollen Sekunde ausgelöst wird:
  fTimer.Interval := fTimer.CalcTimerInterval(iOneSecond);
  //showMessage(inttostr(CalcTimerInterval(iOneSecond)));
  // showMessage(inttostr(Timer2.Interval));
  // Zur nächsten vollen Viertelstunde, um den Glockenschlag für die Viertelstunde auszulösen:
  fTimer.Interval := fTimer.CalcTimerInterval(iFifteenMinutes);
  // Oder um Mitternacht, z. B. für den Datumswechsel:
  fTimer.Interval := fTimer.CalcTimerInterval(iOneDay);
end;

procedure TForm1.Sekundenanzeige(Sender: TObject);   //Messung Intervall
var
  freq    : Int64;
  startTime: Int64;
  endTime : Int64;
  Present : TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  fTimer.Enabled := false;
  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(startTime);
  Ausgabe;
  Present := Now;
  Panel1.Caption := timeToStr(Present);
  StatusBar1.Panels[0].Text := TimeToStr(Present);
  SysUtils.DecodeTime(Present, Hour, Min, Sec, MSec);
  Trackbar1.Position       := Sec;
  QueryPerformanceCounter(endTime);
  fTimer.Enabled := true;
  // ShowMessage('Die Routine benötigte etwa ' + IntToStr((endTime - startTime) * 1000 div freq) + ' ms');
end;

procedure TForm1.Datumsanzeige(Sender: TObject);
var
  Present : TDateTime;
begin
  ftmdatum.Enabled := false;
  Present         := Now;
  Panel1.Caption  := timeToStr(Present);
  StatusBar1.Panels[1].Text := FormatDateTime('"Heute ist "dddd," der "d.mmmm yyyy"',Present);
  ftmDatum.Enabled := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fTimer           := TTimerNW.Create(Self);
  fTimer.OnTimer   := Sekundenanzeige;
  fTimer.OneSecond := True;
  Sekundenanzeige(Sender);
  ftmDatum         := TTimerNW.Create(Self);
  ftmDatum.MidNight := True;
  Datumsanzeige(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ftmDatum.Free;
  fTimer.Free;
end;

procedure TForm1.Ausgabe;
var
  Present: TDateTime;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
  Present := Now;
  SysUtils.DecodeDate(Present, Year, Month, Day);
  SysUtils.DecodeTime(Present, Hour, Min, Sec, MSec);
  Label1.Caption := Format(csHeute,[Dezinroem(Day), Dezinroem(Month), DezinRoem(Year)]);
  Label2.Caption := Format(csUhrzeit,[DezInRoem(Hour),DezInRoem(Min), DezinRoem(Sec), DezinRoem(MSec)]);
  Label4.Caption := DezInRoem(Hour);
  Label5.Caption := DezInRoem(Min);
  Label6.Caption := DezInRoem(Sec);
  Label7.Caption := DezInRoem(mSec);
end;

end.
Bei der Uhr vom Düsseldorfer Fernmeldeturm meinte ich übrigens dieses hier: https://commons.wikimedia.org/wiki/F...rm_uhrzeit.jpg bzw. dashier: http://www.keifzicke.de/Dssd_Rheinturm.html oder auch jenes: http://www.wiegels.net/tuerme/hoch/rz101.jpg

EdAdvokat 19. Jan 2017 17:03

AW: Programm Wurzelberechnung nach Heron
 
Danke erst einmal. Das muss ich mir ganz in Ruhe einziehen. Es ist doch noch eine ganze Menge zu tun....:?


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:17 Uhr.
Seite 4 von 4   « Erste     234

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz