Exibir imagens mais rápido selecionando o registro pelo DBGrid
18/11/2023
0
Prezados,
Tenho um formulário com um DBGrid e um TImage. Estou selecionando o caminho das imagens pelo DBGrid , mas elas estão aparecendo lentamente. Como fazer para que elas apareçam rápidamente ao selecionanr o registro no dbGrid. Segue meu código abaixo:
procedure TFrmCadastroHQ.CarregarImagemSelecionada;
begin
if not dmHQ.cdsHQ.IsEmpty then
begin
dmHQ.cdsHQ.DisableControls; // Desabilita atualizações para melhor desempenho
try
if not dmHQ.cdsHQ.FieldByName('FotoHQ').IsNull then
begin
imgHQGrid.Picture.LoadFromFile(dmHQ.cdsHQ.FieldByName('FotoHQ').AsString);
with imgHQGrid.Picture.Graphic do
//Horizontal
// Canvas.CopyRect(Canvas.ClipRect,
// Canvas, Rect(Width-1, 0, -1, Height));
//Vertical
Canvas.CopyRect(Canvas.ClipRect,
Canvas, Rect(0, Height - 1, Width, -1));
edtFotoHQ.Text := dmHQ.cdsHQ.FieldByName('FotoHQ').AsString;
imgHQGrid.Visible := True;
end
else
begin
imgHQGrid.Visible := False;
ShowMessage('Registro não contém uma imagem associada.');
end;
finally
dmHQ.cdsHQ.EnableControls; // Reabilita atualizações
end;
end
else
begin
imgHQGrid.Visible := False;
ShowMessage('Nenhum registro selecionado.');
end;
end;
procedure TFrmCadastroHQ.DBGrid1CellClick(Column: TColumn);
begin
CarregarImagemSelecionada;
end;
procedure TFrmCadastroHQ.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Chr(Key)<>#13) then exit;
if (DBGrid1.SelectedIndex+1<>DBGrid1.FieldCount) then
DBGrid1.SelectedIndex:=DBGrid1.SelectedIndex+1
else
begin
if (DBGrid1.SelectedIndex=DBGrid1.FieldCount-1) then
begin
TClientDataSet(datasource1.DataSet).Next;
if TClientDataSet(datasource1.DataSet).EOF then
TClientDataSet(datasource1.DataSet).Append;
DBGrid1.SelectedIndex:=DBGrid1.SelectedIndex-DBGrid1.FieldCount-1;
end;
end;
end;
Tenho um formulário com um DBGrid e um TImage. Estou selecionando o caminho das imagens pelo DBGrid , mas elas estão aparecendo lentamente. Como fazer para que elas apareçam rápidamente ao selecionanr o registro no dbGrid. Segue meu código abaixo:
procedure TFrmCadastroHQ.CarregarImagemSelecionada;
begin
if not dmHQ.cdsHQ.IsEmpty then
begin
dmHQ.cdsHQ.DisableControls; // Desabilita atualizações para melhor desempenho
try
if not dmHQ.cdsHQ.FieldByName('FotoHQ').IsNull then
begin
imgHQGrid.Picture.LoadFromFile(dmHQ.cdsHQ.FieldByName('FotoHQ').AsString);
with imgHQGrid.Picture.Graphic do
//Horizontal
// Canvas.CopyRect(Canvas.ClipRect,
// Canvas, Rect(Width-1, 0, -1, Height));
//Vertical
Canvas.CopyRect(Canvas.ClipRect,
Canvas, Rect(0, Height - 1, Width, -1));
edtFotoHQ.Text := dmHQ.cdsHQ.FieldByName('FotoHQ').AsString;
imgHQGrid.Visible := True;
end
else
begin
imgHQGrid.Visible := False;
ShowMessage('Registro não contém uma imagem associada.');
end;
finally
dmHQ.cdsHQ.EnableControls; // Reabilita atualizações
end;
end
else
begin
imgHQGrid.Visible := False;
ShowMessage('Nenhum registro selecionado.');
end;
end;
procedure TFrmCadastroHQ.DBGrid1CellClick(Column: TColumn);
begin
CarregarImagemSelecionada;
end;
procedure TFrmCadastroHQ.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Chr(Key)<>#13) then exit;
if (DBGrid1.SelectedIndex+1<>DBGrid1.FieldCount) then
DBGrid1.SelectedIndex:=DBGrid1.SelectedIndex+1
else
begin
if (DBGrid1.SelectedIndex=DBGrid1.FieldCount-1) then
begin
TClientDataSet(datasource1.DataSet).Next;
if TClientDataSet(datasource1.DataSet).EOF then
TClientDataSet(datasource1.DataSet).Append;
DBGrid1.SelectedIndex:=DBGrid1.SelectedIndex-DBGrid1.FieldCount-1;
end;
end;
end;
Mauricio Bomfim
Curtir tópico
+ 0
Responder
Posts
21/11/2023
Arthur Heinrich
Qual o objetivo do comando:
Na documentação:
Neste contexto, imagino que Canvas.ClipRect seja definido por (0, 0, Width, Height).
Você está copiando uma porção da imagem para ela mesma, usando como origem, o retangulo: Rect(0, Height - 1, Width, -1)
Ao definir este retângulo, você utilizou os vértices inferior esquerdo e o ponto à cima e à direita do vértice superior direito. Não sei se isto surte algum efeito prático. Na minha opinião, este comando deveria ser suprimido.
imgHQGrid.Picture.Graphic do
Canvas.CopyRect(Canvas.ClipRect,Canvas, Rect(0, Height - 1, Width, -1));
Na documentação:
procedure CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: TRect); Description Copies part of an image from another canvas into the canvas. Use CopyRect to transfer part of the image on another canvas to the image of the TCanvas object. Dest specifies the rectangle on the canvas where the source image will be copied. The Canvas parameter specifies the canvas with the source image. Source specifies a rectangle bounding the portion of the source canvas that will be copied. The portion of the source canvas is copied using the mode specified by CopyMode.
Neste contexto, imagino que Canvas.ClipRect seja definido por (0, 0, Width, Height).
Você está copiando uma porção da imagem para ela mesma, usando como origem, o retangulo: Rect(0, Height - 1, Width, -1)
Ao definir este retângulo, você utilizou os vértices inferior esquerdo e o ponto à cima e à direita do vértice superior direito. Não sei se isto surte algum efeito prático. Na minha opinião, este comando deveria ser suprimido.
Responder
Clique aqui para fazer login e interagir na Comunidade :)