TStringGrid с кнопками SpeedButton

Я хочу иметь кнопку со значком в конце каждой строки.

Как здесь:

введите здесь описание изображения

я пробовал это

procedure TMyFrame.sgrd1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  canvas: TCanvas;
  sgrd: TStringGrid;
  point: TPoint;
  btn: TSpeedButton;
begin
  sgrd := TStringGrid(Sender);
  canvas := sgrd.Canvas;

  canvas.FillRect(Rect);

  if (ACol = 1) then 
  begin
    point := Self.ScreenToClient(ClientToScreen(Rect.TopLeft));

    btn := TSpeedButton.Create(sgrd);

    btn.Parent := sgrd;

    btn.OnClick := SpeedButton1Click;
    btn.Tag := ARow;

    btn.enabled:=true;
    btn.visible:= true;

    btn.Top := point.Y;
    btn.Left := point.X;
    btn.Width := 20;
    btn.Height := 24;
  end;
end;

но кнопка не выглядит «живой», хотя событие щелчка работает. Нет щелчка, анимации наведения, фокусировки и т. д.


delphi vcl delphi-7 tstringgrid
person Alex P.    schedule 11.12.2013    source источник

Ответы (2)


arrow_upward
1
arrow_downward

Проблема в том, что вы постоянно создаете новую кнопку скорости каждый раз, когда ячейка нуждается в обновлении. Вы должны создать кнопки в событии Create.

procedure TForm1.FormCreate(Sender: TObject);
var
  canvas: TCanvas;
  point: TPoint;
  btn: TSpeedButton;
  row : integer;
  rect: TRect;
begin
  for row:=0 to stringGrid1.RowCount-1 do
   begin
    rect := stringGrid1.CellRect(1,row);
    point := ScreenToClient(ClientToScreen(Rect.TopLeft));
    btn := TSpeedButton.Create(StringGrid1);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.Tag := row;
    btn.enabled:=true;
    btn.visible:= true;
    btn.Top := point.Y;
    btn.Left := point.X;
    btn.Width := 20;
    btn.Height := 24;
  end;
person PA.    schedule 11.12.2013
comment
О, я собирался сделать это, но я думал, что это не решит мою проблему. Хотя я перерисовывал его только тогда, когда я заполняю его значениями и когда обновляются окна (например, изменение размера и т. - person Alex P.; 11.12.2013
comment
Алекс, с изменением размера и прокруткой вам все равно придется как-то справляться. См. this post, например. - person TLama; 11.12.2013
comment
Я знаю, я не говорил об изменении размера сетки, в моем случае он фиксированный и без полос прокрутки. Я имел в виду, что я думал, что событие DrawCell срабатывает только при изменении содержимого или когда происходит что-то вроде изменения размера окна, поэтому просто для быстрого теста я поместил в него этот код. Но похоже, что он срабатывает намного чаще, и это была моя проблема. - person Alex P.; 11.12.2013

arrow_upward
3
arrow_downward

Предполагая, что вы можете захотеть иметь возможность прокручивать StringGrid и иметь кнопки, связанные с выбранной строкой, вам придется реализовать обработчик для TopLeftChanged. Кнопки не будут перемещаться, если вы прокручиваете свою Stringgrid без реализации кода для этого.

procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
  Showmessage(TSpeedButton(Sender).Name  + ' ' +  IntToStr(TSpeedButton(Sender).Tag));
end;

const
  C_COL = 4;

procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := TStringGrid(Sender).CellRect(C_COL, TStringGrid(Sender).TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to TStringGrid(Sender).RowCount - 1 do
  begin
    btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
    if row >= TStringGrid(Sender).TopRow then
    begin
      btn.Top := y;
      btn.Left := rect.Left;
      btn.Visible := rect.Right > 0;
      y := y + TStringGrid(Sender).DefaultRowHeight;
    end
    else
      btn.Visible := false;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to StringGrid1.RowCount - 1 do
  begin
    btn := TSpeedButton.Create(StringGrid1);
    btn.Name := Format('SP%d', [row]);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.tag := row;
    btn.Width := StringGrid1.ColWidths[C_COL];
    btn.Height := StringGrid1.DefaultRowHeight;
    btn.Visible := false;
  end;
  StringGrid1TopLeftChanged(TStringGrid(Sender));
end;

расширенная версия, предложенная @Tlama, потребует реализации класса интерпозера или использования собственного компонента для переопределения ColWidthsChanged и RowHeightsChanged, чтобы кнопки отображались правильно не только при прокрутке, но и при изменении размера строки/столбца.

//.....

type
  TStringGrid=Class(Grids.TStringGrid)
    procedure ColWidthsChanged; override;
    procedure RowHeightsChanged; override;
  End;

  TForm3 = class(TForm)
    StringGrid1: TStringGrid;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1TopLeftChanged(Sender: TObject);
  private
    procedure SpeedButton1Click(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}


{ TStringGrid }

procedure TStringGrid.ColWidthsChanged;
begin
  inherited;
  TopLeftChanged;
end;

procedure TStringGrid.RowHeightsChanged;
begin
  inherited;
  TopLeftChanged;
end;



procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
  Showmessage(TSpeedButton(Sender).Name  + ' ' +  IntToStr(TSpeedButton(Sender).Tag));
end;

const
  C_COL = 4;

procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  for row := 0 to TStringGrid(Sender).RowCount - 1 do
  begin
    btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
    if row >= TStringGrid(Sender).TopRow then
    begin
      rect := TStringGrid(Sender).CellRect(C_COL, row);
      btn.BoundsRect := rect;
      btn.Visible := rect.Right > 0;
      y := y + TStringGrid(Sender).DefaultRowHeight;
    end
    else
      btn.Visible := false;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to StringGrid1.RowCount - 1 do
  begin
    btn := TSpeedButton.Create(StringGrid1);
    btn.Name := Format('SP%d', [row]);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.tag := row;

    btn.Visible := false;
  end;
  StringGrid1TopLeftChanged(TStringGrid(Sender));
end;
person bummi    schedule 11.12.2013
comment
Это более точно, чем принятый ответ, хотя он не учитывает размер строки, столбца. Однако для этого потребуется переопределить методы ColWidthsChanged и RowHeightsChanged в подклассе. - person TLama; 11.12.2013
comment
@TLama, вы правы, я не уверен, что этот случай тоже следует добавить в код, он может стать более крупным проектом. - person bummi; 11.12.2013
comment
Да, это не так просто, но я бы сказал, что ваше обновление легко покрывает все, что здесь нужно (кроме перемещения столбцов и строк, но я помолчу, обещаю :-) - person TLama; 11.12.2013