DBR Delphi-Ecke

// Getestet mit D2010 unter W7

// 1.  
// Es werden alle Werte einer Zeile in einem Stringgrid addiert   
// und das Ergebnis in einem Label angezeigt. Enthält eine Zelle   
// keine Zahl, sondern ein Wort oder ein Leerzeichen,   
// wird diese Zelle als "0" gewertet.   
   
const   
  zeile: integer = 2;   { dritte Zeile, da die Zählung bei 0 beginnt }  
   
procedure TForm1.Button1Click(Sender: TObject);   
var   
  x: integer;   
  Ergebnis: Double;   
begin   
  Ergebnis := 0;   
  for x := StringGrid1.fixedCols to StringGrid1.ColCount - 1 do   
  try   
    Ergebnis := Ergebnis +   
      StrToFloat(Stringreplace(StringGrid1.Cells[x, zeile], '.', '',   
      [rfReplaceAll]));   
  except end;   
  label1.Caption := FloatToStr(Ergebnis);   
end;   
   
//-------------------------------------------------------------   
   
   
// 2.  
// Es wird eine Spalte addiert. Im Gegensatz zu oben, wird die Summe nicht   
// in einem Label sondern in der untersten Zelle der Spalte angezeigt.    
// Diese Summen-Zelle sollte natürlich nicht anderweitig genutzt werden.   
   
const   
  spalte: integer = 3;    { vierte Spalte einschl. FixedCols }  
   
   
procedure TForm1.Button2Click(Sender: TObject);   
var   
  x: integer;   
  Ergebnis: Double;   
begin   
  Ergebnis := 0;   
  for x := StringGrid1.fixedRows to StringGrid1.RowCount - 2 do   
  try   
    Ergebnis := Ergebnis +   
      StrToFloat(Stringreplace(StringGrid1.Cells[spalte, x], '.', '',   
      [rfReplaceAll]));   
  except end;   
  StringGrid1.Cells[spalte, StringGrid1.RowCount - 1] :=   
    FloatToStr(Ergebnis);   
end;

//-------------------------------------------------------------


// 3.
// Wenn man im Objektinspektor doppelt auf "OnSetEditText" klickt,
// wird das entsprechende Event angelegt, das man mit dem folgenden
// Code ergänzen kann. Hierbei wird sofort die Summe in der untersten
// Zelle aktualisiert, sobald irgendwo in der Spalte eine Zahl eingegeben
// oder geändert wird (natürlich muss dazu "goEditing" auf true stehen).
// Aus Geschwindigkeitsgründen wurde die Abfrage ob "Zahl oder nicht"
// gegenüber den anderen Beispielen verändert.

const 
  spalte: integer = 3;  // Spalte, die addiert wird
   
function isZahl(p: string): boolean;  
var  
  x, lg: integer;  
  iskomma, ise, isvorzeichen: boolean;  
begin  
  result := false;  
  lg := length(p);  
  if (lg = 0) then exit;  
  isvorzeichen := false;  
  iskomma := false;  
  ise := false;  
  for x := 1 to lg do begin  
    if (p[x] = ',') then begin  
      if iskomma or ise then exit;  
      iskomma := true;  
      continue;  
    end;  
    if (lowercase(p[x]) = 'e') then begin  
      if ise or (x = 1) then exit;  
      isvorzeichen := false;  
      ise := true;  
      continue;  
    end;  
    if (p[x] = '+') or (p[x] = '-') then begin  
      if (x > 1) and (lowercase(p[x - 1]) <> 'e') or isvorzeichen  
        or (lg = 1) or (x < lg) and (lowercase(p[x + 1]) = 'e') then exit;  
      isvorzeichen := true;  
      continue;  
    end;  
    if not (p[x] in ['0'..'9']) then exit;  
  end;  
  result := true;  
end; 
 
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, 
  ARow: Integer; const Value: string);  
var  
  x: integer;  
  Ergebnis: Double;  
begin 
  if spalte = ACol then begin 
    Ergebnis := 0; 
    for x := StringGrid1.fixedRows to StringGrid1.RowCount - 2 do begin 
      if isZahl(StringGrid1.Cells[spalte, x]) then 
        Ergebnis := Ergebnis + 
          StrToFloat(Stringreplace(StringGrid1.Cells[spalte, x], '.', '', 
            [rfReplaceAll])); 
    end; 
    StringGrid1.Cells[spalte, StringGrid1.RowCount - 1] := 
      FloatToStr(Ergebnis); 
  end; 
