Komponente Stringgrid mit ComboBox

[Ginko]

Hallo, ich versuche gerade eine Komponente zu erstellen, welche von einem Stringgrid abgeleitet ist und eine Combobox für verschiedene Felder enthält. Leider Stürzt der Compiler immer ab bei der überschriebenen SelectCell Funktion. Und die Zuweisung der Ereignisroutinen klappt auch nicht. Also OnChange := Nachricht; und OnExit:= WennExit;, obwohl ich sicher bin das die Parameter der Nachricht Prozedur richtig sind,
Hier mal der Code:

Delphi-Quellcode:

unit UComboGrid;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Variants, Grids, Forms, Dialogs, Controls,
  StdCtrls, Windows, Messages, Graphics, ComCtrls;

type

  {********************}
  {* Objekt ComboGrid *}
  {********************}
  TComboGrid = class(TStringGrid)
  private
    fKorrekturAuswahl: TComboBox;
  protected
    function SelectCell(ACol: Integer; ARow: Integer): Boolean; override;
    procedure WennExit(Sender: TObject);
  public
    constructor Create(AOwner: TComponent; TopPos: Integer); reintroduce;
    procedure Nachricht(Sender: TObject);
  end;


implementation


//ComboGrid Methoden

constructor TComboGrid.Create(AOwner: TComponent; TopPos: Integer);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl; //Typumwandlung
  Left := 10;
  Top := TopPos;
  DefaultColWidth := 25;
  DefaultRowHeight := 18;
  FixedCols   := 0;
  FixedRows   := 0;
  BorderStyle := bsNone;
  ColCount    := 17;
  RowCount    := 5;
  ColWidths[0] := 40;
  GridLineWidth := 1;
  Width := 500;
  Height := 200;
  ShowHint := True;
  ParentShowHint := True;
  OnExit:= WennExit;   //Ereignisroutine zuweisen
  //Selection:= TGridRect(Rect(-1, -1, -1, -1));

  fKorrekturAuswahl := TComboBox.Create(AOwner);
  with fKorrekturAuswahl do
  begin
    Parent := AOwner as TWinControl;
    Left := 10;
    Top := 10;
    width := 40;
    Visible:= True;
    OnChange := Nachricht; //Ereignisroutine zuweisen
  end;


end;

function TComboGrid.SelectCell(ACol: Integer; ARow: Integer): Boolean;
var
  CRect:TRect;
begin
  //ShowMessage('Ja');
 { if(ACol=1)then
  begin
    CRect:= CellRect(ACol, ARow);
    inc(CRect.Left, Left+2);
    inc(CRect.Right, Left+2);
    inc(CRect.Top, Top+2);
    inc(CRect.Bottom, Top+2);
    fKorrekturAuswahl.BoundsRect:=CRect;
    fKorrekturAuswahl.Visible:=true;
    fKorrekturAuswahl.ItemIndex:=integer(Objects[ACol, ARow])-1;
  end
    else fKorrekturAuswahl.Visible:= false;  } //Absturz ! 
end;


 //OnChange Ereignis von TComboBox
procedure TComboGrid.Nachricht(Sender: TObject);
begin
 ShowMessage('ja')
end;

procedure TComboGrid.WennExit(Sender: TObject);
begin
  if not(ActiveControl=fKorrekturAuswahl)then
  begin
    fKorrekturAuswahl.Visible:=false;
    //Selection:= TGridRect(Rect(-1, -1, -1, -1));
  end;
end;


end.

[Ginko]

Ist es vielleicht so, dass die SelectCell Funktion zu früh auf die ComboBox (fKorrekturAuswahl) zugreift und es deshalb zu einem Absturz kommt ?
Also das der Zugriff auf fKorrekturAuswahl geschieht bevor fKorrekturAuswahl := TComboBox.Create(AOwner); ausgeführt wurde ?
Und kann man das irgendwie abfangen ?

[Bjoerk]

