Solved

show image on cxDBgrid retrieve filepath from SQL db by RecordID

Posted on 2013-06-14
4
844 Views
Last Modified: 2013-07-01
I have a product catalog with an 'Image' field that contains file paths to the images. How can I show the actual image in the grid cell?

Thanks!
0
Comment
Question by:Bianca
  • 3
4 Comments
 
LVL 26

Expert Comment

by:Sinisa Vuk
ID: 39249119
take a look:
http://easycomputertutorial.blogspot.com/2008/07/delphi-tips-displaying-image-in-dbgrid.html
http://www.greatis.com/delphicb/tips/lib/databases-gridimages.html

... use draw cell event and for current row get image path, load into tbitmap and draw on grid canvas.
This may go very slow on larger image, slow disk,... You can use TImageList to fill in all images before show them in grid (on after open query event) and draw each using (in-memory) imagelist and row index as index in list. If you fill image list then you can use tlistview component too.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 39249645
this article explains the details of using a cxgrid with a image column

http://www.devexpress.com/Support/Center/Question/Details/A2322

the trick is the SavePicture procedure from cxImage.
This converts a image to an ansistring and this can be assigned to the values of a DataController.
0
 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 39249649
i tested a sample in unbound mode:
procedure TfrmTestEE.btnAddRowAndPic(Sender: TObject);
var r: Integer;
  P: TPicture;
  F: String;
  S: AnsiString;
begin
  F := 'C:\Program Files\Common Files\CodeGear Shared\Images\Buttons\alarm.bmp';
  with viewPictures.DataController do
  begin
    BeginUpdate;
    try
      r := AppendRecord;
      S := '';
      if FileExists(F) then
      begin
        P := TPicture.Create;
        try
          P.LoadFromFile(F);
          SavePicture(P, S);
        finally
          P.Free;
        end;
      end;
      Values[r, colPicture.Index] := S;
    finally
      EndUpdate;
    end;
  end;
end;

Open in new window

0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 39249670
you might want to preload images into a buffer to make it faster
> if you have lots of rows with same images, then this unit may come in handy

unit uPicBuffer;

interface

uses Classes, Graphics;

function PicFromBuffer(aFileName: string): TPicture;
function PicFromBufferAsAnsiString(aFileName: string): AnsiString;
function PicBufferCount: Integer;
procedure RemovePicFromBuffer(aFileName: string);
procedure EmptyPicBuffer;

implementation

uses SysUtils, ContNrs, cxImage;

type
  TPicBufferItem = class(TObject)
  private
    FPic: TPicture;
    FFileName: string;
    fLastLoaded: TDateTime;
    FIsEmpty: boolean;
    function GetPicture: TPicture;
    procedure LoadPicture;
  public
    constructor Create(aFileName: string);
    destructor Destroy; override;
    procedure Refresh;
    property LastLoaded: TDateTime read fLastLoaded write fLastLoaded;
    property FileName: string read FFileName write FFileName;
    property Picture: TPicture read GetPicture;
    property IsEmpty: boolean read FIsEmpty;
  end;

  TPicBuffer = class(TObjectList)
  private
    FMaxLoad: integer;
    procedure SetMaxLoad(const Value: integer);
  protected
  public
    constructor Create(AOwnsObjects: Boolean);
    function GetPicture(aFileName: string): TPicture;
    procedure RemovePicture(aFileName: string);
    property MaxLoad: integer read FMaxLoad write SetMaxLoad default 100;
  end;

var PicBuffer: TPicBuffer = nil;

function PicFromBuffer(aFileName: string): TPicture;
begin
  if PicBuffer = nil then
    PicBuffer := TPicBuffer.Create(True);
  Result := PicBuffer.GetPicture(aFileName);
end;

function PicFromBufferAsAnsiString(aFileName: string): AnsiString;
var P: TPicture;
  S: AnsiString;
begin
  Result := '';
  P := PicFromBuffer(aFileName);
  if P <> nil then
  begin
    SavePicture(P, S);
    Result := S;
  end;
end;

