AboutPricingCommunityTeamsStart Free TrialLog in
Avatar of aj85
aj85
Ā asked on

GIF Images On A Timer - Easy 500 Points

Hello,

I have several .gif files that I want to load from a DB on a given interval, for example every 2 minutes I want the next image in the database to be displayed. Ā Then when last image is reached in the DB, it should start again. Ā If you can show how to select images on a random basis that would be great as well. Ā I can display the images without any issue, however they are not rotating on the correct time interval. Ā What I would like is a small example of how to implement this using a SQL 2005 DB. Ā You do not have to create the DB, I just want the timer example of connecting to the DB and selecting the image. Ā I need this kind of quickly so I am making the points very high.

Thanks in advance.

aj85
Delphi
Avatar of undefined
Last Comment
aj85
8/22/2022 - Mon
MerijnB
It would probably help if you show what you have now.
developmentguru
1) I would make it so each image record has a unique integer ID
2) I would query the database for the list of IDs that could be showed.
3) If you want to you can make it so the IDs query is rerun to update IDs
Ā  Ā  (if the list of images can change and you want the system to update while running)
4) Load up a TList with the IDs
5) Generate a random number based on the count of the TList to get a random ID
6) Query the database for the image by ID
7) Display it

If you need to be sure to show every image in the random cycle, when you randomly select from that list remove the ID from the list. Ā when the list is empty re-query the database and fill it again.
Geert G
i guess you don't have too many images in there

first load the primary key column into a TStringList
List := TStringList.Create;
qry.SQL.Text :=
Ā  'SELECT PRIM_KEY_COLUMN FROM TABLE';
qry.Open;
while not Qry.Eof do
begin
Ā  List.Add(qry.FieldByName('PRIM_KEY_COLUMN').AsString);
Ā  qry.Next;
end;
close;

then onTimer, just pick a random number form the TStringList

X := Random(List.Count);

qry.SQL.Text := 'SELECT IMAGE_COLUMN FROM TABLE WHERE ID = :X';
qry.ParamByName('X').AsInteger := StrToInt(List[I]);
and load image from column
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
Geert G
some same ideas out there obviously ... :)
aj85
ASKER
Hello Geert,

Can you expand upon your example as I need to see how to connect to the DB, increment the image, and utilize the timer. Ā The total number of images is a maximum of 50 at any time. Ā 

Thanks,
aj85
Geert G
ow, so you just the database and delphi 7
ok, i'll cook something up
āš” FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Geert G
have you got the filename in the db or the image in a blob ?
Geert G
i assume filename
i added a memory storage for the images,
the images are loaded the first time in memory
next the image is taken from memory

unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ExtCtrls, dxGDIPlusClasses;
 
const FileDir = 'C:\images\';
 
type
  TForm2 = class(TForm)
    Timer1: TTimer;
    btnLoadImages: TButton;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Image1: TImage;
    procedure btnLoadImagesClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fImages: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form2: TForm2;
 
implementation
 
uses UntGraphicStore;
 
{$R *.dfm}
 
procedure TForm2.btnLoadImagesClick(Sender: TObject);
begin
  ADOConnection1.Connected := True;
  try
    ADOQuery1.Open;
    while not AdoQuery1.Eof do
    begin
      if fImages.IndexOf(AdoQuery1.FieldByName('PICTURE').AsString) = -1 then
        fImages.Add(AdoQuery1.FieldByName('PICTURE').AsString);
      ADOQuery1.Next;
    end;
    ADOQuery1.Close;
  finally
    AdoConnection1.Connected := False;
  end;
end;
 
constructor TForm2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fImages := TStringList.Create;
end;
 
destructor TForm2.Destroy;
begin
  FreeAndNil(fImages);
  inherited Destroy;
end;
 
procedure TForm2.Timer1Timer(Sender: TObject);
var X: Integer;
begin
  if fImages.Count > 0 then
  begin
    X := Random(fImages.Count);
    Image1.Picture.Graphic := GraphicFromStore(FileDir + fImages[X]);
  end;
end;
 
end.
 
 
-- unit2 dfm -- 
 
