Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

show image on cxDBgrid retrieve filepath from SQL db by RecordID

Posted on 2013-06-14
4
Medium Priority
?
937 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 28

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 38

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 38

Accepted Solution

by:
Geert Gruwez earned 2000 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 38

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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Screencast - Getting to Know the Pipeline
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Suggested Courses

885 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