end;

//-------------------------------------------------------------

// 4.
// Im folgenden Beispiel wird ein ganzer Bereich addiert und das
// Ergebnis in eine bestimmte Zelle geschrieben. Dieses Ergebnisfeld
// darf nicht innerhalb des zu addierenden Bereiches liegen. Zu
// Demo-Zwecken sind die Spalten mit Buchstaben ('A'..) bezeichnet.
// Die Anzahl der Spalten darf höchstens 256 (+ 1 FixedCols) sein.
// Im Beispiel wird der Bereich 'A1:C4' addiert und in der Zelle 'D1'
// wird das Ergebnis angezeigt. Damit Gleitkommazahlen ordnungsgemäß
// addiert werden können, werden die Tausenderpunkte in den entsprechenden
// Zellen entfernt. Im Gegensatz zu oben ist es hier auch möglich
// Zahlen in wissenschaftlicher Notation einzugeben (z.B.: 17E+4).

type 
  cr = record 
    Col, Row: Integer; 
  end; 
 
  aecr = record 
    Anfang, Ende: cr; 
  end; 
 
var 
  SummCell: cr; 
  Felder: aecr; 
  ok: Boolean; 
  Punkt, Komma: byte; 
 
  Bereich: string = 'A1:C4'; 
  SummenFeld: string = 'D1'; 
 
function isZahl(p: pchar): Boolean; stdcall; 
var 
  x: cardinal; 
asm 
  xor ecx, ecx 
  mov edx, p 
  mov x, edx 
 @schleife: 
  mov al, [edx] 
  cmp al, 0 
  jnz @plus 
  cmp edx, x 
  jz @false 
  jmp @true 
 @plus: 
  cmp al, '+' 
  jnz @minus 
 @vorzeichen: 
  cmp ch, 0 
  jnz @false 
  mov ch, 1 
  cmp edx, x 
  jz @eins 
  mov ah, [edx-2]  // [edx-1] 
  cmp ah, 'e' 
  jz @weiter 
  cmp ah, 'E' 
  jz @weiter 
 @eins: 
  mov ah, [edx+2]  // [edx+1] 
  cmp ah, 0 
  jz @false 
  cmp edx, x 
  jnz @false 
  cmp ah, 'e' 
  jz @false 
  cmp ah, 'E' 
  jz @false 
  jmp @weiter 
 @minus: 
  cmp al, '-' 
  jnz @komm 
  jmp @vorzeichen 
 @komm: 
  cmp al, Komma 
  jnz @e 
  cmp cl, 0 
  jg @false 
  cmp ecx, $101 
  jg @false 
  mov cl, 1 
  jmp @weiter 
 @e: 
  cmp al, 'e' 
  jz @etest 
  cmp al, 'E' 
  jnz @ziffer 
 @etest: 
  cmp ecx, $101 
  jg @false 
  cmp edx, x 
  jz @false 
  or ecx, $10000 
  xor ch, ch 
  jmp @weiter 
 @ziffer: 
  cmp al, Punkt 
  jz @weiter 
  cmp al, '0' 
  jl @false 
  cmp al, '9' 
  jg @false 
 @weiter: 
  add edx, 2    // inc edx 
  jmp @schleife 
 @false: 
  mov @result, 0 
  jmp @raus 
 @true: 
  mov result, 1 
 @raus: 
end; 
 
procedure pruefen(p1, p2: pointer); stdcall; 
asm 
  mov edx,p1 
  mov eax,[edx] 
  mov edx,p2 
  mov ecx,[edx] 
  cmp eax,ecx 
  jle @fertig 
  mov [edx],eax 
  mov edx,p1 
  mov [edx],ecx 
 @fertig: 
end; 
 