object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 336
  ClientWidth = 472
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 88
    Top = 72
    Width = 313
    Height = 201
    Picture.Data = {
      0B546478504E47496D61676589504E470D0A1A0A0000000D4948445200000109
      000000B30802000000152C7E94000000017352474200AECE1CE9000000046741
      4D410000B18F0BFC6105000000206348524D00007A26000080840000FA000000
      80E8000075300000EA6000003A98000017709CBA513C00000009704859730000
      0EC400000EC401952B0E1B0000144449444154785EED9D6D8C55C519C72FDFEC
      17D2A4699A7EA8365123504D14132B34DADA462B6BA96B8C68C19796A51A5F42
      6DA8ADE0175269139B2AD2A414DB153FB4054134FB45444D75C50A1AD7451759
      96970A1B40CACBE2B22E6C230BA773EF2C87D99939739E33F7CCCC39F7FE4F4E
      6ECE3D7766CE33FFE7F99D6766EF99BB13CE9C3955A96D839F1D3E33FA79E79B
      6F7DEFBAEFF233ECF8D6DBEFE5C7A5D89E9D37AFADBD7DDEBC7995CAB4F6F6A9
      F3E67557CD9EB6B9B2B932AD32ADADBDC23E696F6F93FA3261C284288AF849BB
      63B516FD8CF68AF1494A3BA2D962F952B8ACD0463236F87E6CE0C0D1437DEB9E
      7F86BDF29D1DB3A029D1D6D6DE56B3B69BEFED6DFC6D75AB7DC4B8387746EC97
      E8A1F83C3B493F8E5B10ABF093FC8C7A09F5A3A4CB898D6BAD129B2A91BF0A6E
      6AA541D9A8D2C17868637964ECA5BDC6067B0DB389311DC6025C35A3020DC506
      8BFD5AF7AB1854F76E963DCE1E57DF3234F47923A36836C5C1868D6A41EB3414
      1BB5B153354FB07451DDC75EF8A9EA4B50A971F19229D0686C944C7E985B6005
      C046819D03D3822AE0908DEE3F4FBFE28177F01A2B10D4D1B87866051CB2C1C0
      C02E2A90D939A81054014B36BEBCA09D79DD6C39BF5F62E70A3035823A1A17CF
      AC406636989B39182F7E32C25E2BB31F4BBA26A89014C8EC1C5408AA40063638
      120C06F6FAD83F3F895FF919B517F5E70DDE665E8CE5D51ABD1DB124F246D038
      B7B938890D295770304448B439A4FE984E8A42A9A33199E62B12635A6D5C7BFB
      A7F44EBAA28D7F50279C02243678C61073450C83745EEC88A3BCA10D714ADC53
      CA4898595F8B9383BC112EB073B832898D787661C6439A7B88F1115B1ADF6E45
      DB934E8AB1151F1BE2555B463A996A89F6666FF87393A19BC81B394468B82648
      6C48936F295788C0A879431BDF6AA869C74586589742DC10D01460B4F6A8F77E
      F50CBD71CC37C205B9E595496C4879830FA8D45987216F24459518E26A42D0E6
      1675DEAF72959A70B4C9440B43925552E1D42BAA665B7A0CD57C29406243CD1B
      221E62DE58B264496C399F6FA4068D61B094C4863406AB870D2964CD4D216FF8
      0ACB425C87C4068B09F5AF52DABCC14AC678D4134986BB32653C4607D28C19BD
      1DB1247F1C3D09B342B81D46101420B1C13DCDF1E0AFEAB08A212182C1AA8879
      439A1E68C745E65BB87614C40D13418ACF487D275E31A99818E86ACB522DBE4C
      4F6203F30D423416AB08950D6EB588879837381886A0116FF60D79ACE60D8E87
      9AE58AE57F5893AC403636E208E090A8B942BC903ADF68482AD4A1A3B87A3BEE
      32F246E930B46183D8C90626C1DC35E9E70ED4511F5140140BAB804336EAFF5E
      BCA474494BC3F9E00A79236CA05B5CDD211B3C209AF055FDD904716A6EE12454
      09A280433682F4A70817D5FEA4087E67A408AEC964833D1BA5FB65B74CBAD453
      380903E0518FAAFEEBDAB3E1DFD6B25CD1C000F0288B13ABDF5858FFAE21256F
      DCA76C2592C6DA543300C0C35A58CF15EDD948359471110DCB7BF564A36F49F3
      0DF527711B5D8972F72F031B1D1BB73EBAE2657567E7B51A3C5EDB06FA67C63B
      3FA36E1D1D1DDA162C82A908F76CF3CF39973B5E9AC9FA0C6C302AB4CA249D67
      0C44519F48027BABDD6B25E5CD6EEC61572B5F8F8BDF8BE317CEF3D5D6676BD9
      D8181D3D75FAF4D8CE8E4747BF1839F9B9990D05863551347E1FAE4E4AA43E1B
      FED4C393092FAF2696F88C54207EABAD259EAC5F7D6E9E4A4511B8ADBF77CDD3
      42363646464ED4F661B69F3C397C7CF0C881FE9D696C2830D8B2A18E55CC6744
      2F8AF14AAF65170722BD5A48EC9A452DCF0A6463E3C489E3E2AD9A1DEFD9D5C3
      D8E07FB3125FD95B3EA692B38404067B4BCE1B166C488945BAA3C7812B45739D
      3E50F3034656754A1AA47A363686868E0D0E1E1D183878F4C8A7870FEDDBB777
      C7AEDEAEC2E68D2496B473E57858E5C20D60C385AAAEDBCCC6C6FEFE1DBBFBB6
      F46D7D6F7BCFE6DE8F36F574756E79F775176C8843915882AC79232B1BDA8BE6
      E500E0919792DEDAC9C6464FD79B9BDE7869E386E7DFDAB09AED9DAFAC7AFBB5
      B58ED8204EB555720C9375F398CAE95C196C788BE9BC2E94810D8BEF37D4EFFE
      3467A235CDF085A0D3315B5ED18076C6FDFDC6FA9991541DD9377A6C3AAE3E36
      A29E49FAEE2FF512280005DC2950CD1BD29F9EF0160A4081AA029C8D28EAC70E
      05A040AC00D8C01D010AE815001B880C2890131B49A32FBB51995D2D7779DF6C
      4F706BEB3120B56E6A01B3EC61AB4BB6D5690C6F4D9F37C47918F1AA76CC88B5
      CC1725963CD7ABB3CDF14E1271E225297D31589B742DA2198662D247920D7582
      4D348FDEBBDCCD8B1B4CF5A6755FE43093E6E2761253E249ED92648A380D120B
      7351B49FAAD7A59CA13B5832836843AAF30C05886C64ED666AB8A416C894379C
      9A976A6A6A018A83AA3127B241097199ADB3384BF76CCA5BF1269D1AFD7101F5
      F69914C1AA0DDAAB24DDE1D41B95D6067E527C1DCBC802D222DEDA66E302D2A7
      EADBB8536A4A171B913096FA98E41D6DE2D51696FA2829A365A31EF3CC4E4F1A
      2F68D5134D55FD22EA66CF4652348BCE4B85CD106D521010D9D0C6A5E17EAFF6
      428A722DC0DA5AE6BE24356BF0BA36C2C6396F3C7E16DDD4DE562C3CABED9D14
      79F59897CA46921FA568A4F8E81C6994BC415750BA3FA95D32DC08A58FACD950
      6F99165ED1C6877ACBC9CAB6A88F1A4F228731E4E6ACA8A62CB591A433490197
      D477D1415ACF4AA92CE92E99358E25FBD5B7F42E1B2241237E8E6C50FA9C1AF1
      5223998249F28D210318422A6BDE907AA4F593F6726AC524AF6B09ACF31670EE
      EE78762E67E0DCEC5943EFACD195CCCB2B6FD8B3A1F58DD9D9E67B43527656DD
      60BE4F53EE40EA4DABE06CA4E60DD59152885064318B203AB77E360C77747324
      247D4A44CB47DE1061E5376CF3BD4DBCA91BEA8AED887939C9B549F7A1D8CD6A
      236218692F61B041EA855A52A44E1BD06A4C2475939714B555CFC49F6ABB6910
      41729958DDE0296DEF0C466AF591825BBD5CDC4D6D9CA49AA76D504522B5CB52
      6755478C0B248BE7A94421D4BB75D633F9B696F5EA59CB5B5B6B5D51B230AF76
      B41D4F223FAB4A45286F21944C38D8C8E4480BC5B5238D4C17556FEDD6D5CD15
      9B990DC9B3D59462C18623C7A05928501C05C0069EB48302393D6B581CAC6109
      1470AAC0B9BC21FE1D00C750000A8CB1C1978C1F1B3870F4501FFBFDB5BDFFF9
      E0BD4D1B56FF63C5FDF7DEF5F4D34F3F156EBBF6CA6F7DEDBCCA15E75F10CE04
      5CB97915D0FCCEC8FEFE0F7BB6746E58BF66E16F1E5AB76EDD0B09DB825FDE97
      F491E1BC5D2D8B0BA10A14A853010D1B07F77FBC677717C3E34F4B7FBB6DDBB6
      8FB14181A65440C3C6E183BD0C8F7D7B3FFCFB73CB8E276FE64F93EAD16B3DF1
      C413371837836DF8080AD4AF80868D23FFDDCE7646C80BAB578C86DB962E5D3A
      3A7A50BBCF9E3D9B9D9F31634638EB70E5C65720C3EF1A4A3F9245F97F7FEAEF
      6A516ABD7FF794E8FDD6AEAEAE91A7CE8FA2C31FFC75067B15F73973E6F0B72D
      2D2DEE7EBA0B2D37B902F66C3815AEFBE6298C0D4648F7FCABA3AE5B3809279F
      ACA2C276C606DFEA64A3F698003628A057C09E0D4A06B0CB1BBC1663E39DB649
      5157EB2B174EE60984A1524D296339646D14AD55D918FFC0E6B97F9EA4ED3DD8
      00160605ECD97027EBCEA72E678DB3D70D174DDEFBCC946D0F4D62070C89F7EF
      3E0BC9593C2436D45837473FD870E7C40668D99E0D777963E79397B3FCC07860
      072C576C5F3CE9DF332E93A61CB5B772DED0B271F619FD7139849794920C77A7
      B006609C7F898593AA3740AC345B17ECD970AA149B5ABC7CD394E87FEB86FEF5
      3376B0E78FDF1F1B568D9B949BC65471A0C7768AE4C46C489F1A32895A5D5440
      6DD0A93E68DC8302F66CD49337D4FF0FA8B6B6EBB96BDE997B4974AC6FFFB3D7
      6F5A32939237CCC14A6423090F2D1BEAF406E3340F51EBE712F66C38B5EFE6EB
      6F60498381111DDB1E7DC65EFBAA67C6FF25573B1737E4010A1BE2B04AEA609D
      D59DCA85C65D2860CF865DDE48ED0363A0E5AA29D3BFF195F9B7DDB4646ECBC2
      7BEFF9D59DB72CFCF91D3FBCFCC2EBA64E1E4F88664C950B1B7CD6218DCAE86C
      88D553FB8B028555C09E0D775D7AE0F6D6966993AEBDF4D22BBF7ADE9C9BA6B6
      4CBA60F297267CE7D24B7E7ADB8FC7A70ECD5C5C9D0AC77371719E9D3417D756
      179389D89AA14177E2A0656F0AD8B3E1286FF09E3FF2EB857F58F4F0ED375EB3
      EAF5DE07EEB8F991BB7EF497277F97694C95BB829848E42E69C11BB467C375C7
      66B5FC60D56BBDD32FFAE6CABFADB8FF9E596C76A1EE757E2F9EA90B6023935C
      0D50D89E0DA779832B7BEB0DD36FBDFAB2877FD2CAA7DDEAB66CD9B206F001BA
      504C05ECD9F0D09F5FDC3973F2C4CA1D577DDBC3B5700928202960CF8687BC01
      6F4181800AD8B311D0685C1A0A7850C09E0DE40D0FEEC125022A60CF4640A371
      6928E041017B362879E33E65F3D0255C020AE4A2803D1BA997675C44C3F25E3D
      890D0A9441810C6C746CDCFAE88A97D59D9DD7F6F4F1DA36D03F33DEF91975EB
      E8E890FF7C263CE05AA78CF8CEAE4E019BB67A063618155A9992CE3306A2A84F
      2481BDD5EEB592E336F36289A6F5163AEE53816C6C8C8E9E3A7D7A6C67C7A3A3
      5F8C9CFCDCCC8602C39A281ABF0F5727254436921E25342FEE638D4B6B8F0CED
      F8541FD72AB202D9D818193951DB87D97EF2E4F0F1C12307FA77A6B1A1C060CB
      06E529F1A432D2D3B8B14BB05EAFC8D119D6B66C6C9C38715C5CE9C68EF7ECEA
      616CA8EBF858AFF8984ACE121218EC6D42DE30A70835A6CD672466B05E2F6CD8
      95E2EAD9D8181A3A3638787460E0E0D1239F1E3EB46FDFDE1DBB7ABB9CE60DF3
      C4839E49281318696D4629FC0723DD29908D8DFDFD3B76F76DE9DBFADEF69ECD
      BD1F6DEAE9EADCF2EEEB4ED988A70AE2813A7F483D93C486F4572CFC51CB5DA8
      95AEE56C6CF474BDB9E98D97366E78FEAD0DABD9DEF9CAAAB75F5BEB9A0D090F
      F3CA3B5E581C8F696714D2804D1DBF95CE913038770532B061F1FD86FADD9FE6
      4CB426972F0471CBCF3D389ABCC10C6C64558A7DA3C7A6E3EA6323EA19F5BBBF
      ACD792465C16D551050A480A3864035A4381522B00364AED3E18EF5001B0E150
      5C345D6A05C046A9DD07E31D2AE09B0DCAAA0FD6DDDF1BB7952B573A94044D43
      819A02BED9A0C8DEB9BB73D6AC590C804A6B85ED9F2A1BFB8815A034853250C0
      5A01DF6CA4E68DEEEEEECA820ADBAF585E993A75EAA2458BD41F68E379037858
      7B1D15290AF86623D5A6F5EBD77330AE79B5F260F4606579A5B2B8D2B2A02292
      C0F306DF521BAC2647E3FFF5C39786140D9BB08C6F3652F3C6DCB973BFDE5A99
      3871227BBD7841656A6B65F9F2CAABAF560F62F7B0DCC237031B94870B798360
      A309E39ED265DF6CA4DA34773963E0E228BA91F1C0F6DAF1C5F3E7CF8F4E0DAA
      75C146AA9E2860AD806F3652F3C6BE8FA3D6D6CAEEDD63543030D6AE65BF12AD
      DF2436C4C70AD5C70DA526A447127902891F64543FB59618154BAA806F362832
      0D0D0DB1190543826D6CFA61A8A2B2110F90EA59F8210DB430E8A278ADF1CAF8
      6623E93FFD49F9847DBDA17D163DBEBB734F68F3863A8B50835B25C7B090036C
      345EDC537AE49B0D8A4DACCCE2C58BA501525C513C0F36887AA2988502BED948
      9D6FF03EF0BC118F6D926EF359D9308CB890372CA2A7B1ABF86683A8A6998D38
      8E0D6C88A3AF2424A4E57E988B13BDD324C57CB39157DED0CE3772F419E61839
      8A59D2A67CB34194C93C178F1B217E2F4EBCA8580C6C5888D660557CB341CF1B
      F197DF8603776C34989BD11D0B057CB3413451FCEA8D1FC70F504907C406510C
      0A6455C0371BC4BC91B51B280F057257C0371BB977000D4201470AF866839837
      B0EECF91BFD12C5D01DF6C502CC3BA3F8A4A28E35A01DF6CA4E60DACFB73ED72
      B44F54C0371BA966B958F7175FD4FCAD05BED348F54E5315F0CD466ADEC86BDD
      9FD68B60A3A982BBCECEFA6623D5DCBCD6FD818D54A951C0AC806F3652F346FD
      EBFE7887C5E70BC5D57CAA1CEA123F3C74086CAA2174E6CC29BE1F1B3870F450
      1F8B5DF6CAF7D43876A4603DEBFEA4A985E1C97309A118273CACEEC8ADA56BD6
      371B4ED7FDA9F10D364A1791C531D8371BC49EDBADFB031B4479518CA2806F36
      88E334BB757F49C32469A025CD46E8C330FC919712520D53C6371B44E1ECD6FD
      A96C700CD4B9B8B4C8160B00897E69AA62BED9C82B6F70277958BF815CD1543C
      889DF5CD0651E8E0EBFED46118D172146B18057CB341CF1B58F7D7304156D28E
      F866832813D6FD11854231770AF866839837DC75182D4301A202BED9209A8562
      5020B802BED920E60DACFB0B1E1930C0371B14C5B1EE8FA212CAB856C0371BA9
      7903EBFE5CBB1CED1315F0CD46AA599ED7FD15E4ABBD829891EA9DA62AE09B8D
      D4BCE179DD1F312889C5AC43C775FBD686357345DF6CA46AED79DD5F4182B220
      66A47AA7A90AF86623356FF859F7675EEBC72320E921C5D45581EA938BBC3535
      B0B0E4B0C8B0F96683A285EB757FD243B852E0F24FB58BA2B2568C9B4A022356
      C370D118548A742893A302BED928C2BA3F6D884BB7F0F8B1763134896CA84D69
      1D666E4D4B6C8E8E4753A90AF86623D5205EC0E9BABFD4A0146FE7E21D9DC886
      D4C7A4B944AA196A01A27A28968B020565C3E9BA3F4A886B473B948AF488A797
      4C9AAEE412016824498152B2114795766D933A55880748F147E649308F457158
      9554517B6B4FAAABCE1CCC66A89F228E7D2A504A3662813CACFB4BBCA9E8FEEE
      94AFE7920663F95E05AD95326F48776571E8CFFBE39F0D2927380D2CB0E154DE
      D4C68B9B37B0EE2FD57928E0548182B2210EB5F931FEDF9FD33840E3AA020565
      03AE8202C115001BC15D00030AAA00D828A86360567005C0467017C080822A00
      360AEA1898155C01B011DC0530A0A00A808D823A06660557006C0477010C28A8
      0260A3A08E8159C115001BC15D00030AAA00D828A86360567005C0467017C080
      822A00360AEA1898155C01B011DC0530A0A00A808D823A06660557006C047701
      0C28A80260A3A08E8159C115001BC15D00030AAA00D828A86360567005C04670
      17C080822A00360AEA1898155C01B011DC0530A0A00A808D823A06660557006C
      0477010C28A80260A3A08E8159C115001BC15D00030AAA00D828A86360567005
      C0467017C080822A00360AEA1898155C81FF0351E6E6669FC31DDF0000000049
      454E44AE426082}
  end
  object btnLoadImages: TButton
    Left = 64
    Top = 24
    Width = 75
    Height = 25
    Caption = 'Load images'
    TabOrder = 0
    OnClick = btnLoadImagesClick
  end
  object Timer1: TTimer
    Interval = 2000
    OnTimer = Timer1Timer
    Left = 16
    Top = 16
  end
  object ADOConnection1: TADOConnection
    Connected = True
    ConnectionString = 
      'Provider=OraOLEDB.Oracle.1;Password=STOREPWD;Persist Security Info' +
      '=True;User ID=STORE;Data Source=TESTDB'
    LoginPrompt = False
    Provider = 'OraOLEDB.Oracle.1'
    Left = 16
    Top = 64
  end
  object ADOQuery1: TADOQuery
    Connection = ADOConnection1
    Parameters = <>
    SQL.Strings = (
      'SELECT ID, PICTURE FROM STORE.IMAGE_FILES')
    Left = 16
    Top = 104
  end
