DateTimePicker w polu StringGrid'a.

0

Witam, tworzę projekt w którym znajduje się StringGrid i chciałbym, by w kolumnie nr.3 wyświetlał się ComboBox, a w nr.4 DateTimePicker (po kliknięciu na nie).
Z pierwszym sobie poradziłem z pomocą tej strony.
Jednak postępując analogicznie z drugim (DateTimePicker-em), nie udaje mi się osiągnąć zamierzonego efektu i otrzymuję błąd 'access violation at...' przy kliknięciu na komórkę z kolumny nr.4.
Będę wdzięczny za wszelkie podpowiedzi.
Kod wykorzystywanych procedur:

procedure tform1.movedater(sender: TObject);
  var rect:trect;gwidth:integer;
begin
  rect:=stringgrid1.CellRect(stringgrid1.Col,stringgrid1.row);
  gwidth:=stringgrid1.GridLineWidth;
  panel:=tpanel.Create(Form1);
  with panel do
  begin
    parent:=stringgrid1;
    visible:=true;
    bevelouter:=bvnone;
    ctl3d:=false;
    parentbackground:=false;
    parentcolor:=false;
    color:=clWhite;
    caption:='';
    top:=rect.Top+gwidth;
    left:=rect.Left+gwidth;
    height:=(rect.Bottom-rect.Top)+1;
    width:=(rect.Left-rect.Right)+1;
  end;
  dator:=tdatetimepicker.Create(Form1);
  with dator do
  begin
    parent:=panel;
    left:=0;
    top:=0;
    width:=mypanel.Width;
    height:=mypanel.Height;
    datemode:=dmcombobox;
    kind:=dtkDate;
    mindate:=strtodate('1947-01-01');
    maxdate:=now;
    OnChange:=datorchange;
  end;
end;

procedure tform1.datorchange(sender: TObject);
begin
  stringgrid1.Cells[stringgrid1.Col,stringgrid1.Row]:=datetostr(dator.DateTime);
  panel.Visible:=false;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  if stringgrid1.Col=2 then
  begin
    moveeditor(sender);
    myeditor.DroppedDown:=true;
  end
  else
  begin
    if stringgrid1.Col=3 then
    begin
      movedater(sender);
    end;
  end;
end;
0

Sprawdzałeś ten kod pod debuggerem? To powinieneś zrobić od razu, skoro dostajesz wyjątek AV; Przeglądnij kod instrukcja po instrukcji i znajdziesz przyczynę, a co najmniej będziesz dokładnie wiedział która linijka jest przyczyną rzucenia wyjątku;

PS: I jak podajesz informacje o błędzie, to wklejaj/przepisujj całą jego treść, a nie "access violation at..."

1
var
  dtp: TDateTimePicker;

procedure TForm1.dtpChange(Sender: TObject);
begin
  sg.Cells[sg.Col, sg.Row]:=DateToStr(dtp.DateTime);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  dtp:=TDateTimePicker.Create(Form1);
  dtp.Parent:=Form1;
  dtp.Visible:=False;
  dtp.AutoSize:=False;
  dtp.OnChange:=@dtpChange;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  dtp.Free;
end;

procedure TForm1.sgDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
begin
  if (ACol=2) and (aRow=sg.Row) then
  begin
    dtp.Left:=sg.Left+aRect.Left+2;
    dtp.Top:=sg.Top+aRect.Top+2;
    dtp.Width:=aRect.Right-aRect.Left;
    dtp.Height:=aRect.Bottom-aRect.Top;
  end;
end;

procedure TForm1.sgSelectCell(Sender: TObject; aCol, aRow: Integer;
  var CanSelect: Boolean);
begin
  if (ACol=2) then
  dtp.Visible:=True
  else
  dtp.Visible:=False;
end;
1

Nieco szybszy kod, niż podany przez @Paweł Dmitruk:

procedure TForm1.sgDrawCell(Sender: TObject; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
  rctBounds: TRect;
begin
  if (ACol = 2) and (aRow = sg.Row) then
  begin
    rctBounds.Left   := sg.Left + ARect.Left + 2;
    rctBounds.Top    := sgTop + ARect.Top + 2;
    rctBounds.Right  := rctBounds.Left + (ARect.Right - ARect.Left);
    rctBounds.Bottom := rctBounds.Top + (ARect.Bottom - ARect.Top);

    dtp.BoundsRect := rctBounds;
  end;
end;

Jeśli trzeba ustalić w jednym miejscu od razu pozycję i rozmiar komponentu to nie należy korzystać z poszczególnych właściwości; W zamian należy skorzystać z metody SetBounds lub właściwości BoundsRect; Dzięki temu komponent zostanie tylko raz przemieszczony i/lub rozciągnięty oraz tylko raz przemalowany, a nie cztery razy; Nawet jeśli trzeba będzie użyć dodatkowej zmiennej to i tak będzie to o wiele szybsze rozwiązanie, dodatkowo interfejs nie będzie "migać";

Jeśli o następną metodę chodzi to wystarczy tyle:

procedure TForm1.sgSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  dtp.Visible := ACol = 2;
end;

I w warunku mamy wartość logiczną i właściwość Visible jest typu logicznego, więc warunek zbędny, tak samo jak nawiasy.

1 użytkowników online, w tym zalogowanych: 0, gości: 1