STEP für FOR Schleifen

[cruiser]

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]