end
 
--
unit UntGraphicStore;
 
interface
 
uses Classes, Graphics;
 
function GraphicFromStore(aFileName: string): TGraphic;
function GraphicStoreCount: Integer;
procedure RemoveFromStore(aFileName: string);
procedure EmptyGraphicStore;
 
implementation
 
uses GraphicEx, Jpeg, SysUtils, ContNrs;
 
type
  TGraphicStoreItem = class(TObject)
  private
    FGraphic: TGraphic;
    FFileName: string;
    fLastLoaded: TDateTime;
    FIsEmpty: boolean;
    function GetGraphic: TGraphic;
    procedure LoadGraphic;
  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 Graphic: TGraphic read GetGraphic;
    property IsEmpty: boolean read FIsEmpty;
  end;
 
  TGraphicStore = class(TObjectList)
  private
    FMaxLoad: integer;
    procedure SetMaxLoad(const Value: integer);
  protected
  public
    constructor Create(AOwnsObjects: Boolean);
    function GetGraphic(aFileName: string): TGraphic;
    procedure RemoveGraphic(aFileName: string);
    property MaxLoad: integer read FMaxLoad write SetMaxLoad default 100;
  end;
 
var GraphicStore: TGraphicStore = nil;
 
function GraphicFromStore(aFileName: string): TGraphic;
begin
  if GraphicStore = nil then
    GraphicStore := TGraphicStore.Create(True);
  Result := GraphicStore.GetGraphic(aFileName);
end;
 
function GraphicStoreCount: Integer;
begin
  Result := 0;
  if GraphicStore <> nil then
    Result := GraphicStore.Count;
end;
 
procedure RemoveFromStore(aFileName: string);
begin
  if GraphicStore <> nil then
    GraphicStore.RemoveGraphic(aFileName);
end;
 
procedure EmptyGraphicStore;
begin
  if GraphicStore <> nil then
    GraphicStore.Clear;
end;
 
{ TGraphicStoreItem }
 
constructor TGraphicStoreItem.Create(aFileName: string);
begin
  inherited Create;
  FIsEmpty := True;
  FFileName := aFileName;
  FGraphic := nil;
  LoadGraphic;
end;
 
procedure TGraphicStoreItem.LoadGraphic;
var aClass: TGraphicExGraphicClass;
begin
  FIsEmpty := True;
  if FGraphic <> nil then
    FreeAndNil(FGraphic);
  if FFileName <> '' then
  try
    if FileExists(fFileName) then
    begin
      if SameText(ExtractFileExt(FFileName), '.bmp') then
      begin
        FGraphic := TBitmap.Create;
        FGraphic.LoadFromFile(FFileName);
        FIsEmpty := False;
      end else if SameText(ExtractFileExt(FFileName), '.jpg') or SameText(ExtractFileExt(FFileName), '.jpeg') then
      begin
        FGraphic := TJPEGImage.Create;
        FGraphic.LoadFromFile(FFileName);
        FIsEmpty := False;
      end
        else
      begin
        aClass := FileFormatList.GraphicFromContent(fFileName);
        if aClass <> nil then
        begin
          FGraphic := aClass.Create;
          if TGraphicExGraphic(FGraphic).CanLoad(FFileName) then
            FGraphic.LoadFromFile(FFileName);
        end;
      end;
    end;
  except
    // Catch exceptions
  end;
  fLastLoaded := Now;
end;
 
destructor TGraphicStoreItem.Destroy;
begin
  FreeAndNil(FGraphic);
  inherited Destroy;
end;
 
function TGraphicStoreItem.GetGraphic: TGraphic;
begin
  if FGraphic = nil then
    LoadGraphic;
  Result := FGraphic;
  LastLoaded := Now;
end;
 
procedure TGraphicStoreItem.Refresh;
begin
  LoadGraphic;
end;
 
{ TGraphicStore }
 
constructor TGraphicStore.Create(AOwnsObjects: Boolean);
begin
  inherited Create(True);
  FMaxLoad := 100;
end;
 
function TGraphicStore.GetGraphic(aFileName: string): TGraphic;
var I, OldestIndex: Integer;
  Found: boolean;
  aItem: TGraphicStoreItem;
begin
  Result := nil;
  Found := False;
  for I := 0 to Count - 1 do
    if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
    begin
      Result := TGraphicStoreItem(Items[I]).Graphic;
      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 TGraphicStoreItem(Items[I]).LastLoaded < TGraphicStoreItem(Items[OldestIndex]).LastLoaded then
            OldestIndex := I;
        Delete(OldestIndex);
      end else
        Delete(0);
    end;
    aItem := TGraphicStoreItem.Create(aFileName);
    Add(aItem);
    Result := aItem.Graphic;
  end;
end;
 
procedure TGraphicStore.RemoveGraphic(aFileName: string);
var I: Integer;
begin
  for I := Count - 1 downto 0 do
    if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
      Delete(I);
end;
 
procedure TGraphicStore.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 GraphicStore <> nil then
    FreeAndNil(GraphicStore);
end.

Open in new window

aj85
ASKER
Hello Geert,

I am sorry I did not get a chance to reply to your question before your post. Ā However I have it stored as a blob. Ā If not can you give the example with that? Also, would it be better to use the filename instead of a blob? Ā Would that help with performance? Ā Again sorry for the late reply.

Thanks in advance.

aj85
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Geert G
you put easy in your question header,
so i took the easy way ... :)

you to consider pro and con for db image against db filename:
db image: pro: no need for a fileshare, con: larger db
db filename: pro: smaller db (which is no longer an issue) , con: file share necessary for multiple users

the next thing you would have to consider:
how loading the images
1: all at startup, all load from mem
2: 1 by one as they are used, second pass from mem
3: same as 2, but with a run ahead timer for loading the next image
4: use thread to load images

