[Gelöst] TDrawGrid

[MacWomble]

Mir ist eben aufgefallen, dass OnDrawCell in TDrawGrid ununterbrochen (auch wenn ich nichts mache) aufgerufen wird.
Ist dieses Verhalten normal und lässt sich das abstellen?

Neues Projekt, TDrawGrid auf Form setzen, in OnDrawCell DebugLN('Tick'); eingeben, starten und staunen

[wp_xyz]

OnDrawGrid? Gibt es nicht, meinst du OnDrawCell? Hier kann ich das Verhalten nicht bestätigen. Ein neues Formular mit einem DrawGrid und dem folgenden OnDrawCell-Handler, der bei jedem Aufruf einen Zähler hochzählt und den Zählerstand im Form-Caption anzeigt, demonstriert, dass der Zähler zum Stillstand kommt, wenn alle Zellen gezeichnet sind.

Code: Alles auswählen

var
  Counter: Integer = 0;
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
  inc(Counter);
  Caption := IntToStr(Counter);
end;     

[MacWomble]

Hm, du hast Recht.

Ich habe zwei DrawGrid auf der Form, irgendwie wird da bei mir was rekursiv - ich suche nochmal.

[wp_xyz]

Vielleicht enthält der OnDrawCell-Code des einen Grid den Namen des anderen?

[MacWomble]

Nein, das ist es leider nicht.

Ursprünglich gabe es nur das Grid dgAdresse. Nachdem ich nun dgKontakt hinzugefügt habe, tritt das Problem auf:

Code: Alles auswählen

 
unit fruadressliste;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, Grids, Graphics,
  Dialogs, LCLProc, Types, cuadresse, cukontakt, fuadresseditor;
 
type
  { TfrAdressliste }
 
  TfrAdressliste = class(TFrame)
    btnEditAdresse: TButton;
    btnInsertAdresse: TButton;
    btnDeleteAdresse: TButton;
    btnSpeichern: TButton;
    btnVerwerfen: TButton;
    dgAdresse: TDrawGrid;
    dgKontakt: TDrawGrid;
    ltKontakte: TLabel;
    pnlButtons: TPanel;
    pnlHeader: TPanel;
    procedure btnDeleteAdresseClick(Sender: TObject);
    procedure btnEditAdresseClick(Sender: TObject);
    procedure btnInsertAdresseClick(Sender: TObject);
    procedure btnSpeichernClick(Sender: TObject);
    procedure btnVerwerfenClick(Sender: TObject);
    procedure dgAdresseDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
    procedure dgKontaktDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
    procedure FrameResize(Sender: TObject);
  private
    A: TAdresse;
    K: TKontakt;
    FAdresse: TAdresse;
    FHasInfo: boolean;
    FOnFertig: TNotifyEvent;
 
    procedure SetAdresse(AValue: TAdresse);
    procedure SetHasInfo(Avalue: boolean);
    procedure SetOnFertig(AValue: TNotifyEvent);
  public
    procedure InitGridAdresse;
    procedure InitGridKontakt;
 
    property HasInfo: boolean read FHasInfo write SetHasInfo;
    property OnFertig: TNotifyEvent read FOnFertig write SetOnFertig;
    property Adresse: TAdresse read FAdresse write SetAdresse;
  protected
    function GetAdressIndex: integer;
    function GetCellText(ACol, ARow: integer): string;
    function GetCellTextKontakt(ACol, ARow: integer): string;
  end;
 
var
counter:integer;
 
 
implementation
 
{$R *.frm}
 
{ TfrAdressliste }
 
{ dgAdresse Zeichnen }
procedure TfrAdressliste.dgAdresseDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
var
  txt: string;
  TextStyle: TTextStyle;