function Punktweg(p: PWideChar): pchar; stdcall; 
asm 
  push ebx 
  xor ebx, ebx 
  mov edx, p 
  mov @result, edx 
 @loop: 
  mov al, [edx] 
  cmp al, 0 
  jz @fertig 
  cmp al, Punkt 
  jz @pw 
  add edx, 2  // inc edx 
  jmp @loop 
 @pw: 
  mov ecx, edx 
  inc ebx 
 @loop2: 
  mov ah, [edx+2]    // [edx+1] 
  mov [edx], ah 
  cmp ah, 0 
  jz @weiter 
  add edx, 2   // inc edx 
  jmp @loop2 
 @weiter: 
  mov edx, ecx 
  jmp @loop 
 @fertig: 
  mov edx, p 
  sub edx, 4 
  mov eax, [edx] 
  sub eax, ebx 
  mov [edx], eax 
  pop ebx 
end; 
 
 
function Feldwandeln(s: string; var z: cr): Boolean; 
var 
  x, p: Integer; 
begin 
  result := false; 
  p := -1; 
  s := trim(uppercase(s)); 
  for x := 2 to length(s) do 
    if not CharInset(s[x], ['A' .. 'Z']) then 
    begin 
      p := x; 
      break; 
    end; 
  if (p > 3) or (p < 0) then 
    exit; 
  try 
    if p = 2 then 
      z.Col := ord(s[1]) - 64 
    else 
      z.Col := ord(s[2]) - 64 + (ord(s[1]) - 64) * 26; 
    if z.Col > 256 then 
      exit; 
    z.Row := strtoint(copy(s, p, maxint)); 
  except 
    exit; 
  end; 
  result := true; 
end; 
 
function Arealwandeln(s: string; var fl: aecr): Boolean; 
var 
  p: Integer; 
begin 
  result := false; 
  p := pos(':', s); 
  with fl do 
  begin 
    if not Feldwandeln(copy(s, 1, p - 1), Anfang) then 
      exit; 
    if not Feldwandeln(copy(s, p + 1, maxint), Ende) then 
      exit; 
    pruefen(@Anfang.Col, @Ende.Col); 
    pruefen(@Anfang.Row, @Ende.Row); 
    if (SummCell.Col in [Anfang.Col .. Ende.Col]) and 
      (SummCell.Row in [Anfang.Row .. Ende.Row]) then 
      exit; 
  end; 
  result := true; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: Integer; 
begin 
  Punkt := ord(ThousandSeparator); 
  Komma := ord(Decimalseparator); 
  with StringGrid1 do 
  begin 
    Options := Options + [goEditing]; 
    fixedRows := 1; 
    fixedCols := 1; 
    for x := 1 to ColCount - 1 do // Nummerieren der Spalten 
      if x <= 26 then 
        Cells[x, 0] := chr(x + 64) 
      else if x <= 256 then 
        Cells[x, 0] := chr((x - 1) div 26 + 64) + chr((x - 1) mod 26 + 65); 
    for x := 1 to RowCount - 1 do 
      Cells[0, x] := inttostr(x); 
  end; 
  ok := Feldwandeln(SummenFeld, SummCell) and Arealwandeln(Bereich, Felder); 
  if not ok then 
  begin 
    StringGrid1.Cells[0, 0] := 'Fehler'; 
    beep; 
  end; 
end; 
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
  Rect: TRect; State: TGridDrawState); 
begin 
  if (ACol = 4) and (ARow = 1) then // Summenfeld 
    with StringGrid1, Canvas do 
    begin 
      Brush.Color := clNavy; 
      Font.Color := clYellow; 
      FillRect(Rect); 
      Textout(Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]); 
    end; 
end; 
 
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; 
  const Value: string); 
var 
  x, y: Integer; 
  Ergebnis: Double; 
begin 
  with Felder do 
  begin 
    if ok and (ACol in [Anfang.Col .. Ende.Col]) and 
      (ARow in [Anfang.Row .. Ende.Row]) then 
    begin 
      Ergebnis := 0; 
      for y := Anfang.Row to Ende.Row do 
        for x := Anfang.Col to Ende.Col do 
        begin 
          if not isZahl(pchar(StringGrid1.Cells[x, y])) then 
            Continue; 
          Ergebnis := Ergebnis + StrToFloat 
            (Punktweg(PWideChar(StringGrid1.Cells[x, y]))); 
        end; 
      if Ergebnis <> 0 then 
        StringGrid1.Cells[SummCell.Col, SummCell.Row] := FloatToStr(Ergebnis) 
      else 
        StringGrid1.Cells[SummCell.Col, SummCell.Row] := ''; 
    end; 
  end; 
end;