the higher the number the more difficult it gets, but the smoother the gui works
let's start at 2 ...


Geert G
oops:

up to you to consider pro and con for db image against db filename:
db image: pro: no need for a fileshare, con: larger db (which is no longer an issue with cheap drive space)
db filename: pro: smaller db , con: file share necessary for multiple users
Geert G
also you need to consider connection with database,
after loading the images you could kill the connection to the database
āš” FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
developmentguru
Unless the image contents (or number of images) can change... and you need to show the most recent.
Geert G
i had to modify some things ...

you will need the GraphicEx library from Mike Lischke too
i added the path of the GraphicEx dir to the search path of the project for this to work.
unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ExtCtrls, dxGDIPlusClasses;
 
const FileDir = 'C:\images\';
 
type
  TForm2 = class(TForm)
    Timer1: TTimer;
    btnLoadImages: TButton;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Image1: TImage;
    procedure btnLoadImagesClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fImages: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form2: TForm2;
 
implementation
 
uses UntGraphicStore;
 
{$R *.dfm}
 
procedure TForm2.btnLoadImagesClick(Sender: TObject);
begin
  ADOConnection1.Connected := True;
  try
    ADOQuery1.Open;
    while not AdoQuery1.Eof do
    begin
      if fImages.IndexOf(AdoQuery1.FieldByName('ID').AsString) = -1 then
      begin
        if GraphicFromStore(AdoQuery1.FieldByName('ID').AsString, AdoQuery1) <> nil then
          fImages.Add(AdoQuery1.FieldByName('ID').AsString);
      end;
      ADOQuery1.Next;
    end;
    ADOQuery1.Close;
  finally
    AdoConnection1.Connected := False;
  end;
end;
 
constructor TForm2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fImages := TStringList.Create;
end;
 
destructor TForm2.Destroy;
begin
  FreeAndNil(fImages);
  inherited Destroy;
end;
 
procedure TForm2.Timer1Timer(Sender: TObject);
var X: Integer;
begin
  if fImages.Count > 0 then
  begin
    X := Random(fImages.Count);
    //Image1.Picture.Graphic := GraphicFromStore(FileDir + fImages[X]);
    Image1.Picture.Graphic := GraphicFromStore(fImages[X]);
  end;
end;
 
end.
 
