Solved

show image on cxDBgrid retrieve filepath from SQL db by RecordID

Posted on 2013-06-14
4
859 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

Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…

820 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