Sicher, daß Parent := AOwner as TWinControl im Constructor schon zur Verfügung steht?

[Ginko]

Hi, danke für deine Antwort. Aber ich habe gerade das ganze unter Delphi 7 Pers. laufen lassen, da sind die Probleme die ich beschrieben habe gar nicht vorhanden. Scheint wohl an Lazarus zu liegen.
Aber warum ? Was macht Lazarus hier anders ?

[sx2008]

Zitat:

Zitat von Ginko (Beitrag 1211383)

Delphi-Quellcode:

unit UComboGrid;

type
  TComboGrid = class(TStringGrid)
  public
    constructor Create(AOwner: TComponent; TopPos: Integer); reintroduce;
  end;

Dein Konstruktor ist nicht in Ordnung, denn ab der Klasse TComponent ist der Konstruktor virtuell; und das aus gutem Grund.
Nur wenn der Konstruktor die gleiche Bauart (Signatur) hat wie von TComponent kann die dynamische Erzeugung von Komponenten aus einer DFM-Datei funktionieren.
Der Parameter TopPos ist zudem völlig überflüssig, weil

Delphi-Quellcode:

Top := TopPos

.

Falls du ein Stringgrid mit erweiterten Fähigkeiten willst dann schau dir mal das XStringGrid an.

[Bummi]

Ich hätte einen anders gearteten Vorschlag,noch nicht als fertige Komponente ...
Hier wird statt des TInplaceedits ein TInplaceEditList erzeugt.

Delphi-Quellcode:

unit StringGrid_Lookup;

interface
  // 2013 bummi
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type

  TGetEditStyleEvent = procedure(TSender: TObject; ACol, ARow: integer;
    var EditStyle: TEditStyle) of object;

  TGetPickListItemsEvent = procedure(TSender: TObject; ACol, ARow: integer;
    Items: TStrings) of Object;

  TStringGrid = Class(Grids.TStringGrid)
  private
    FOnGetEditStyle: TGetEditStyleEvent;
    FOnGetPickListItems: TGetPickListItemsEvent;
    Procedure GetPickListItems(ACol, ARow: integer; Items: TStrings);
  public
    function CreateEditor: TInplaceEdit; override;
    function GetEditStyle(ACol, ARow: integer): TEditStyle; override;
  published
    Property OnGetPickListItems : TGetPickListItemsEvent read FOnGetPickListItems write FOnGetPickListItems;
    Property OnGetEditStyle : TGetEditStyleEvent read FOnGetEditStyle write FOnGetEditStyle;
  End;

  TForm6 = class(TForm)
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    procedure OnGetEditStyle(Sender: TObject; ACol, ARow: integer; var EditStyle: TEditStyle);
    procedure OnGetPickListItems(Sender: TObject; ACol, ARow: integer; Items: TStrings);

    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form6: TForm6;

implementation

{$R *.dfm}

Procedure TForm6.OnGetEditStyle(Sender: TObject; ACol, ARow: integer;
  var EditStyle: TEditStyle);
begin
  if ACol = 2 then
    EditStyle := esPickList;
end;

procedure TForm6.OnGetPickListItems(Sender: TObject; ACol, ARow: integer;
  Items: TStrings);
begin
  if ACol = 2 then
    Items.Assign(Memo1.Lines);

end;

procedure TForm6.FormCreate(Sender: TObject);
begin
  StringGrid1.OnGetEditStyle := OnGetEditStyle;
  StringGrid1.OnGetPickListItems := OnGetPickListItems;
end;

{ StringGrid }

function TStringGrid.CreateEditor: TInplaceEdit;
begin
  Result := TInplaceEditList.Create(Self);
  TInplaceEditList(Result).OnGetPickListItems := GetPickListItems;
  TInplaceEditList(Result).DropDownRows := 8;

end;

function TStringGrid.GetEditStyle(ACol, ARow: integer): TEditStyle;
begin
  Result := esSimple;
  if Assigned(FOnGetEditStyle) then
    FOnGetEditStyle(Self, ACol, ARow, Result);