-- dfm --
object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 305
  ClientWidth = 443
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 88
    Top = 72
    Width = 313
    Height = 201
    Picture.Data = {
      0B546478504E47496D61676589504E470D0A1A0A0000000D4948445200000109
      000000B30802000000152C7E94000000017352474200AECE1CE9000000046741
      4D410000B18F0BFC6105000000206348524D00007A26000080840000FA000000
      80E8000075300000EA6000003A98000017709CBA513C00000009704859730000
      0EC400000EC401952B0E1B0000144449444154785EED9D6D8C55C519C72FDFEC
      17D2A4699A7EA8365123504D14132B34DADA462B6BA96B8C68C19796A51A5F42
      6DA8ADE0175269139B2AD2A414DB153FB4054134FB45444D75C50A1AD7451759
      96970A1B40CACBE2B22E6C230BA773EF2C87D99939739E33F7CCCC39F7FE4F4E
      6ECE3D7766CE33FFE7F99D6766EF99BB13CE9C3955A96D839F1D3E33FA79E79B
      6F7DEFBAEFF233ECF8D6DBEFE5C7A5D89E9D37AFADBD7DDEBC7995CAB4F6F6A9
      F3E67557CD9EB6B9B2B932AD32ADADBDC23E696F6F93FA3261C284288AF849BB
      63B516FD8CF68AF1494A3BA2D962F952B8ACD0463236F87E6CE0C0D1437DEB9E
      7F86BDF29D1DB3A029D1D6D6DE56B3B69BEFED6DFC6D75AB7DC4B8387746EC97
      E8A1F83C3B493F8E5B10ABF093FC8C7A09F5A3A4CB898D6BAD129B2A91BF0A6E
      6AA541D9A8D2C17868637964ECA5BDC6067B0DB389311DC6025C35A3020DC506
      8BFD5AF7AB1854F76E963DCE1E57DF3234F47923A36836C5C1868D6A41EB3414
      1BB5B153354FB07451DDC75EF8A9EA4B50A971F19229D0686C944C7E985B6005
      C046819D03D3822AE0908DEE3F4FBFE28177F01A2B10D4D1B87866051CB2C1C0
      C02E2A90D939A81054014B36BEBCA09D79DD6C39BF5F62E70A3035823A1A17CF
      AC406636989B39182F7E32C25E2BB31F4BBA26A89014C8EC1C5408AA40063638
      120C06F6FAD83F3F895FF919B517F5E70DDE665E8CE5D51ABD1DB124F246D038
      B7B938890D295770304448B439A4FE984E8A42A9A33199E62B12635A6D5C7BFB
      A7F44EBAA28D7F50279C02243678C61073450C83745EEC88A3BCA10D714ADC53
      CA4898595F8B9383BC112EB073B832898D787661C6439A7B88F1115B1ADF6E45
      DB934E8AB1151F1BE2555B463A996A89F6666FF87393A19BC81B394468B82648
      6C48936F295788C0A879431BDF6AA869C74586589742DC10D01460B4F6A8F77E
      F50CBD71CC37C205B9E595496C4879830FA8D45987216F24459518E26A42D0E6
      1675DEAF72959A70B4C9440B43925552E1D42BAA665B7A0CD57C29406243CD1B
      221E62DE58B264496C399F6FA4068D61B094C4863406AB870D2964CD4D216FF8
      0ACB425C87C4068B09F5AF52DABCC14AC678D4134986BB32653C4607D28C19BD
      1DB1247F1C3D09B342B81D46101420B1C13DCDF1E0AFEAB08A212182C1AA8879
      439A1E68C745E65BB87614C40D13418ACF487D275E31A99818E86ACB522DBE4C
      4F6203F30D423416AB08950D6EB588879837381886A0116FF60D79ACE60D8E87
      9AE58AE57F5893AC403636E208E090A8B942BC903ADF68482AD4A1A3B87A3BEE
      32F246E930B46183D8C90626C1DC35E9E70ED4511F5140140BAB804336EAFF5E
      BCA474494BC3F9E00A79236CA05B5CDD211B3C209AF055FDD904716A6EE12454
      09A280433682F4A70817D5FEA4087E67A408AEC964833D1BA5FB65B74CBAD453
      380903E0518FAAFEEBDAB3E1DFD6B25CD1C000F0288B13ABDF5858FFAE21256F
      DCA76C2592C6DA543300C0C35A58CF15EDD948359471110DCB7BF564A36F49F3
      0DF527711B5D8972F72F031B1D1BB73EBAE2657567E7B51A3C5EDB06FA67C63B
      3FA36E1D1D1DDA162C82A908F76CF3CF39973B5E9AC9FA0C6C302AB4CA249D67
      0C44519F48027BABDD6B25E5CD6EEC61572B5F8F8BDF8BE317CEF3D5D6676BD9
      D8181D3D75FAF4D8CE8E4747BF1839F9B9990D05863551347E1FAE4E4AA43E1B
      FED4C393092FAF2696F88C54207EABAD259EAC5F7D6E9E4A4511B8ADBF77CDD3
      42363646464ED4F661B69F3C397C7CF0C881FE9D696C2830D8B2A18E55CC6744
      2F8AF14AAF65170722BD5A48EC9A452DCF0A6463E3C489E3E2AD9A1DEFD9D5C3
      D8E07FB3125FD95B3EA692B38404067B4BCE1B166C488945BAA3C7812B45739D
      3E50F3034656754A1AA47A363686868E0D0E1E1D183878F4C8A7870FEDDBB777
      C7AEDEAEC2E68D2496B473E57858E5C20D60C385AAAEDBCCC6C6FEFE1DBBFBB6
      F46D7D6F7BCFE6DE8F36F574756E79F775176C8843915882AC79232B1BDA8BE6
      E500E0919792DEDAC9C6464FD79B9BDE7869E386E7DFDAB09AED9DAFAC7AFBB5
      B58ED8204EB555720C9375F398CAE95C196C788BE9BC2E94810D8BEF37D4EFFE
      3467A235CDF085A0D3315B5ED18076C6FDFDC6FA9991541DD9377A6C3AAE3E36
      A29E49FAEE2FF512280005DC2950CD1BD29F9EF0160A4081AA029C8D28EAC70E
      05A040AC00D8C01D010AE815001B880C2890131B49A32FBB51995D2D7779DF6C
      4F706BEB3120B56E6A01B3EC61AB4BB6D5690C6F4D9F37C47918F1AA76CC88B5
      CC1725963CD7ABB3CDF14E1271E225297D31589B742DA2198662D247920D7582
      4D348FDEBBDCCD8B1B4CF5A6755FE43093E6E2761253E249ED92648A380D120B
      7351B49FAAD7A59CA13B5832836843AAF30C05886C64ED666AB8A416C894379C
      9A976A6A6A018A83AA3127B241097199ADB3384BF76CCA5BF1269D1AFD7101F5
      F69914C1AA0DDAAB24DDE1D41B95D6067E527C1DCBC802D222DEDA66E302D2A7
      EADBB8536A4A171B913096FA98E41D6DE2D51696FA2829A365A31EF3CC4E4F1A
      2F68D5134D55FD22EA66CF4652348BCE4B85CD106D521010D9D0C6A5E17EAFF6
      428A722DC0DA5AE6BE24356BF0BA36C2C6396F3C7E16DDD4DE562C3CABED9D14
      79F59897CA46921FA568A4F8E81C6994BC415750BA3FA95D32DC08A58FACD950
      6F99165ED1C6877ACBC9CAB6A88F1A4F228731E4E6ACA8A62CB591A433490197
      D477D1415ACF4AA92CE92E99358E25FBD5B7F42E1B2241237E8E6C50FA9C1AF1
      5223998249F28D210318422A6BDE907AA4F593F6726AC524AF6B09ACF31670EE
      EE78762E67E0DCEC5943EFACD195CCCB2B6FD8B3A1F58DD9D9E67B43527656DD
      60BE4F53EE40EA4DABE06CA4E60DD59152885064318B203AB77E360C77747324
      247D4A44CB47DE1061E5376CF3BD4DBCA91BEA8AED887939C9B549F7A1D8CD6A
      236218692F61B041EA855A52A44E1BD06A4C2475939714B555CFC49F6ABB6910
      41729958DDE0296DEF0C466AF591825BBD5CDC4D6D9CA49AA76D504522B5CB52
      6755478C0B248BE7A94421D4BB75D633F9B696F5EA59CB5B5B6B5D51B230AF76
      B41D4F223FAB4A45286F21944C38D8C8E4480BC5B5238D4C17556FEDD6D5CD15
      9B990DC9B3D59462C18623C7A05928501C05C0069EB48302393D6B581CAC6109
      1470AAC0B9BC21FE1D00C750000A8CB1C1978C1F1B3870F4501FFBFDB5BDFFF9
      E0BD4D1B56FF63C5FDF7DEF5F4D34F3F156EBBF6CA6F7DEDBCCA15E75F10CE04
      5CB97915D0FCCEC8FEFE0F7BB6746E58BF66E16F1E5AB76EDD0B09DB825FDE97
      F491E1BC5D2D8B0BA10A14A853010D1B07F77FBC677717C3E34F4B7FBB6DDBB6
      8FB14181A65440C3C6E183BD0C8F7D7B3FFCFB73CB8E276FE64F93EAD16B3DF1
      C413371837836DF8080AD4AF80868D23FFDDCE7646C80BAB578C86DB962E5D3A
      3A7A50BBCF9E3D9B9D9F31634638EB70E5C65720C3EF1A4A3F9245F97F7FEAEF
      6A516ABD7FF794E8FDD6AEAEAE91A7CE8FA2C31FFC75067B15F73973E6F0B72D
      2D2DEE7EBA0B2D37B902F66C3815AEFBE6298C0D4648F7FCABA3AE5B3809279F
      ACA2C276C606DFEA64A3F698003628A057C09E0D4A06B0CB1BBC1663E39DB649
      5157EB2B174EE60984A1524D296339646D14AD55D918FFC0E6B97F9EA4ED3DD8
      00160605ECD97027EBCEA72E678DB3D70D174DDEFBCC946D0F4D62070C89F7EF
      3E0BC9593C2436D45837473FD870E7C40668D99E0D777963E79397B3FCC07860
      072C576C5F3CE9DF332E93A61CB5B772DED0B271F619FD7139849794920C77A7
      B006609C7F898593AA3740AC345B17ECD970AA149B5ABC7CD394E87FEB86FEF5
      3376B0E78FDF1F1B568D9B949BC65471A0C7768AE4C46C489F1A32895A5D5440
      6DD0A93E68DC8302F66CD49337D4FF0FA8B6B6EBB96BDE997B4974AC6FFFB3D7
      6F5A32939237CCC14A6423090F2D1BEAF406E3340F51EBE712F66C38B5EFE6EB
      6F60498381111DDB1E7DC65EFBAA67C6FF25573B1737E4010A1BE2B04AEA609D
      D59DCA85C65D2860CF865DDE48ED0363A0E5AA29D3BFF195F9B7DDB4646ECBC2
      7BEFF9D59DB72CFCF91D3FBCFCC2EBA64E1E4F88664C950B1B7CD6218DCAE86C
      88D553FB8B028555C09E0D775D7AE0F6D6966993AEBDF4D22BBF7ADE9C9BA6B6
      4CBA60F297267CE7D24B7E7ADB8FC7A70ECD5C5C9D0AC77371719E9D3417D756
      179389D89AA14177E2A0656F0AD8B3E1286FF09E3FF2EB857F58F4F0ED375EB3
      EAF5DE07EEB8F991BB7EF497277F97694C95BB829848E42E69C11BB467C375C7
      66B5FC60D56BBDD32FFAE6CABFADB8FF9E596C76A1EE757E2F9EA90B6023935C
      0D50D89E0DA779832B7BEB0DD36FBDFAB2877FD2CAA7DDEAB66CD9B206F001BA
      504C05ECD9F0D09F5FDC3973F2C4CA1D577DDBC3B5700928202960CF8687BC01
      6F4181800AD8B311D0685C1A0A7850C09E0DE40D0FEEC125022A60CF4640A371
      6928E041017B362879E33E65F3D0255C020AE4A2803D1BA997675C44C3F25E3D
      890D0A9441810C6C746CDCFAE88A97D59D9DD7F6F4F1DA36D03F33DEF91975EB
      E8E890FF7C263CE05AA78CF8CEAE4E019BB67A063618155A9992CE3306A2A84F
      2481BDD5EEB592E336F36289A6F5163AEE53816C6C8C8E9E3A7D7A6C67C7A3A3
      5F8C9CFCDCCC8602C39A281ABF0F5727254436921E25342FEE638D4B6B8F0CED
      F8541FD72AB202D9D818193951DB87D97EF2E4F0F1C12307FA77A6B1A1C060CB
      06E529F1A432D2D3B8B14BB05EAFC8D119D6B66C6C9C38715C5CE9C68EF7ECEA
      616CA8EBF858AFF8984ACE121218EC6D42DE30A70835A6CD672466B05E2F6CD8
      95E2EAD9D8181A3A3638787460E0E0D1239F1E3EB46FDFDE1DBB7ABB9CE60DF3
      C4839E49281318696D4629FC0723DD29908D8DFDFD3B76F76DE9DBFADEF69ECD
      BD1F6DEAE9EADCF2EEEB4ED988A70AE2813A7F483D93C486F4572CFC51CB5DA8
      95AEE56C6CF474BDB9E98D97366E78FEAD0DABD9DEF9CAAAB75F5BEB9A0D090F
      F3CA3B5E581C8F696714D2804D1DBF95CE913038770532B061F1FD86FADD9FE6
      4CB426972F0471CBCF3D389ABCC10C6C64558A7DA3C7A6E3EA6323EA19F5BBBF
      ACD792465C16D551050A480A3864035A4381522B00364AED3E18EF5001B0E150
      5C345D6A05C046A9DD07E31D2AE09B0DCAAA0FD6DDDF1BB7952B573A94044D43
      819A02BED9A0C8DEB9BB73D6AC590C804A6B85ED9F2A1BFB8815A034853250C0
      5A01DF6CA4E68DEEEEEECA820ADBAF585E993A75EAA2458BD41F68E379037858
      7B1D15290AF86623D5A6F5EBD77330AE79B5F260F4606579A5B2B8D2B2A02292
      C0F306DF521BAC2647E3FFF5C39786140D9BB08C6F3652F3C6DCB973BFDE5A99
      3871227BBD7841656A6B65F9F2CAABAF560F62F7B0DCC237031B94870B798360
      A309E39ED265DF6CA4DA34773963E0E228BA91F1C0F6DAF1C5F3E7CF8F4E0DAA
      75C146AA9E2860AD806F3652F3C6BE8FA3D6D6CAEEDD63543030D6AE65BF12AD
      DF2436C4C70AD5C70DA526A447127902891F64543FB59618154BAA806F362832
      0D0D0DB1190543826D6CFA61A8A2B2110F90EA59F8210DB430E8A278ADF1CAF8
      6623E93FFD49F9847DBDA17D163DBEBB734F68F3863A8B50835B25C7B090036C
      345EDC537AE49B0D8A4DACCCE2C58BA501525C513C0F36887AA2988502BED948
      9D6FF03EF0BC118F6D926EF359D9308CB890372CA2A7B1ABF86683A8A6998D38
      8E0D6C88A3AF2424A4E57E988B13BDD324C57CB39157DED0CE3772F419E61839
      8A59D2A67CB34194C93C178F1B217E2F4EBCA8580C6C5888D660557CB341CF1B
      F197DF8603776C34989BD11D0B057CB3413451FCEA8D1FC70F504907C406510C
      0A6455C0371BC4BC91B51B280F057257C0371BB977000D4201470AF866839837
      B0EECF91BFD12C5D01DF6C502CC3BA3F8A4A28E35A01DF6CA4E60DACFB73ED72
      B44F54C0371BA966B958F7175FD4FCAD05BED348F54E5315F0CD466ADEC86BDD
      9FD68B60A3A982BBCECEFA6623D5DCBCD6FD818D54A951C0AC806F3652F346FD
      EBFE7887C5E70BC5D57CAA1CEA123F3C74086CAA2174E6CC29BE1F1B3870F450
      1F8B5DF6CAF7D43876A4603DEBFEA4A985E1C97309A118273CACEEC8ADA56BD6
      371B4ED7FDA9F10D364A1791C531D8371BC49EDBADFB031B4479518CA2806F36
      88E334BB757F49C32469A025CD46E8C330FC919712520D53C6371B44E1ECD6FD
      A96C700CD4B9B8B4C8160B00897E69AA62BED9C82B6F70277958BF815CD1543C
      889DF5CD0651E8E0EBFED46118D172146B18057CB341CF1B58F7D7304156D28E
      F866832813D6FD11854231770AF866839837DC75182D4301A202BED9209A8562
      5020B802BED920E60DACFB0B1E1930C0371B14C5B1EE8FA212CAB856C0371BA9
      7903EBFE5CBB1CED1315F0CD46AA599ED7FD15E4ABBD829891EA9DA62AE09B8D
      D4BCE179DD1F312889C5AC43C775FBD686357345DF6CA46AED79DD5F4182B220
      66A47AA7A90AF86623356FF859F7675EEBC72320E921C5D45581EA938BBC3535
      B0B0E4B0C8B0F96683A285EB757FD243B852E0F24FB58BA2B2568C9B4A022356
      C370D118548A742893A302BED928C2BA3F6D884BB7F0F8B1763134896CA84D69
      1D666E4D4B6C8E8E4753A90AF86623D5205EC0E9BABFD4A0146FE7E21D9DC886
      D4C7A4B944AA196A01A27A28968B020565C3E9BA3F4A886B473B948AF488A797
      4C9AAEE412016824498152B2114795766D933A55880748F147E649308F457158
      9554517B6B4FAAABCE1CCC66A89F228E7D2A504A3662813CACFB4BBCA9E8FEEE
      94AFE7920663F95E05AD95326F48776571E8CFFBE39F0D2927380D2CB0E154DE
      D4C68B9B37B0EE2FD57928E0548182B2210EB5F931FEDF9FD33840E3AA020565
      03AE8202C115001BC15D00030AAA00D828A86360567005C0467017C080822A00
      360AEA1898155C01B011DC0530A0A00A808D823A06660557006C0477010C28A8
      0260A3A08E8159C115001BC15D00030AAA00D828A86360567005C0467017C080
      822A00360AEA1898155C01B011DC0530A0A00A808D823A06660557006C047701
      0C28A80260A3A08E8159C115001BC15D00030AAA00D828A86360567005C04670
      17C080822A00360AEA1898155C01B011DC0530A0A00A808D823A06660557006C
      0477010C28A80260A3A08E8159C115001BC15D00030AAA00D828A86360567005
      C0467017C080822A00360AEA1898155C81FF0351E6E6669FC31DDF0000000049
      454E44AE426082}
  end
  object btnLoadImages: TButton
    Left = 64
    Top = 24
    Width = 75
    Height = 25
    Caption = 'Load images'
    TabOrder = 0
    OnClick = btnLoadImagesClick
  end
  object Timer1: TTimer
    Interval = 2000
    OnTimer = Timer1Timer
    Left = 16
    Top = 16
  end
  object ADOConnection1: TADOConnection
    Connected = True
    ConnectionString = 
      'Provider=OraOLEDB.Oracle.1;Password=STOREPWD;Persist Security Info' +
      '=True;User ID=STORE;Data Source=TESTDB'
    LoginPrompt = False
    Provider = 'OraOLEDB.Oracle.1'
    Left = 16
    Top = 64
  end
  object ADOQuery1: TADOQuery
    Connection = ADOConnection1
    Parameters = <>
    SQL.Strings = (
      'SELECT ID, XIMAGE FROM STORE.IMAGES')
    Left = 16
    Top = 104
  end