begin
  { Zellinhalt Holen }
  txt := GetCellText(ACol, ARow);
  { Spalte Fett }
  if Acol = 2 then
    dgAdresse.Canvas.Font.Style := [fsBold];
 
  { Farben setzen }
  if A.IDColor > 0 then
    if (aCol > 0) and (aRow >= dgAdresse.FixedRows) then
    begin
      if AState * [gdFocused, gdSelected] <> [] then
      begin
        dgAdresse.Canvas.Font.Color := StringToColor(A.Colorhfont);
        dgAdresse.Canvas.Brush.Color := StringToColor(A.Colorh);
 
                                                             { Ich dachte zuerst, es liegt hier dran: Aber das Problem existiert auch, wenn ich die Zeilen Remarke }
        //if ACol = 1 then
        //begin
        //  KontaktListe.Clear;
        //  KontaktListe.ReadAllByAdressID(A.ID);
        //  InitGridKontakt;
        //end;
 
      end
      else
      begin
        dgAdresse.Canvas.Font.Color := StringToColor(A.Colornfont);
        dgAdresse.Canvas.Brush.Color := StringToColor(A.Colorn);
      end;
    end;
 
  { Textstyle definieren }
  if aRow = 0 then
    TextStyle.Alignment := taCenter
  else
    case ACol of
      0: TextStyle.Alignment := taCenter;
      1: TextStyle.Alignment := taCenter; //Anrede
      2: TextStyle.Alignment := taLeftJustify; // Name
      3: TextStyle.Alignment := taLeftJustify; // Vorname
      4: TextStyle.Alignment := taLeftJustify; // Firma
      5: TextStyle.Alignment := taLeftJustify;      // Zusatz
      6: TextStyle.Alignment := taCenter;      // PLZ
      7: TextStyle.Alignment := taLeftJustify;// Ort
      8: TextStyle.Alignment := taLeftJustify;// Straße
    end;
  TextStyle.Layout := tlCenter;
  TextStyle.SingleLine := True;
  TextStyle.Clipping := True;
  TextStyle.ExpandTabs := True;
  TextStyle.ShowPrefix := True;
  TextStyle.Wordbreak := True;
  TextStyle.Opaque := False;
  TextStyle.SystemFont := False;
  TextStyle.RightToLeft := False;
  TextStyle.EndEllipsis := False;
 
  dgAdresse.Canvas.FillRect(ARect);
  InflateRect(ARect, -varCellpadding, -varCellpadding);   // Rechteck kleiner machen
  dgAdresse.Canvas.TextRect(ARect, ARect.Left + constCellPadding, ARect.Top + constCellPadding, txt, TextStyle);
 
end;
 
procedure TfrAdressliste.dgKontaktDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
var
  txt: string;
  TextStyle: TTextStyle;
begin
  { Zellinhalt Holen }
  txt := GetCellTextKontakt(ACol, ARow);
  { Spalte Fett }
  if Acol = 2 then
    dgKontakt.Canvas.Font.Style := [fsBold];
 
  { Farben setzen }
  if Assigned(K) then
  if K.IDColor > 0 then
    if (aCol > 0) and (aRow >= dgKontakt.FixedRows) then
    begin
      if AState * [gdFocused, gdSelected] <> [] then
      begin
        dgKontakt.Canvas.Font.Color := StringToColor(K.Colorhfont);
        dgKontakt.Canvas.Brush.Color := StringToColor(K.Colorh);
      end
      else
      begin
        dgKontakt.Canvas.Font.Color := StringToColor(K.Colornfont);
        dgKontakt.Canvas.Brush.Color := StringToColor(K.Colorn);
      end;
    end;
 
  { Textstyle definieren }
  if aRow = 0 then
    TextStyle.Alignment := taCenter
  else
    case ACol of
      0: TextStyle.Alignment := taCenter;
      1: TextStyle.Alignment := taCenter; //Anrede
      2: TextStyle.Alignment := taLeftJustify; // Name
      3: TextStyle.Alignment := taLeftJustify; // Vorname
      4: TextStyle.Alignment := taLeftJustify; // Abteilung
      5: TextStyle.Alignment := taLeftJustify; // Funktion
    end;
  TextStyle.Layout := tlCenter;
  TextStyle.SingleLine := True;
  TextStyle.Clipping := True;
  TextStyle.ExpandTabs := True;
  TextStyle.ShowPrefix := True;
  TextStyle.Wordbreak := True;
  TextStyle.Opaque := False;
  TextStyle.SystemFont := False;
  TextStyle.RightToLeft := False;
  TextStyle.EndEllipsis := False;
 
  dgKontakt.Canvas.FillRect(ARect);
  InflateRect(ARect, -varCellpadding, -varCellpadding);   // Rechteck kleiner machen
  dgKontakt.Canvas.TextRect(ARect, ARect.Left + constCellPadding, ARect.Top + constCellPadding, txt, TextStyle);
 
   inc(Counter);
   DebugLn('tik '+IntToStr(Counter));            { Dieser Zähler läuft unendlich }