end;

procedure TStringGrid.GetPickListItems(ACol, ARow: integer; Items: TStrings);
begin
  if Assigned(FOnGetPickListItems) then
    FOnGetPickListItems(Self, ACol, ARow, Items);
end;

end.

[Bjoerk]

Zitat:

Zitat von Ginko (Beitrag 1211412)

Ich habe gerade das ganze unter Delphi 7 Pers. laufen lassen, da sind die Probleme die ich beschrieben habe gar nicht vorhanden. Scheint wohl an Lazarus zu liegen.Aber warum ? Was macht Lazarus hier anders ?

Kann sein, daß das Parent(Handle) von Lazarus anders vergeben wird, als von Delphi, das kann ich nicht beurteilen, ich benutze keine Lazarus. Wo aber auf jeden Fall eins zur Verfügung steht ist in Loaded. Und wegen dem Constructor (Siehe SX2008) wenn du das TopPos nicht brauchst, einfach so:

Delphi-Quellcode:

protected
  procedure Loaded; override;
public
  constructor Create(AOwner: TComponent); override;

[Ginko]

Hey danke für die Anwtorten. Ich hab mal alles versucht.

Zitat:

Zitat von Bjoerk (Beitrag 1211422)

Delphi-Quellcode:

protected
  procedure Loaded; override;
public
  constructor Create(AOwner: TComponent); override;

Bringt bei Lazarus leider keine Besserung. Für was ist die Loaded Methode ? Und wann wird die aufgerufen ?


@Bummi wie bringt man bei deinem Beispiel die ComboBox zum Vorschein, muss man da noch was übergeben oder ersetzen ?

@sx2008 XStringGrid ist ne tolle Sache, bekomme ich aber nicht zum Laufen unter Lazarus

[Bummi]

Sie kommt um Vorschein wenn der Editor angezeigt wird, je nach Gusto verhält sich das Gitter erwartungsgemäß wenn goTabs, goAlwaysShowEditor angehakt sind.

[Ginko]

So hab die Options mal entsprechend gesetzt aber leider erscheint keine ComboBox wenn ich die Zellen anklicke. Das ganze Compiliert ohne probleme in Delphi 7 Pers.

Delphi-Quellcode:

unit Unit1;

interface
  // 2013 bummi
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type

  TGetEditStyleEvent = procedure(TSender: TObject; ACol, ARow: integer;
    var EditStyle: TEditStyle) of object;

  TGetPickListItemsEvent = procedure(TSender: TObject; ACol, ARow: integer;
    Items: TStrings) of Object;

  TStringGrid = Class(Grids.TStringGrid)
  private
    FOnGetEditStyle: TGetEditStyleEvent;
    FOnGetPickListItems: TGetPickListItemsEvent;
    Procedure GetPickListItems(ACol, ARow: integer; Items: TStrings);
  public
    function CreateEditor: TInplaceEdit; override;
    function GetEditStyle(ACol, ARow: integer): TEditStyle; override;
  published
    Property OnGetPickListItems : TGetPickListItemsEvent read FOnGetPickListItems write FOnGetPickListItems;
    Property OnGetEditStyle : TGetEditStyleEvent read FOnGetEditStyle write FOnGetEditStyle;
  End;

  TForm1 = class(TForm)
    Memo1: TMemo;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure OnGetEditStyle(Sender: TObject; ACol, ARow: integer; var EditStyle: TEditStyle);
    procedure OnGetPickListItems(Sender: TObject; ACol, ARow: integer; Items: TStrings);

    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.OnGetEditStyle(Sender: TObject; ACol, ARow: integer;
  var EditStyle: TEditStyle);
begin
  if ACol = 2 then
    EditStyle := esPickList;
end;

procedure TForm1.OnGetPickListItems(Sender: TObject; ACol, ARow: integer;
  Items: TStrings);