end
 
-----
 
unit UntGraphicStore;
 
interface
 
uses Classes, Graphics, DB;
 
const
  column_ID: string    = 'ID';
  column_IMAGE: string = 'XIMAGE';
  param_ID: string     = 'ID';
 
function GraphicFromStore(aFileName: string; Qry: TDataset = nil): TGraphic;
function GraphicStoreCount: Integer;
procedure RemoveFromStore(aFileName: string);
procedure EmptyGraphicStore;
 
implementation
 
uses GraphicEx, Jpeg, SysUtils, ContNrs, AdoDB;
 
type
  TGraphicStoreItem = class(TObject)
  private
    FGraphic: TGraphic;
    FFileName: string;
    fLastLoaded: TDateTime;
    FIsEmpty: boolean;
    FQry: TDataset;
    function GetGraphic: TGraphic;
    procedure LoadGraphic;
  public
    constructor Create(aFileName: string; aQry: Tdataset = nil);
    destructor Destroy; override;
    procedure Refresh;
    property LastLoaded: TDateTime read fLastLoaded write fLastLoaded;
    property FileName: string read FFileName write FFileName;
    property Graphic: TGraphic read GetGraphic;
    property IsEmpty: boolean read FIsEmpty;
  end;
 
  TGraphicStore = class(TObjectList)
  private
    FMaxLoad: integer;
    procedure SetMaxLoad(const Value: integer);
  protected
  public
    constructor Create(AOwnsObjects: Boolean);
    function GetGraphic(aFileName: string; Qry: TDataset = nil): TGraphic;
    procedure RemoveGraphic(aFileName: string);
    property MaxLoad: integer read FMaxLoad write SetMaxLoad default 100;
  end;
 
var GraphicStore: TGraphicStore = nil;
 
function GraphicFromStore(aFileName: string; Qry: TDataset = nil): TGraphic;
begin
  if GraphicStore = nil then
    GraphicStore := TGraphicStore.Create(True);
  Result := GraphicStore.GetGraphic(aFileName, Qry);
end;
 
function GraphicStoreCount: Integer;
begin
  Result := 0;
  if GraphicStore <> nil then
    Result := GraphicStore.Count;
end;
 
procedure RemoveFromStore(aFileName: string);
begin
  if GraphicStore <> nil then
    GraphicStore.RemoveGraphic(aFileName);
end;
 
procedure EmptyGraphicStore;
begin
  if GraphicStore <> nil then
    GraphicStore.Clear;
end;
 
{ TGraphicStoreItem }
 
constructor TGraphicStoreItem.Create(aFileName: string; aQry: TDataset = nil);
begin
  inherited Create;
  FIsEmpty := True;
  FFileName := aFileName;
  FGraphic := nil;
  FQry := aQry;
  LoadGraphic;
end;
 
procedure TGraphicStoreItem.LoadGraphic;
var aClass: TGraphicExGraphicClass;
  aStream: TStream;
begin
  FIsEmpty := True;
  if FGraphic <> nil then
    FreeAndNil(FGraphic);
  if FFileName <> '' then
  try
    if Assigned(fQry) then 
    begin
      if fQry is TADOQuery then
        with TAdoQuery(fQry) do
        begin
          if Active and
            not SameText(FieldByName(column_ID).AsString, FFileName) then
          begin
            if not Locate(column_Id, FFileName, []) then
              Close;
          end;
          if not Active then
          begin
            Parameters.ParamByName(param_ID).Value := fFileName;
            Open;
          end;
          if Active and
            SameText(FieldByName(column_id).AsString, fFileName) then
          begin
            aStream := CreateBlobStream(FieldByName(column_Image), bmRead);
            try
              aClass := FileFormatList.GraphicFromContent(aStream);
              if aClass <> nil then
              begin
                FGraphic := aClass.Create;
                aStream.Seek(0, soFromBeginning);
                TGraphicExGraphic(FGraphic).LoadFromStream(aStream);
              end;
            finally
              FreeAndNil(aStream);
            end;
          end;
        end;
    end else
    begin
      if FileExists(fFileName) then
      begin
        if SameText(ExtractFileExt(FFileName), '.bmp') then
        begin
          FGraphic := TBitmap.Create;
          FGraphic.LoadFromFile(FFileName);
          FIsEmpty := False;
        end else if SameText(ExtractFileExt(FFileName), '.jpg') or SameText(ExtractFileExt(FFileName), '.jpeg') then
        begin
          FGraphic := TJPEGImage.Create;
          FGraphic.LoadFromFile(FFileName);
          FIsEmpty := False;
        end
          else
        begin
          aClass := FileFormatList.GraphicFromContent(fFileName);
          if aClass <> nil then
          begin
            FGraphic := aClass.Create;
            if TGraphicExGraphic(FGraphic).CanLoad(FFileName) then
              FGraphic.LoadFromFile(FFileName);
          end;
        end;
      end;
    end;
  except
    // Catch exceptions
  end;
  fLastLoaded := Now;
end;
 
destructor TGraphicStoreItem.Destroy;
begin
  FreeAndNil(FGraphic);
  inherited Destroy;
end;
 
function TGraphicStoreItem.GetGraphic: TGraphic;
begin
  if FGraphic = nil then
    LoadGraphic;
  Result := FGraphic;
  LastLoaded := Now;
end;
 
procedure TGraphicStoreItem.Refresh;
begin
  LoadGraphic;
end;
 
{ TGraphicStore }
 
constructor TGraphicStore.Create(AOwnsObjects: Boolean);
begin
  inherited Create(True);
  FMaxLoad := 100;
end;
 
function TGraphicStore.GetGraphic(aFileName: string; Qry: TDataset = nil): TGraphic;
var I, OldestIndex: Integer;
  Found: boolean;
  aItem: TGraphicStoreItem;
begin
  Result := nil;
  Found := False;
  for I := 0 to Count - 1 do
    if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
    begin
      Result := TGraphicStoreItem(Items[I]).Graphic;
      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 TGraphicStoreItem(Items[I]).LastLoaded < TGraphicStoreItem(Items[OldestIndex]).LastLoaded then
            OldestIndex := I;
        Delete(OldestIndex);
      end else
        Delete(0);
    end;
    aItem := TGraphicStoreItem.Create(aFileName, Qry);
    Add(aItem);
    Result := aItem.Graphic;
  end;
end;
 
procedure TGraphicStore.RemoveGraphic(aFileName: string);
var I: Integer;
begin
  for I := Count - 1 downto 0 do
    if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
      Delete(I);
end;
 
procedure TGraphicStore.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 GraphicStore <> nil then
    FreeAndNil(GraphicStore);
end.

Open in new window

developmentguru
I did my own version. Ā I used the GIFImg unit (included in Delphi 2007). Ā I am using a TADOConnection component (you must set this up to map to your database) and a TADOTable. Ā I start the program with the connection connected and connect the table on Form Create. Ā On Form Create I also load all of the GIFs into memory and create a TList I use for the randomization. Ā On a timer I take care of the randomization and display of an image. Ā Let me know if you need more.
unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ImgList, Contnrs, ExtCtrls, GIFImg;
 
type
  TForm3 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    ImageList1: TImageList;
    Image1: TImage;
    Timer1: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    fGIFs : TObjectList;
    fIndexes : TList;
  public
    { Public declarations }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