function PicBufferCount: Integer;
begin
  Result := 0;
  if PicBuffer <> nil then
    Result := PicBuffer.Count;
end;

procedure RemovePicFromBuffer(aFileName: string);
begin
  if PicBuffer <> nil then
    PicBuffer.RemovePicture(aFileName);
end;

procedure EmptyPicBuffer;
begin
  if PicBuffer <> nil then
    PicBuffer.Clear;
end;

{ TPicBufferItem }

constructor TPicBufferItem.Create(aFileName: string);
begin
  inherited Create;
  FIsEmpty := True;
  FFileName := aFileName;
  FPic := nil;
  LoadPicture;
end;

procedure TPicBufferItem.LoadPicture;
begin
  FIsEmpty := True;
  if FPic <> nil then
    FreeAndNil(FPic);
  FPic := TPicture.Create;
  if FFileName <> '' then
  try
    if FileExists(fFileName) then
    begin
      FPic.LoadFromFile(FFileName);
      FIsEmpty := False;
    end;
  except
    // Catch exceptions
  end;
  fLastLoaded := Now;
end;

destructor TPicBufferItem.Destroy;
begin
  FreeAndNil(FPic);
  inherited Destroy;
end;

function TPicBufferItem.GetPicture: TPicture;
begin
  if FPic = nil then
    LoadPicture;
  Result := FPic;
  fLastLoaded := Now;
end;

procedure TPicBufferItem.Refresh;
begin
  LoadPicture;
end;

{ TPicBuffer }

constructor TPicBuffer.Create(AOwnsObjects: Boolean);
begin
  inherited Create(True);
  FMaxLoad := 100;
end;

function TPicBuffer.GetPicture(aFileName: string): TPicture;
var I, OldestIndex: Integer;
  Found: boolean;
  aItem: TPicBufferItem;
begin
  Result := nil;
  Found := False;
  for I := 0 to Count - 1 do
    if SameText(TPicBufferItem(Items[I]).FileName, aFileName) then
    begin
      Result := TPicBufferItem(Items[I]).Picture;
      Found := True;
      Break;
    end;
  if not Found then
  begin
    if Count >= FMaxLoad then
    begin
      if Count > 1 then
      begin
        OldestIndex := 0;
        for I := 1 to Count - 1 do
          if TPicBufferItem(Items[I]).LastLoaded < TPicBufferItem(Items[OldestIndex]).LastLoaded then
            OldestIndex := I;
        Delete(OldestIndex);
      end else
        Delete(0);
    end;
    aItem := TPicBufferItem.Create(aFileName);
    Add(aItem);
    Result := aItem.Picture;
  end;
end;

procedure TPicBuffer.RemovePicture(aFileName: string);
var I: Integer;
begin
  for I := Count - 1 downto 0 do
    if SameText(TPicBufferItem(Items[I]).FileName, aFileName) then
      Delete(I);
end;

procedure TPicBuffer.SetMaxLoad(const Value: integer);
var aValue: Integer;
begin
  aValue := Value;
  if aValue <= 1 then aValue := 2;
  if aValue < FMaxLoad then
    while (Count > 0) and (Count > aValue) do Delete(0);
  FMaxLoad := aValue;
end;

initialization

finalization
  if PicBuffer <> nil then
    FreeAndNil(PicBuffer);
end.

Open in new window


the earlier sample becomes simpler with above unit:
procedure TfrmTestEE.btnAddRowAndPic(Sender: TObject);
var r: Integer;
  F: String;
begin
  F := 'C:\Program Files\Common Files\CodeGear Shared\Images\Buttons\alarm.bmp';
  with viewPictures.DataController do
  begin
    BeginUpdate;
    try
      r := AppendRecord;
      Values[r, colPicture.Index] := PicFromBufferAsAnsiString(F);
    finally
      EndUpdate;
    end;
  end;
end;

Open in new window

0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
Need to grow your business through quality cloud solutions? With everything required to build a cloud platform and solution, you may feel like the distance between you and the cloud is quite long. Help is here. Spend some time learning about the Con…

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now