begin
  if ACol = 2 then
    Items.Assign(Memo1.Lines);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.OnGetEditStyle := OnGetEditStyle;
  StringGrid1.OnGetPickListItems := OnGetPickListItems;
end;

//Änderung gegenüber Orignal
procedure TForm1.FormShow(Sender: TObject);
begin
  StringGrid1.Options := StringGrid1.Options  + [goTabs] + [goEditing] + [goAlwaysShowEditor];
end;


{ StringGrid }

function TStringGrid.CreateEditor: TInplaceEdit;
begin
  Result := TInplaceEditList.Create(Self);
  TInplaceEditList(Result).OnGetPickListItems := GetPickListItems;
  TInplaceEditList(Result).DropDownRows := 8;

end;

function TStringGrid.GetEditStyle(ACol, ARow: integer): TEditStyle;
begin
  Result := esSimple;
  if Assigned(FOnGetEditStyle) then
    FOnGetEditStyle(Self, ACol, ARow, Result);
end;

procedure TStringGrid.GetPickListItems(ACol, ARow: integer; Items: TStrings);
begin
  if Assigned(FOnGetPickListItems) then
    FOnGetPickListItems(Self, ACol, ARow, Items);
end;


end.

[Bummi]

Ich habe hier Zuhause leider nur ein 2010 er Delphi und hier funktioniert es problemlos. Falls sich niemand anderes findet um zu suchen, kann ich es morgen im Büro an einer VM mit D7 versuchen.

EDIT:

Läuft auch unter D7 problemlos, dass der Beispielcode nur bei Column eine "Combobox" anzeigt hast Du gesehen?

Delphi-Quellcode:

 if ACol = 2 then .....

[Ginko]

Zitat:

Zitat von Bummi (Beitrag 1211465)

Läuft auch unter D7 problemlos, dass der Beispielcode nur bei Column eine "Combobox" anzeigt hast Du gesehen?

Delphi-Quellcode:

 if ACol = 2 then .....

Ja, ich habe alle Felder durchprobiert, dann muss es wohl was mit meiner Delphi Insatllation zu tun haben, obwohl ich es einmal unter Virtualbox und einmal in einer echten XP-Installation versucht hatte.

Naja ich werd dann wohl mit der Version unten vorlieb nehmene müssen und auf die flexiblere Laufzeiterstellung verzichten...
Aber was gut ist, die Version läuft auch unter Lazarus.
Trotzdem Danke für die Antworten.

Delphi-Quellcode:

{ StringGrid mit ComboBox }

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  CRect:TRect;
begin
  if(ACol=1)then
  begin
    CRect:=StringGrid1.CellRect(ACol, ARow);
    inc(CRect.Left, StringGrid1.Left+2);
    inc(CRect.Right, StringGrid1.Left+2);
    inc(CRect.Top, StringGrid1.Top+2);
    inc(CRect.Bottom, StringGrid1.Top+2);
    ComboBox1.BoundsRect:=CRect;
    ComboBox1.Visible:=true;
    ComboBox1.ItemIndex:=integer(StringGrid1.Objects[ACol, ARow])-1;
  end
    else ComboBox1.Visible:=false;
end;


procedure TForm1.StringGrid1Exit(Sender: TObject);
begin
  if not(ActiveControl=ComboBox1)then
  begin
    ComboBox1.Visible:=false;
    StringGrid1.Selection:= TGridRect(Rect(-1, -1, -1, -1));
  end;
end;


procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
  if not(ActiveControl = StringGrid1)then
  begin
    ComboBox1.Visible:= false;
    StringGrid1.Selection:= TGridRect(Rect(-1, -1, -1, -1));
  end;
end;


procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
var
  GRect:TGridRect;
begin
  ComboBox1.Visible:= false;
  GRect:= StringGrid1.Selection;
  if(GRect.Left = 0) and (GRect.Right = 0)then
    begin
    inc(GRect.Left, 1);
    inc(GRect.Right, 1);
    end;
  StringGrid1.Selection:=GRect;
end;