procedure TForm3.FormCreate(Sender: TObject);
var
  BlobField : TBlobField;
  GIF : TGIFImage;
  MemStream : TMemoryStream;
  Picture : TPicture;
 
begin
  fIndexes := TList.Create;
  fGIFs := TObjectList.Create;
  MemStream := TMemoryStream.Create;
  try
    ADOTable1.Open;
    BlobField := TBLOBField(ADOTable1.FieldByName('GIF'));
    while not ADOTable1.EOF do
      begin
        MemStream.Clear;
        BlobField.SaveToStream(MemStream);
        MemStream.Seek(0, soFromBeginning);
        GIF := TGIFImage.Create;
        GIF.LoadFromStream(MemStream);
        fGIFs.Add(GIF);
 
        ADOTable1.Next;
      end;
  finally
    MemStream.Free;
  end;
end;
 
procedure TForm3.FormDestroy(Sender: TObject);
begin
  fIndexes.Free;
  fGIFs.Free;
end;
 
procedure TForm3.Timer1Timer(Sender: TObject);
var
  I, Index : Integer;
 
begin
  if fIndexes.Count = 0 then
    begin
      for I := 0 to fGIFs.Count - 1 do
        fIndexes.Add(pointer(I));
    end;
 
  Index := Random(fIndexes.Count);
  I := integer(fIndexes[Index]);
  fIndexes.Delete(Index);
  Image1.Picture.Assign(TGIFImage(fGIFs[I]));
end;
 
end.

Open in new window

I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
aj85
ASKER
Hello developmentguru,

With your version I get the following error:

Ā  Ā  Ā  Ā  GIF := TGIFImage.Create;
Ā  Ā  Ā  Ā  GIF.LoadFromStream(MemStream);

[Error] Unit1.pas(54): Not enough actual parameters
[Error] Unit1.pas(55): Undeclared identifier: 'LoadFromStream'

I have added the GIFImg PAS, so I am not sure why this error is occurring. Ā Perhaps I am missing something in my environment? Ā Please advise.

Thanks,
aj85


aj85
ASKER
Hello Geert,

I your version I get the following error when I click on the btnLoadImages button:

begin
Ā  Ā  Ā  ADOConnection1.Connected := True; Ā ---This connects to my DB successfully.
Ā  try
Ā  Ā  ADOQuery1.Open; Ā --- This gives an error: ADOQuery1: Missing SQL Property

Please advise as well.

Thanks again,
aj85



Geert G
did you set the SQL.Text in the dfm ?
check my dfm, you will need to change it your database
āš” FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
aj85
ASKER
Hello Geert,

Ok I checked your DFM and you were correct. Ā Just one more thing. Ā The image is not showing, and I noticed that your example is for a .bmp and jpeg, can you modify yours for a GIF? Ā Also, here are the column names for the table I am using:

ID, Imagename, ImageType


I am sure it is something small that I am not doing on my end, so if you could assist with solving this I think we will be finished.

Thanks,
aj85
Geert G
ImageType ?
if this the extension of the file, that would make it easier ...

i'll have to modify the storage unit to use 3 columns (the constants at the top)
developmentguru
What version of Delphi are you using? Ā The example I gave you is done on Delphi 2007. Ā It sounds like you have an older version of the unit. Ā You can place your cursor inside the parenthesis on the LoadFromStream call and hit [Ctrl][Shift][Space] to have it show the parameter list. Ā Could you show the entire method as you defined it?
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
aj85
ASKER
Hello,

I am using D7. Ā The "LoadFromStream" call is never made when I step through the code. Ā So I must be missing something on my end. Ā Here is the units that I have:


unit Unit1;

interface

uses
Ā  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Ā  Dialogs, DB, ADODB, StdCtrls, ExtCtrls, dxGDIPlusClasses, ImgList, JvGIF;

Ā  const FileDir = 'C:\images\';

type
Ā  TForm1 = class(TForm)
Ā  Ā  Timer1: TTimer;
Ā  Ā  DataSource1: TDataSource;
Ā  Ā  ADOTable1: TADOTable;
Ā  Ā  ADOQuery1: TADOQuery;
Ā  Ā  btnLoadImages: TButton;
Ā  Ā  ADOConnection1: TADOConnection;
Ā  Ā  Image1: TImage;
Ā  Ā  ImageList1: TImageList;
Ā  Ā  procedure btnLoadImagesClick(Sender: TObject);
Ā  Ā  procedure Timer1Timer(Sender: TObject);
Ā  private
Ā  Ā  { Private declarations }
Ā  Ā  Ā fImages: TStrings;
Ā  public
Ā  Ā  { Public declarations }
Ā  Ā  constructor Create(AOwner: TComponent); override;
Ā  Ā  destructor Destroy; override;
Ā  end;

var
Ā  Form1: TForm1;

implementation

uses UntGraphicStore;

{$R *.dfm}

procedure TForm1.btnLoadImagesClick(Sender: TObject);
begin
Ā  Ā  Ā  ADOConnection1.Connected := True;
Ā  try
Ā  Ā  ADOQuery1.Open;
Ā  Ā  while not AdoQuery1.Eof do
Ā  Ā  begin
Ā  Ā  Ā  if fImages.IndexOf(AdoQuery1.FieldByName('ID').AsString) = -1 then
Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  if GraphicFromStore(AdoQuery1.FieldByName('ID').AsString, AdoQuery1) <>Ā nil then
Ā  Ā  Ā  Ā  Ā  fImages.Add(AdoQuery1.FieldByName('ID').AsString);
Ā  Ā  Ā  end;
Ā  Ā  Ā  ADOQuery1.Next;
Ā  Ā  end;
Ā  Ā  ADOQuery1.Close;
Ā  finally
Ā  Ā  AdoConnection1.Connected := False;
Ā  end;
end;

constructor TForm1.Create(AOwner: TComponent);
begin
Ā  inherited Create(AOwner);
Ā  fImages := TStringList.Create;
end;
Ā 
destructor TForm1.Destroy;
begin
Ā  FreeAndNil(fImages);
Ā  inherited Destroy;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var X: Integer;
begin
Ā  if fImages.Count >Ā 0 then
Ā  begin
Ā  Ā  X := Random(fImages.Count);
Ā  Ā  //Image1.Picture.Graphic := GraphicFromStore(FileDir + fImages[X]);
Ā  Ā  Image1.Picture.Graphic := GraphicFromStore(fImages[X]);
Ā  end;
end;


end.

//---------------

