[Gelöst] TDrawGrid
-
- Lazarusforum e. V.
- Beiträge: 999
- Registriert: Do 17. Apr 2008, 01:59
- OS, Lazarus, FPC: Mint 21.1 Cinnamon / FPC 3.2.2/Lazarus 2.2.4
- CPU-Target: Intel i7-10750 64Bit
- Wohnort: Freiburg
[Gelöst] TDrawGrid
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
Ist dieses Verhalten normal und lässt sich das abstellen?
Neues Projekt, TDrawGrid auf Form setzen, in OnDrawCell DebugLN('Tick'); eingeben, starten und staunen
Zuletzt geändert von MacWomble am So 10. Mär 2019, 13:04, insgesamt 1-mal geändert.
Alle sagten, dass es unmöglich sei - bis einer kam und es einfach gemacht hat.
Re: TDrawGrid
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;
-
- Lazarusforum e. V.
- Beiträge: 999
- Registriert: Do 17. Apr 2008, 01:59
- OS, Lazarus, FPC: Mint 21.1 Cinnamon / FPC 3.2.2/Lazarus 2.2.4
- CPU-Target: Intel i7-10750 64Bit
- Wohnort: Freiburg
Re: TDrawGrid
Hm, du hast Recht.
Ich habe zwei DrawGrid auf der Form, irgendwie wird da bei mir was rekursiv - ich suche nochmal.
Ich habe zwei DrawGrid auf der Form, irgendwie wird da bei mir was rekursiv - ich suche nochmal.
Alle sagten, dass es unmöglich sei - bis einer kam und es einfach gemacht hat.
Re: TDrawGrid
Vielleicht enthält der OnDrawCell-Code des einen Grid den Namen des anderen?
-
- Lazarusforum e. V.
- Beiträge: 999
- Registriert: Do 17. Apr 2008, 01:59
- OS, Lazarus, FPC: Mint 21.1 Cinnamon / FPC 3.2.2/Lazarus 2.2.4
- CPU-Target: Intel i7-10750 64Bit
- Wohnort: Freiburg
Re: TDrawGrid
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:
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.
Alle sagten, dass es unmöglich sei - bis einer kam und es einfach gemacht hat.
Re: TDrawGrid
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.
-
- Lazarusforum e. V.
- Beiträge: 999
- Registriert: Do 17. Apr 2008, 01:59
- OS, Lazarus, FPC: Mint 21.1 Cinnamon / FPC 3.2.2/Lazarus 2.2.4
- CPU-Target: Intel i7-10750 64Bit
- Wohnort: Freiburg
Re: TDrawGrid
Eigentlich logisch, aber das hätte ich nie gefunden. Danke vielmals, es funktioniert wieder!
Alle sagten, dass es unmöglich sei - bis einer kam und es einfach gemacht hat.