AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

STEP für FOR Schleifen

Ein Thema von cruiser · begonnen am 19. Apr 2007
Antwort Antwort
Benutzerbild von cruiser
cruiser

Registriert seit: 23. Dez 2003
Ort: Königsbrück/Sachsen
455 Beiträge
 
Delphi 7 Enterprise
 
#1

STEP für FOR Schleifen

  Alt 19. Apr 2007, 19:01
Steps sind in Delphi ja nicht möglich. Auch for-Schleifen mit nicht ganzzahligen Werten sind nicht implementiert. folgende Unit sollte Abhilfe schaffen:

Delphi-Quellcode:
unit cruForDo;
// uncomment the compilerswitch below to throw exceptions when LoopProc is nil
// {$DEFINE NilLoopProcExcept}
// uncomment the compilerswitch below to exit when LoopProc is nil
{$DEFINE NilLoopProcExit}

interface

type
  TLoopProc = procedure(const counter: Int64; var break: Boolean);
  TObjLoopProc = procedure(const counter: Int64; var break: Boolean) of object;
  TExtLoopProc = procedure(const counter: Extended; var break: Boolean);
  TObjExtLoopProc = procedure(const counter: Extended; var break: Boolean) of object;

function ForDo(const start, stop, step: Int64; LoopProc: TLoopProc): Boolean; overload;
function ForDo(const start, stop, step: Int64; LoopProc: TObjLoopProc): Boolean; overload;
function ForDo(const start, stop, step: Extended; LoopProc: TExtLoopProc): Boolean; overload;
function ForDo(const start, stop, step: Extended; LoopProc: TObjExtLoopProc): Boolean; overload;


implementation

{$IFDEF NilLoopProcExcept}
uses SysUtils;
const LoopProcExcp = 'No LoopProc assigned!';
{$ENDIF}

function ForDo(const start, stop, step: Int64; LoopProc: TLoopProc): Boolean;
var
  counter: Int64;
  break: Boolean;
begin
  break := False;
  Result := True;
  if not Assigned(LoopProc) then begin
    {$IFDEF NilLoopProcExcept}
    raise Exception.Create(LoopProcExcp);
    {$ENDIF}
    Result := False;
    {$IFDEF NilLoopProcExit}
    Exit;
    {$ENDIF}
  end;
  counter := start;
  if start <= stop then while (counter <= stop) and not break do begin
    LoopProc(counter, break);
    Inc(counter, step);
  end else while (stop <= counter) and not break do begin
    LoopProc(counter, break);
    Dec(counter, step);
  end;
end;

function ForDo(const start, stop, step: Int64; LoopProc: TObjLoopProc): Boolean;
var
  counter: Int64;
  break: Boolean;
begin
  break := False;
  Result := True;
  if not Assigned(LoopProc) then begin
    {$IFDEF NilLoopProcExcept}
    raise Exception.Create(LoopProcExcp);
    {$ENDIF}
    Result := False;
    {$IFDEF NilLoopProcExit}
    Exit;
    {$ENDIF}
  end;
  counter := start;
  if start <= stop then while (counter <= stop) and not break do begin
    LoopProc(counter, break);
    Inc(counter, step);
  end else while (stop <= counter) and not break do begin
    LoopProc(counter, break);
    Dec(counter, step);
  end;
end;

function ForDo(const start, stop, step: Extended; LoopProc: TExtLoopProc): Boolean;
var
  counter, stop2: Extended;
  break: Boolean;
begin
  break := False;
  Result := True;
  if not Assigned(LoopProc) then begin
    {$IFDEF NilLoopProcExcept}
    raise Exception.Create(LoopProcExcp);
    {$ENDIF}
    Result := False;
    {$IFDEF NilLoopProcExit}
    Exit;
    {$ENDIF}
  end;
  if start <= stop then begin
    counter := 0;
    stop2 := (stop + step / 100) - start;
    while (counter <= stop2) and not break do begin
      LoopProc(counter + start, break);
      counter := counter + step;
    end;
  end else begin
    counter := 0;
    stop2 := start - (stop - step / 100);
    while (counter <= stop2) and not break do begin
      LoopProc(start - counter, break);
      counter := counter + step;
    end;
  end;
end;

function ForDo(const start, stop, step: Extended; LoopProc: TObjExtLoopProc): Boolean;
var
  counter, stop2: Extended;
  break: Boolean;
begin
  break := False;
  Result := True;
  if not Assigned(LoopProc) then begin
    {$IFDEF NilLoopProcExcept}
    raise Exception.Create(LoopProcExcp);
    {$ENDIF}
    Result := False;
    {$IFDEF NilLoopProcExit}
    Exit;
    {$ENDIF}
  end;
  if start <= stop then begin
    counter := 0;
    stop2 := (stop + step / 100) - start;
    while (counter <= stop2) and not break do begin
      LoopProc(counter + start, break);
      counter := counter + step;
    end;
  end else begin
    counter := 0;
    stop2 := start - (stop - step / 100);
    while (counter <= stop2) and not break do begin
      LoopProc(start - counter, break);
      counter := counter + step;
    end;
  end;
end;

end.
Wie funktioniert es?

Die überladene procedure ForDo wird mit den Parametern Start, Stop und Step gefüttert. Zusätzlich wird noch ein Prozedur-Zeiger mitgegeben, in der die eigentliche Arbeit der Schleife gekapselt ist. Diese Prozeduren dürfen nur einen konstanten Parameter namens counter mitbekommen. Soll rückwärts gezählt werden, muss start einfach nur größer als stop sein.

also so:
Delphi-Quellcode:
procedure aIntLoop(const counter: Int64);
begin
  Form1.lst1.Items.Add(IntToStr(counter));
end;

procedure aExtLoop(const counter: Extended);
begin
  Form1.lst1.Items.Add(FormatFloat('0.###', counter));
end;
Und noch ein Beispiel zum Schluss:

Delphi-Quellcode:
uses cruForDo;

var i: Integer;

procedure aLoop(const counter: Int64; var break: Boolean);
begin
  Inc(i);
  if i >= 2 then break := True;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  i := 0;
  ForDo(0,3,1,aLoop);
  ShowMessage(IntToStr(i));
end;
[edit=CalganX]Neue Version des Quellcodes. Mfg, CalganX[/edit]
Angehängte Dateien
Dateityp: pas crufordo_884.pas (3,6 KB, 24x aufgerufen)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 12:47 Uhr.
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