Solved

show image on cxDBgrid retrieve filepath from SQL db by RecordID

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

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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

744 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

12 Experts available now in Live!

Get 1:1 Help Now