end;
 
procedure TfrAdressliste.FrameResize(Sender: TObject);
begin
  InitGridAdresse;
end;
 
{ dgAdresse Initialisieren }
procedure TfrAdressliste.InitGridAdresse;
var
  v: integer;
begin
  { Einstellungen DrawGrid }
  dgAdresse.Colcount := dgAdresse.FixedCols + 8; // Wert an GetCellText anpassen!
 
  dgAdresse.RowCount := Adressliste.Count + dgAdresse.FixedRows;
  dgAdresse.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goSmoothScroll, goRowHighlight];
  dgAdresse.ScrollBars := ssVertical;
  dgAdresse.FixedCols := 1;
  dgAdresse.FixedRows := 1;
  v := (dgAdresse.Width - 15 - 920) div 6; { 1 variable Spalte v }
  dgAdresse.ColWidths[0] := 30;   // Width 715
  dgAdresse.ColWidths[1] := 100;  // Anrede
  dgAdresse.ColWidths[2] := 150 + v;  // Name
  dgAdresse.ColWidths[3] := 100 + v;  // Vorname
  dgAdresse.ColWidths[4] := 150 + v;  // Firma
  dgAdresse.ColWidths[5] := 150 + v;  // Zusatz
  dgAdresse.ColWidths[6] := 60;  // PLZ
  dgAdresse.ColWidths[7] := 80 + v;  // Ort
  dgAdresse.ColWidths[8] := 100 + v;  // Straße
end;
 
{ dgKontakt Initialisieren }
procedure TfrAdressliste.InitGridKontakt;
var
  v: integer;
begin
  { Einstellungen DrawGrid }
  dgKontakt.Colcount := dgKontakt.FixedCols + 5; // Wert an GetCellText anpassen!
 
  dgKontakt.RowCount := KontaktListe.Count + dgKontakt.FixedRows;
  dgKontakt.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goSmoothScroll, goRowHighlight];
  dgKontakt.ScrollBars := ssVertical;
  dgKontakt.FixedCols := 1;
  dgKontakt.FixedRows := 1;
  v := (dgKontakt.Width - 15 - 780) div 4; { 1 variable Spalte v }
  dgKontakt.ColWidths[0] := 30;   // Width 715
  dgKontakt.ColWidths[1] := 100;  // Anrede
  dgKontakt.ColWidths[2] := 150 + v;  // Name
  dgKontakt.ColWidths[3] := 100 + v;  // Vorname
  dgKontakt.ColWidths[4] := 200 + v;  // Abteilung
  dgKontakt.ColWidths[5] := 200 + v;  // Funktion
end;
 
 
{ GridIndex Adresse Holen }
function TfrAdressliste.GetAdressIndex: integer;
begin
  Result := dgAdresse.Row - dgAdresse.FixedRows;
end;
 
{ Adressauswahl Beenden }
procedure TfrAdressliste.btnSpeichernClick(Sender: TObject);
var
  idx: integer;
begin
  idx := GetAdressIndex;
  if idx < 0 then
    exit;
  SetAdresse(Adressliste[idx]);
  if Assigned(FOnFertig) then
    FHasInfo := True;
  FOnFertig(Sender);
  exit;
end;
 
{ Adressauswahl Verwerfen }
procedure TfrAdressliste.btnVerwerfenClick(Sender: TObject);
begin
  if Assigned(FOnFertig) then
    FHasInfo := False;
  FOnFertig(Sender);
  exit;
end;
 
{ AdressEditor zum Editieren Starten }
procedure TfrAdressliste.btnEditAdresseClick(Sender: TObject);
var
  i, idx: integer;
  aID, Aindex: integer;
begin
  idx := GetAdressIndex;
  if idx < 0 then
    exit;
  A := Adressliste[idx];
  aID := CallAdressEditor(A);
 
  Adressliste.ReadAll;
  Aindex := Adressliste.IndexOf(aID);
  if AIndex >= 0 then
    dgAdresse.Row := AIndex + dgAdresse.FixedRows;
end;
 
{ Adresse Löschen inkl. Preisen }
procedure TfrAdressliste.btnDeleteAdresseClick(Sender: TObject);
var
  idx: integer;