unit UntGraphicStore;
Ā 
interface
Ā 
uses Classes, Graphics, DB;
Ā 
const
Ā  column_ID: string Ā  Ā = 'ID';
Ā  column_IMAGE: string = 'BANNERS';
Ā  param_ID: string Ā  Ā  = 'ID';
Ā 
function GraphicFromStore(aFileName: string; Qry: TDataset = nil): TGraphic;
function GraphicStoreCount: Integer;
procedure RemoveFromStore(aFileName: string);
procedure EmptyGraphicStore;
Ā 
implementation
Ā 
uses GraphicEx, Jpeg, SysUtils, ContNrs, AdoDB;
Ā 
type
Ā  TGraphicStoreItem = class(TObject)
Ā  private
Ā  Ā  FGraphic: TGraphic;
Ā  Ā  FFileName: string;
Ā  Ā  fLastLoaded: TDateTime;
Ā  Ā  FIsEmpty: boolean;
Ā  Ā  FQry: TDataset;
Ā  Ā  function GetGraphic: TGraphic;
Ā  Ā  procedure LoadGraphic;
Ā  public
Ā  Ā  constructor Create(aFileName: string; aQry: Tdataset = nil);
Ā  Ā  destructor Destroy; override;
Ā  Ā  procedure Refresh;
Ā  Ā  property LastLoaded: TDateTime read fLastLoaded write fLastLoaded;
Ā  Ā  property FileName: string read FFileName write FFileName;
Ā  Ā  property Graphic: TGraphic read GetGraphic;
Ā  Ā  property IsEmpty: boolean read FIsEmpty;
Ā  end;
Ā 
Ā  TGraphicStore = class(TObjectList)
Ā  private
Ā  Ā  FMaxLoad: integer;
Ā  Ā  procedure SetMaxLoad(const Value: integer);
Ā  protected
Ā  public
Ā  Ā  constructor Create(AOwnsObjects: Boolean);
Ā  Ā  function GetGraphic(aFileName: string; Qry: TDataset = nil): TGraphic;
Ā  Ā  procedure RemoveGraphic(aFileName: string);
Ā  Ā  property MaxLoad: integer read FMaxLoad write SetMaxLoad default 100;
Ā  end;
Ā 
var GraphicStore: TGraphicStore = nil;
Ā 
function GraphicFromStore(aFileName: string; Qry: TDataset = nil): TGraphic;
begin
Ā  if GraphicStore = nil then
Ā  Ā  GraphicStore := TGraphicStore.Create(True);
Ā  Result := GraphicStore.GetGraphic(aFileName, Qry);
end;
Ā 
function GraphicStoreCount: Integer;
begin
Ā  Result := 0;
Ā  if GraphicStore <>Ā nil then
Ā  Ā  Result := GraphicStore.Count;
end;
Ā 
procedure RemoveFromStore(aFileName: string);
begin
Ā  if GraphicStore <>Ā nil then
Ā  Ā  GraphicStore.RemoveGraphic(aFileName);
end;
Ā 
procedure EmptyGraphicStore;
begin
Ā  if GraphicStore <>Ā nil then
Ā  Ā  GraphicStore.Clear;
end;
Ā 
{ TGraphicStoreItem }
Ā 
constructor TGraphicStoreItem.Create(aFileName: string; aQry: TDataset = nil);
begin
Ā  inherited Create;
Ā  FIsEmpty := True;
Ā  FFileName := aFileName;
Ā  FGraphic := nil;
Ā  FQry := aQry;
Ā  LoadGraphic;
end;
Ā 
procedure TGraphicStoreItem.LoadGraphic;
var aClass: TGraphicExGraphicClass;
Ā  aStream: TStream;
begin
Ā  FIsEmpty := True;
Ā  if FGraphic <>Ā nil then
Ā  Ā  FreeAndNil(FGraphic);
Ā  if FFileName <>Ā '' then
Ā  try
Ā  Ā  if Assigned(fQry) then
Ā  Ā  begin
Ā  Ā  Ā  if fQry is TADOQuery then
Ā  Ā  Ā  Ā  with TAdoQuery(fQry) do
Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  if Active and
Ā  Ā  Ā  Ā  Ā  Ā  not SameText(FieldByName(column_ID).AsString, FFileName) then
Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  if not Locate(column_Id, FFileName, []) then
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Close;
Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  if not Active then
Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  Parameters.ParamByName(param_ID).Value := fFileName;
Ā  Ā  Ā  Ā  Ā  Ā  Open;
Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  if Active and
Ā  Ā  Ā  Ā  Ā  Ā  SameText(FieldByName(column_id).AsString, fFileName) then
Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  aStream := CreateBlobStream(FieldByName(column_Image), bmRead);
Ā  Ā  Ā  Ā  Ā  Ā  try
Ā  Ā  Ā  Ā  Ā  Ā  Ā  aClass := FileFormatList.GraphicFromContent(aStream);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  if aClass <>Ā nil then
Ā  Ā  Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  FGraphic := aClass.Create;
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  aStream.Seek(0, soFromBeginning);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  TGraphicExGraphic(FGraphic).LoadFromStream(aStream);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  Ā  finally
Ā  Ā  Ā  Ā  Ā  Ā  Ā  FreeAndNil(aStream);
Ā  Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  end;
Ā  Ā  end else
Ā  Ā  begin
Ā  Ā  Ā  if FileExists(fFileName) then
Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  if SameText(ExtractFileExt(FFileName), '.bmp') then
Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  FGraphic := TBitmap.Create;
Ā  Ā  Ā  Ā  Ā  FGraphic.LoadFromFile(FFileName);
Ā  Ā  Ā  Ā  Ā  FIsEmpty := False;
Ā  Ā  Ā  Ā  end else if SameText(ExtractFileExt(FFileName), '.jpg') or SameText(ExtractFileExt(FFileName), '.jpeg') then
Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  FGraphic := TJPEGImage.Create;
Ā  Ā  Ā  Ā  Ā  FGraphic.LoadFromFile(FFileName);
Ā  Ā  Ā  Ā  Ā  FIsEmpty := False;
Ā  Ā  Ā  Ā  end
Ā  Ā  Ā  Ā  Ā  else
Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  aClass := FileFormatList.GraphicFromContent(fFileName);
Ā  Ā  Ā  Ā  Ā  if aClass <>Ā nil then
Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  FGraphic := aClass.Create;
Ā  Ā  Ā  Ā  Ā  Ā  if TGraphicExGraphic(FGraphic).CanLoad(FFileName) then
Ā  Ā  Ā  Ā  Ā  Ā  Ā  FGraphic.LoadFromFile(FFileName);
Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  end;
Ā  Ā  end;
Ā  except
Ā  Ā  // Catch exceptions
Ā  end;
Ā  fLastLoaded := Now;
end;
Ā 
destructor TGraphicStoreItem.Destroy;
begin
Ā  FreeAndNil(FGraphic);
Ā  inherited Destroy;
end;
Ā 
function TGraphicStoreItem.GetGraphic: TGraphic;
begin
Ā  if FGraphic = nil then
Ā  Ā  LoadGraphic;
Ā  Result := FGraphic;
Ā  LastLoaded := Now;
end;
Ā 
procedure TGraphicStoreItem.Refresh;
begin
Ā  LoadGraphic;
end;
Ā 
{ TGraphicStore }
Ā 
constructor TGraphicStore.Create(AOwnsObjects: Boolean);
begin
Ā  inherited Create(True);
Ā  FMaxLoad := 100;
end;
Ā 
function TGraphicStore.GetGraphic(aFileName: string; Qry: TDataset = nil): TGraphic;
var I, OldestIndex: Integer;
Ā  Found: boolean;
Ā  aItem: TGraphicStoreItem;
begin
Ā  Result := nil;
Ā  Found := False;
Ā  for I := 0 to Count - 1 do
Ā  Ā  if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
Ā  Ā  begin
Ā  Ā  Ā  Result := TGraphicStoreItem(Items[I]).Graphic;
Ā  Ā  Ā  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 TGraphicStoreItem(Items[I]).LastLoaded <Ā TGraphicStoreItem(Items[OldestIndex]).LastLoaded then
Ā  Ā  Ā  Ā  Ā  Ā  OldestIndex := I;
Ā  Ā  Ā  Ā  Delete(OldestIndex);
Ā  Ā  Ā  end else
Ā  Ā  Ā  Ā  Delete(0);
Ā  Ā  end;
Ā  Ā  aItem := TGraphicStoreItem.Create(aFileName, Qry);
Ā  Ā  Add(aItem);
Ā  Ā  Result := aItem.Graphic;
Ā  end;
end;
Ā 
procedure TGraphicStore.RemoveGraphic(aFileName: string);
var I: Integer;
begin
Ā  for I := Count - 1 downto 0 do
Ā  Ā  if SameText(TGraphicStoreItem(Items[I]).FileName, aFileName) then
Ā  Ā  Ā  Delete(I);
end;
Ā 
procedure TGraphicStore.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 GraphicStore <>Ā nil then
Ā  Ā  FreeAndNil(GraphicStore);

end.


Thanks,
aj85
aj85
ASKER
Hello Geert,

ImageType is the column when the images are stored.

Thanks again,
aj85
Geert G
ok, here are the changes:
1: column_type

unit UntGraphicStore;

interface

uses Classes, Graphics, DB;

const
Ā  column_ID: Ā  Ā string = 'ID';
Ā  column_IMAGE: string = 'XIMAGE';
Ā  column_TYPE: Ā string = 'EXT';
Ā  param_ID: Ā  Ā  string = 'ID';

function GraphicFromStore(aFileName: string; Qry: TDataset = nil): TGraphic;


2: GraphicFromExtension

if Active and
Ā  Ā  Ā  Ā  Ā  Ā  SameText(FieldByName(column_id).AsString, fFileName) then
Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  aStream := CreateBlobStream(FieldByName(column_Image), bmRead);
Ā  Ā  Ā  Ā  Ā  Ā  try
Ā  Ā  Ā  Ā  Ā  Ā  Ā  aClass := FileFormatList.GraphicFromExtension(FieldByName(column_TYPE).AsString);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  if aClass <>Ā nil then
Ā  Ā  Ā  Ā  Ā  Ā  Ā  begin
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  FGraphic := aClass.Create;
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  aStream.Seek(0, soFromBeginning);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  TGraphicExGraphic(FGraphic).LoadFromStream(aStream);
Ā  Ā  Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  Ā  finally
Ā  Ā  Ā  Ā  Ā  Ā  Ā  FreeAndNil(aStream);
Ā  Ā  Ā  Ā  Ā  Ā  end;
Ā  Ā  Ā  Ā  Ā  end;

3: change your query to include the image type

4: enable GIF in the GraphicConfiguration.inc file:
Ā (remove the . )
//
//----------------------------------------------------------------------------------------------------------------------

{$define UseLZW} // if this is not defined (default) then neither the GIF format nor the
Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  Ā  // LZW compression decoder (e.g. for TIFF LZW compression) is available

// Pick your preferred image formats here or leave them all enabled. By disabling
// certain formats which are not of interest you can save some memory.
{$define SGIGraphic} Ā  Ā  Ā 



āš” FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Geert G
you still need to change the constants to the column name you use
this is in the first lines of UntGraphicStore

const
Ā  column_ID: string Ā  Ā = 'ID';
Ā  column_IMAGE: string = 'BANNERS';
Ā  column_TYPE: string = 'IMAGETYPE';
Ā  param_ID: string Ā  Ā  = 'ID';
aj85
ASKER
Hello Geert,

I am sorry I am little confused. Ā What are you referring to, in steps 2 and 4? Ā What is GraphicFromExtension and GraphicConfiguration.inc?

aj85
ASKER CERTIFIED SOLUTION
Geert G
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
aj85
ASKER
Hello Geert,

Thanks for expanding on that further. Ā Only one more question. :-) Ā I have a gif pre-loaded in the TImage control and it is visible prior to runtime. Ā However when I run the application the image is not visible. Ā I removed the "." in the inc file for the GraphicEx library as you instructed; "{$define UseLZW} // if this is not defined (default) then neither the GIF format nor"

My question is, do I need to do something else to make the .GIF show as it is not visible? Ā 

Thanks,
aj85


All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
aj85
ASKER
Hello Again Geert,

I found the issue and it was a small typo on my part that was casing the problem. Ā Thanks very much for your help. Ā Here are your points.

aj85 Ā 
Geert G
the pre loaded gif is not part of the database
adding it, would solve that problem
aj85
ASKER
Hello Geert,

Thanks for clarification. Ā I do have one follow up that if you would answer I would appreciate it. Ā The GIF file works as it should now however, because it is random in the rotation the actual image being shown does not correlate to the image ID in the database. Ā For example is image 2 is rotated it actually may be image ID 23 in the database. Ā This has caused a small problem for me because the images have a department message in the database the is for that specific image. Ā So if a user clicks on image 2 in the rotation, that is actually image 23 in the database, the user gets the message for image number 2. Ā My question is how do I get the correct ID for the image that is being rotated so the correct message is shown? Ā Hope this makes sense?

Thanks,
aj85
āš” FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Plans and Pricing
Resources
Product
Podcasts
Careers
Contact Us
Teams
Certified Expert Program
Credly Partnership
Udemy Partnership
Privacy Policy
Terms of Use

Ā© 1996-2023 Experts Exchange, LLC. All rights reserved. Covered by US Patent