begin
  idx := GetAdressIndex;
  if idx < 0 then
    exit;
  if MessageDlg('Diese Adresse wirklich löschen?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    A := Adressliste[idx];
    Adressliste.DeleteByID(A.ID);
    Adressliste.Delete(idx);
    dgAdresse.RowCount := dgAdresse.RowCount - 1;
    if idx >= Adressliste.Count then
      idx := Adressliste.Count - 1;
    dgAdresse.Row := dgAdresse.FixedRows + idx;
    dgAdresse.Invalidate;
  end;
end;
 
{ AdressEditor zum Erstellen Starten }
procedure TfrAdressliste.btnInsertAdresseClick(Sender: TObject);
var
  aID, Aindex: integer;
begin
  aID := CallNewAdressEditor;
  if aID > 0 then
  begin
    Adressliste.ReadAll;
    dgAdresse.RowCount := dgAdresse.FixedRows + Adressliste.Count;
    dgAdresse.Invalidate;
    Aindex := Adressliste.IndexOf(aID);
    if AIndex >= 0 then
      dgAdresse.Row := AIndex + dgAdresse.FixedRows;
  end;
end;
 
{ dgAdresse Daten Einlesen }
function TfrAdressliste.GetCellText(ACol, ARow: integer): string;
begin
  if ARow = 0 then
  begin
    case ACol of
      0: Result := '';
      1: Result := 'Anrede';
      2: Result := 'Name / Firma';
      3: Result := 'Vorname';
      4: Result := 'Firma 2. Zeile';
      5: Result := 'Zusatz';
      6: Result := 'PLZ';
      7: Result := 'Ort';
      8: Result := 'Straße';
    end;
    dgAdresse.SetFocus;
  end
  else
  if Adressliste.Count > 0 then
  begin
    A := Adressliste[ARow - dgAdresse.FixedRows];
    if A = nil then
      Result := ''
    else
      case ACol of
        0: Result := IntToStr(ARow);
        1: Result := A.Anrede;
        2: Result := A.FirmaZuname;
        3: Result := A.Vorname;
        4: Result := A.Firma2;
        5: Result := A.Zusatz;
        6: Result := A.Plz;
        7: Result := A.Ort;
        8: Result := A.StrasseNr;
      end;
  end;
end;
 
{ dgKontakt Daten Einlesen }
function TfrAdressliste.GetCellTextKontakt(ACol, ARow: integer): string;
begin
  if ARow = 0 then
  begin
    case ACol of
      0: Result := '';
      1: Result := 'Anrede';
      2: Result := 'Name';
      3: Result := 'Vorname';
      4: Result := 'Abteilung';
      5: Result := 'Funktion';
    end;
    dgKontakt.SetFocus;
  end
  else
  if KontaktListe.Count > 0 then
  begin
    K := KontaktListe[ARow - dgKontakt.FixedRows];
    if K = nil then
      Result := ''
    else
      case ACol of
        0: Result := IntToStr(ARow);
        1: Result := K.Anrede;
        2: Result := K.Zuname;
        3: Result := K.Vorname;
        4: Result := K.Abteilung;
        5: Result := K.Funktion;
      end;
  end;
end;
 
procedure TfrAdressliste.SetHasInfo(Avalue: boolean);
begin
  if FHasInfo = AValue then
    Exit;
  FHasInfo := AValue;
end;
 
procedure TfrAdressliste.SetAdresse(AValue: TAdresse);
begin
  if FAdresse = AValue then
    Exit;
  FAdresse := AValue;
end;
 
procedure TfrAdressliste.SetOnFertig(AValue: TNotifyEvent);
begin
  if FOnFertig = AValue then
    Exit;
  FOnFertig := AValue;
end;
 
end.

[wp_xyz]

Ich denke, du darfst in GetCellText und GetCellTextKontakt nicht das SetFocus des zugehörigen Grids aufrufen, denn dieses bewirkt ein Neuzeichnen. Diese Funktionen dürfen NUR den in den entsprechenden Zellen anzuzeigenden Text zurückliefern. SetFocus darf auf keinen Fall innerhalb des OnDrawCellHandlers bzw. den von dort aufgerufenen Routinen erfolgen.

[MacWomble]

Eigentlich logisch, aber das hätte ich nie gefunden. Danke vielmals, es funktioniert wieder!