寻找自定义图像网格 [英] Looking for a custom image grid

问题描述

我正在寻找一个特别设计用于显示图像的网格。它还需要具有良好的性能，最好使用某种缩略图缓存。这些图像需要从文件中加载，如果可以动态地分配图像也是很好的。它不应该在列/列记录（例如标准网格）上工作，而是单个项目列表，每个项目表示图像。应该有一个属性来一次定义所有列和行的col宽度和行高，而不是一次。最终目标是列出所有具有用户选项的图像，以控制显示图像的大小。它将被用作产品显示，因此还需要一些自定义绘图功能，如 OnDrawItem 事件。这可能会在此列表中显示多达50,000张图像，因此TListView将无法正常工作，因为它非常重要。

需要使用Delphi 2010，XE2，并且最好是7。

这里有3个如何显示下面8个图像的例子。我不是说每个图像的大小不一样，但大小相同。没有2列可以有不同的宽度，与行相同。

解决方案

为了乐趣，我为您编写了一个ImageGrid组件。 >

它只有一个垂直滚动条;调整控件宽度的大小调整列计数和行计数。图像在内部列表中被缓存为调整大小的位图及其文件名。

由于加载和重新采样这些图像可能需要一些时间，具体取决于图像数量，分辨率以及是否要使用Graphics32库以获得更好的重新采样质量，组件将加载过程委托给一个单独的线程，（重新）在设置列宽度或行高度时运行，以及更改文件名或文件夹路径其中组件尝试查找要在 FileFormats 属性中提供的所有类型的图像。

功能： / p>

• 在后台线程中创建和调整图像缩略图，从GDI +库的文件名或使用Graphics 32库的手动添加图像


• 自动识别所有注册的图像文件格式


• 动画滚​​动


• 通过拖动网格滚动浏览屏幕支持
• 
  
• 键盘支持f或选择大拇指


• OwnerDraw支持，例如


• 绕过自动创建缩略图的虚拟支持

属性和事件：

• ColCount ：列数，readonly


• 计数：图像数量，只读


• 图像：所有手动添加的图像的列表，其中从


• 项目内部创建拇指：所有filename-thumbnail或image-缩略图组合


• RowCount ：行数，只读


• Thumbs ：所有内部创建的缩略图列表


• AutoHideScrollBar ：隐藏滚动条，当所有行都可见


• BorderStyle ：显示或隐藏主题边框


• BorderWidth ：组件边缘，滚动条之外


• CellAlignment ：将左侧的拇指对齐或细胞的右侧l


• CellHeight ：单元格高度


• CellLayout ：将大拇指排列在单元格的顶部，中间或底部


• CellSpacing ：单元格之间的间距
• 
  
• CellWidth ：单元格宽度


• 颜色：边框和单元间距的背景颜色


• ColWidth ：width的宽度（等于单元格宽度加上单元间距） li>
  
• DefaultDrawing ：默认绘制所有缩略图


• DesignPreview ：在设计器中显示拇指


• DragScroll ：支持通过放置网格滚动网格


• FileFormats ：文件名过滤的图像文件扩展名


• FileNames ：包含所有文件名的列表


• 文件夹：组件尝试查找所有图像文件的目录


• ItemIndex ：选择的单元格索引


• MarkerColor ：加载过程中临时拇指标记的颜色


• MarkerStyle ：加载过程中临时拇指标记的样式


• OnClickCell ：单击单元格时触发


• OnDrawCell ：绘制单元格时触发


• OnMeasureThumb ：当要计算拇指的大小时触发


• OnProgress ：当图像为调整为缩略图格式


• OnUnresolved ：无法创建拇指时触发，例如当没有找到文件名


• RetainUnresolvedItems ：在列表中保留空的缩略图


• RowHeight ：行高度（等于单元格高度加上单元格间距）


• ParentBackground ：在边框和单元格之间绘制父母的（主题）背景


• 比例：按比例调整图像的大小


• 排序：文件名排序


• Stretch ：将小图像延伸到单元格大小


• VirtualMode ：阻止自动创建缩略图


• WheelScrollLines ：使用鼠标滚轮滚动的行数

感谢：

• InterfaceLIFT ，以上截图中显示的图片


• 如何在滚动条上创建一个减速的滚动效果？


• 如何获取所有图形单元支持的文件格式？


• 是否有必要将String转换为WideString？


• BorderWidth的修补程序> 0与滚动条组合

代码太长，不能在这里发布，但OpenSource项目可以从这里的版本服务器。这是接口部分：

 单元AwImageGrid; 
 
接口
 
 {$ DEFINE USE_GR32} 
 
使用
 Windows，Classes，SysUtils，消息，控件，图形，窗体，StdCtrls ，
网格，GDIPAPI，GDIPOBJ，RTLConsts，数学，主题
 {$ IFDEF USE_GR32}，GR32，GR32_Resamplers {$ ENDIF}; 
 
 const 
 DefCellSpacing = 5; 
 DefCellWidth = 96; 
 DefCellHeight = 60; 
 DefColWidth = DefCellWidth + DefCellSpacing; 
 DefRowHeight = DefCellHeight + DefCellSpacing; 
 MinThumbSize = 4; 
 MinCellSize = 8; 
 
 type 
 PImageGridItem = ^ TImageGridItem; 
 TImageGridItem = record 
 FFileName：TFileName; 
 FObject：TObject; 
 FImage：TGraphic; 
 FThumb：TBitmap; 
结束
 
 PImageGridItemList = ^ TImageGridItemList; 
 TImageGridItemList =数组[0..MaxListSize div 2] TI​​mageGridItem; 
 
 {TImageGridItems 
在TImageGridItem元素数组中保存filename-thumbnail或image-thumbnail 
组合的管理对象。当项目的图像
更改时，项目的缩略图将被释放。当项目的文件名更改时，
仅当项目的图像未分配时，项目的缩略图才会被释放。 } 
 
 TImageGridItems = class（TStrings）
 private 
 FCapacity：Integer; 
 FChanged：Boolean; 
 FCount：整数; 
 FList：PImageGridItemList; 
 FOnChanged：TNotifyEvent; 
 FOnChanging：TNotifyEvent; 
 FOwnsObjects：Boolean; 
 FSorted：Boolean; 
程序ExchangeItems（Index1，Index2：Integer）; 
函数GetImage（Index：Integer）：TGraphic; 
函数GetThumb（Index：Integer）：TBitmap; 
程序成长; 
 procedure InsertItem（Index：Integer; const S：String; AObject：TObject; 
 AImage：TGraphic; AThumb：TBitmap）; 
程序PutImage（Index：Integer; AImage：TGraphic）; 
程序PutThumb（Index：Integer; AThumb：TBitmap）; 
 procedure QuickSort（L，R：Integer）; 
 procedure SetSorted（Value：Boolean）; 
 protected 
 function CompareStrings（const S1，S2：String）：Integer;覆盖
程序已更改;虚拟; 
程序更改;虚拟; 
函数Get（Index：Integer）：String;覆盖
函数GetCapacity：Integer;覆盖
函数GetCount：Integer;覆盖
函数GetObject（Index：Integer）：TObject;覆盖
 procedure Put（Index：Integer; const S：String）;覆盖
 procedure PutObject（Index：Integer; AObject：TObject）;覆盖
程序PutThumbSilently（Index：Integer; AThumb：TBitmap）;虚拟; 
程序SetCapacity（Value：Integer）;覆盖
 procedure SetUpdateState（Updating：Boolean）;覆盖
 public 
 function Add（const S：String）：Integer;覆盖
函数AddImage（const S：String; AImage：TGraphic）：整数;虚拟; 
 function AddItem（const S：String; AObject：TObject; AImage：TGraphic; 
 AThumb：TBitmap）：Integer;虚拟; 
 function AddObject（const S：String; AObject：TObject）：Integer;覆盖
函数AddThumb（const S：String; AThumb：TBitmap）：整数;虚拟; 
 procedure AddStrings（Strings：TStrings）;覆盖
程序分配（来源：TPersistent）;覆盖
程序清除;覆盖
程序ClearThumbs;虚拟; 
 procedure Delete（Index：Integer）;覆盖
析构函数覆盖
程序交换（Index1，Index2：Integer）;覆盖
 function IndexOf（const S：String）：整数;覆盖
 procedure Insert（Index：Integer; const S：String）;覆盖
 procedure InsertObject（Index：Integer; const S：String; 
 AObject：TObject）;覆盖
函数Find（const S：String; var Index：Integer）：Boolean; 
程序排序;虚拟; 
属性FileNames [Index：Integer]：String read获取写入; 
属性Images [Index：Integer]：TGraphic读取GetImage写入PutImage; 
属性OnChanged：TNotifyEvent read FOnChanged write FOnChanged; 
属性OnChanging：TNotifyEvent读取FOnChanging写FOnChanging; 
属性OwnsObjects：Boolean读取FOwnsObjects写入FOwnsObjects; 
属性排序：布尔读取FSorted写SetSorted; 
属性Thumbs [Index：Integer]：TBitmap读取GetThumb写PutThumb; 
结束
 
 {TBorderControl 
在当前主题之后，系统绘制边框的控件，以及由TWinControl.BorderWidth实现的
附加边距。 } 
 
 TBorderControl = class（TCustomControl）
 private 
 FBorderStyle：TBorderStyle; 
 procedure SetBorderStyle（Value：TBorderStyle）; 
 procedure WMNCPaint（var Message：TWMNCPaint）;消息WM_NCPAINT; 
 procedure CMCtl3DChanged（var Message：TMessage）;消息CM_CTL3DCHANGED; 
 protected 
 procedure CreateParams（var Params：TCreateParams）;覆盖
函数TotalBorderWidth：Integer;虚拟; 
 public 
构造函数Create（AOwner：TComponent）;覆盖
属性BorderStyle：TBorderStyle读FBorderStyle写SetBorderStyle 
默认bsSingle; 
属性BorderWidth; 
结束
 
 {TAnimRowScroller 
带垂直滚动条的滚动框和垂直堆叠的项，
固定行高。使用滚动条滚动是动画类似的Windows'
自己的默认列表框控件。使用鼠标左键拖动
内容也可以滚动。 } 
 
 TAnimRowScroller = class（TBorderControl）
 private 
 FAutoHideScrollBar：Boolean; 
 FDragScroll：Boolean; 
 FDragScrolling：Boolean; 
 FDragSpeed：Single; 
 FDragStartPos：Integer; 
 FPrevScrollPos：Integer; 
 FPrevTick：红衣主教; 
 FRow：整数; 
 FRowCount：Integer; 
 FRowHeight：整数; 
 FScrollingPos：整数; 
 FScrollPos：Integer; 
 FWheelScrollLines：Integer; 
程序拖动; 
函数IsWheelScrollLinesStored：Boolean; 
程序滚动; 
程序SetAutoHideScrollBar（Value：Boolean）; 
程序SetRow（Value：Integer）; 
程序SetRowCount（Value：Integer）; 
程序SetScrollPos（Value：Integer; Animate，Snap：Boolean）; 
程序UpdateScrollBar; 
程序WMVScroll（var Message：TWMVScroll）;消息WM_VSCROLL; 
 protected 
 procedure CreateWnd;覆盖
函数DoMouseWheel（Shift：TShiftState; WheelDelta：Integer; 
 MousePos：TPoint）：Boolean;覆盖
程序DrawFocusRect;虚拟; 
 procedure MouseDown（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）;覆盖
 procedure MouseMove（Shift：TShiftState; X，Y：Integer）;覆盖
 procedure MouseUp（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）;覆盖
 procedure调整大小;覆盖
程序SetRowHeight（Value：Integer）;虚拟; 
程序WndProc（var Message：TMessage）;覆盖
属性AutoHideScrollBar：Boolean读取FAutoHideScrollBar 
写入SetAutoHideScrollBar default True; 
属性行：整数读FROW写SetRow默认-1; 
属性RowCount：整数读取FRowCount写SetRowCount; 
属性RowHeight：整数读取FRowHeight写SetRowHeight 
默认DefRowHeight; 
属性DragScroll：Boolean读取FDragScroll写入FDragScroll 
 default True; 
属性DragScrolling：Boolean读取FDragScrolling; 
属性ScrollingPos：整数读取FScrollingPos; 
属性WheelScrollLines：整数读取FWheelScrollLines 
写入FWheelScrollLines存储的IsWheelScrollLinesStored; 
 public 
构造函数Create（AOwner：TComponent）;覆盖
 procedure MouseWheelHandler（var Message：TMessage）;覆盖
函数Scrolling：Boolean; 
结束
 
 {TCustomImageGrid 
图像网格的基类。它显示从左到右的图像，然后从上到下显示
。列的数量由
控件的宽度确定，可能导致垂直滚动条。通过ColWidth和RowHeight将coord大小设置为
，它们是CellWidth的总和。 CellHeight加
 CellSpacing。每个单元格显示相应图像的拇指。当图像的
图形，文件名或其单元格大小更改时，控件
将自动启动生成后台线程的缩略图。在每次这样的更改之前，任何
以前创建的线程都将被终止。通过调用
 Items.BeginUpdate / Items.EndUpdate来组合多个更改，以防止重新创建线程
。 } 
 
 TCustomImageGrid = class; 
 
 TPath = type String; 
 
 TDrawCellEvent =过程（发件人：TCustomImageGrid;索引，ACol，
 ARow：Integer; R：TRect）对象; 
 
 TImageEvent =对象的过程（发件人：TCustomImageGrid;索引：整数） 
 
 TMeasureThumbEvent = procedure（Sender：TCustomImageGrid; Index：Integer; 
 var AThumbWidth，AThumbHeight：Integer）of object; 
 
 TCustomImageGrid = class（TAnimRowScroller）
 private 
 FCellAlignment：TAlignment; 
 FCellLayout：TTextLayout; 
 FCellSpacing：整数; 
 FColCount：整数; 
 FColWidth：Integer; 
 FDefaultDrawing：Boolean; 
 FDesignPreview：Boolean; 
 FFileFormats：TStrings; 
 FFolder：TPath; 
 FItemIndex：Integer; 
模式：TImageGridItems; 
 FMarkerColor：TColor; 
 FMarkerStyle：TPenStyle; 
 FOnClickCell：TImageEvent; 
 FOnDrawCell：TDrawCellEvent; 
 FOnMeasureThumb：TMeasureThumbEvent; 
 FOnProgress：TImageEvent; 
 FOnUnresolved：TImageEvent; 
 FProportional：Boolean; 
 FRetainUnresolvedItems：Boolean; 
 FStretch：Boolean; 
 FThumbsGenerator：TThread; 
 FVirtualMode：Boolean; 
 procedure DeleteUnresolvedItems; 
 procedure FileFormatsChanged（Sender：TObject）; 
函数GetCellHeight：Integer; 
函数GetCellWidth：Integer; 
函数GetCount：Integer; 
函数GetFileNames：TStrings; 
函数GetImage（Index：Integer）：TGraphic; 
函数GetRowCount：Integer; 
函数GetSorted：Boolean; 
函数GetThumb（Index：Integer）：TBitmap; 
函数IsFileNamesStored：Boolean; 
程序ItemsChanged（发件人：TObject）; 
程序ItemsChanging（Sender：TObject）; 
程序重新排列; 
程序SetCellAlignment（Value：TAlignment）; 
程序SetCellHeight（Value：Integer）; 
程序SetCellLayout（Value：TTextLayout）; 
程序SetCellSpacing（Value：Integer）; 
程序SetCellWidth（Value：Integer）; 
程序SetColWidth（Value：Integer）; 
 procedure SetDefaultDrawing（Value：Boolean）; 
程序SetDesignPreview（Value：Boolean）; 
程序SetFileFormats（Value：TStrings）; 
 procedure SetFileNames（Value：TStrings）; 
 procedure SetFolder（Value：TPath）; 
程序SetImage（Index：Integer; Value：TGraphic）; 
过程SetItemIndex（Value：Integer）; 
 procedure SetItems（Value：TImageGridItems）; 
 procedure SetMarkerColor（Value：TColor）; 
程序SetMarkerStyle（Value：TPenStyle）; 
 procedure SetProportional（Value：Boolean）; 
 procedure SetRetainUnresolvedItems（Value：Boolean）; 
 procedure SetSorted（Value：Boolean）; 
 procedure SetStretch（Value：Boolean）; 
程序SetThumb（Index：Integer; Value：TBitmap）; 
过程SetVirtualMode（Value：Boolean）; 
程序TerminateThumbsGenerator; 
 procedure ThumbsUpdated（Sender：TObject）; 
程序UpdateThumbs; 
 procedure WMEraseBkgnd（var Message：TWMEraseBkgnd）;消息WM_ERASEBKGND; 
程序WMGetDlgCode（var Message：TWMGetDlgCode）;消息WM_GETDLGCODE; 
 procedure CMEnter（var Message：TCMEnter）;消息CM_ENTER; 
 procedure CMExit（var Message：TCMExit）;消息CM_EXIT; 
 protected 
 procedure ChangeScale（M，D：Integer）;覆盖
程序DoClickCell（Index：Integer）;虚拟; 
 procedure DoDrawCell（Index，ACol，ARow：Integer; R：TRect）;虚拟; 
 procedure DoMeasureThumb（Index：Integer; var AThumbWidth，
 AThumbHeight：Integer）;虚拟; 
 procedure DoProgress（Index：Integer）;虚拟; 
程序DrawFocusRect;覆盖
 procedure InvalidateItem（Index：Integer）;虚拟; 
程序KeyDown（var Key：Word; Shift：TShiftState）;覆盖
程序加载;覆盖
 procedure MouseDown（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）;覆盖
 procedure MouseUp（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）;覆盖
程序油漆;覆盖
 procedure调整大小;覆盖
程序SetRowHeight（Value：Integer）;覆盖
属性CellAlignment：TAlignment读取FCellAlignment 
写入SetCellAlignment默认taCenter; 
属性CellHeight：整数读取GetCellHeight写SetCellHeight 
默认DefCellHeight; 
 property CellLayout：TTextLayout read FCellLayout write SetCellLayout 
 default tlCenter; 
属性CellSpacing：整数读取FCellSpacing写SetCellSpacing 
默认DefCellSpacing; 
属性CellWidth：整数读取GetCellWidth写SetCellWidth 
默认DefCellWidth; 
属性ColCount：整数读取FColCount; 
属性ColWidth：整数读取FColWidth写入SetColWidth 
默认DefColWidth; 
属性计数：整数读取GetCount; 
属性DefaultDrawing：Boolean读取FDefaultDrawing 
写入SetDefaultDrawing default True; 
属性DesignPreview：Boolean读取FDesignPreview写入SetDesignPreview 
 default False; 
属性FileFormats：TStrings读取FFileFormats写SetFileFormats; 
属性FileNames：TStrings读取GetFileNames写SetFileNames 
存储IsFileNamesStored; 
属性文件夹：TPath读取FFolder写SetFolder; 
属性Images [Index：Integer]：TGraphic读取GetImage写入SetImage; 
属性ItemIndex：整数读取FItemIndex写SetItemIndex default -1; 
属性项目：TImageGridItems读取FItems写入SetItems; 
属性MarkerColor：TColor读取FMarkerColor写SetMarkerColor 
默认clGray; 
属性MarkerStyle：TPenStyle读FMarkerStyle写SetMarkerStyle 
默认psDash; 
属性OnClickCell：TImageEvent读取FOnClickCell写入FOnClickCell; 
属性OnDrawCell：TDrawCellEvent读取FOnDrawCell写入FOnDrawCell; 
属性OnMeasureThumb：TMeasureThumbEvent读取FOnMeasureThumb 
写入FOnMeasureThumb; 
属性OnProgress：TImageEvent读取FOnProgress写入FOnProgress; 
属性OnUnresolved：TImageEvent read FOnUnresolved write FOnUnresolved; 
属性比例：布尔读取FProportional write SetProportional 
 default True; 
属性RetainUnresolvedItems：Boolean读取FRetainUnresolvedItems 
 write SetRetainUnresolvedItems default False; 
属性RowCount：整数读取GetRowCount; 
属性Sorted：Boolean读取GetSorted写SetSorted default False; 
属性Stretch：Boolean读取FStretch写入SetStretch默认值为false; 
属性Thumbs [Index：Integer]：TBitmap读取GetThumb写SetThumb; 
属性VirtualMode：Boolean读取FVirtualMode写入SetVirtualMode 
 default False; 
 public 
构造函数Create（AOwner：TComponent）;覆盖
析构函数覆盖
函数CellRect（Index：Integer）：TRect; 
函数CoordFromIndex（Index：Integer）：TGridCoord; 
程序清除;虚拟; 
 function MouseToIndex（X，Y：Integer）：Integer; 
程序ScrollInView（Index：Integer）; 
程序SetCellSize（ACellWidth，ACellHeight：Integer）; 
程序SetCoordSize（AColWidth，ARowHeight：Integer）; 
属性ParentBackground default False; 
 public 
属性TabStop default True; 
结束
 
 TAwImageGrid = class（TCustomImageGrid）
 public 
属性ColCount; 
属性Count; 
属性图片; 
属性项目; 
属性RowCount; 
属性Thumbs; 
发布
属性对齐; 
属性锚点; 
属性AutoHideScrollBar; 
属性BorderStyle; 
属性BorderWidth; 
属性CellAlignment; 
属性CellHeight; 
属性CellLayout; 
属性CellSpacing; 
属性CellWidth; 
属性ClientHeight; 
属性ClientWidth; 
属性颜色; 
属性ColWidth; 
属性约束; 
属性Ctl3D; 
属性DefaultDrawing; 
属性DesignPreview; 
属性DragCursor; 
属性DragKind; 
属性DragMode; 
属性DragScroll; 
属性启用; 
属性FileFormats; 
属性FileNames; 
属性文件夹; 
属性ItemIndex; 
属性MarkerColor; 
属性MarkerStyle; 
属性OnCanResize; 
属性OnClick; 
属性OnClickCell; 
属性OnConstrainedResize; 
属性OnContextPopup; 
属性OnDblClick; 
属性OnDockDrop; 
属性OnDockOver; 
属性OnDragDrop; 
属性OnDragOver; 
属性OnDrawCell; 
属性OnEndDock; 
属性OnEndDrag; 
属性OnEnter; 
属性OnExit; 
属性OnGetSiteInfo; 
属性OnKeyDown; 
属性OnKeyPress; 
属性OnKeyUp; 
属性OnMeasureThumb; 
属性OnMouseDown; 
属性OnMouseMove; 
属性OnMouseUp; 
属性OnMouseWheel; 
属性OnMouseWheelDown; 
属性OnMouseWheelUp; 
属性OnProgress; 
属性OnResize; 
属性OnStartDock; 
属性OnStartDrag; 
属性OnUnDock; 
属性OnUnresolved; 
属性ParentBackground; 
属性RetainUnresolvedItems; 
属性RowHeight; 
属性ParentColor; 
属性ParentCtl3D; 
属性ParentShowHint; 
属性PopupMenu; 
属性比例; 
属性ShowHint; 
属性排序; 
 property Stretch; 
属性TabOrder; 
属性TabStop; 
属性VirtualMode; 
属性可见; 
属性WheelScrollLines; 
结束
  

I'm trying to find a grid which is especially designed to show images. It needs to have good performance too, and preferably with some sort of thumbnail cache. The images need to be loaded from files, and it would be good if images can be assigned dynamically too. It shouldn't work on a list of col/row records like standard grids, but a single list of items, each item representing an image. There should be a property to define col width and row height for all cols and rows at once, not one at a time. The end goal is to list all images with user options to control how large to display the images. It will be used as a product display, so there needs to be some sort of custom drawing capability too, like an OnDrawItem event. This may display up to 50,000 images in this list, so TListView won't work, as it's very heavy for this.

It needs to work with Delphi 2010, XE2, and preferably 7 too.

Here's 3 examples of how to display 8 images below. I don't mean each image being a different size, but exactly the same size. No 2 columns can have different widths, and same with rows.

解决方案

For the fun of it, I wrote an ImageGrid component for you.

It has only a vertical scroll bar; resizing the width of the control adjusts the column count and row count. The images are cached as resized bitmaps in an internal list, along with their file names.

Because loading and resampling these images may take some time, depending on image count, resolution and whether you want to use the Graphics32 library for better resample quality, the component delegates the loading process to a separate thread, which (re)runs on setting the column width or the row height, and on changing the file names or the folder path in which the component tries to find all images of types to be supplied in the FileFormats property.

Features:

• Creates and resizes image thumbs in a background thread, from file names with the GDI+ library or from manually added images with the Graphics 32 library
• Automatically recognizes all registered image file formats
• Animated scrolling
• Touchscreen support for scrolling by dragging the grid
• Keyboard support for selecting thumbs
• OwnerDraw support, e.g. for adding captions to the thumbs
• Virtual support for bypassing the automatic creation of thumbs

Properties and events:

• ColCount: number of columns, readonly
• Count: number of images, readonly
• Images: list of all manually added images where the thumbs are internally created from
• Items: list of all filename-thumbnail or image-thumbnail combinations
• RowCount: number of rows, readonly
• Thumbs: list of all internally created thumbs
• AutoHideScrollBar: hides the scroll bar when all rows are visible
• BorderStyle: shows or hides themed border
• BorderWidth: margin of the component, outside of the scroll bar
• CellAlignment: alignes thumbs at the left, center or right of the cell
• CellHeight: height of cell
• CellLayout: alignes thumbs at the top, middle or bottom of the cell
• CellSpacing: spacing between the cells
• CellWidth: width of cell
• Color: background color of border and cell spacing
• ColWidth: width of column (equals width of cell plus cell spacing)
• DefaultDrawing: draws all thumbs by default
• DesignPreview: shows thumbs in the designer
• DragScroll: supports scrolling the grid by draging the grid
• FileFormats: image file name extensions by which the file names are filtered
• FileNames: list holding all file names
• Folder: the directory in which the component tries to find all images files
• ItemIndex: selected cell index
• MarkerColor: color of temporarily thumb marker during loading process
• MarkerStyle: style of temporarily thumb marker during loading process
• OnClickCell: fires when a cell is clicked
• OnDrawCell: fires when a cell is drawn
• OnMeasureThumb: fires when the size of a thumb is to be calculated
• OnProgress: fires when an image is resized to thumb format
• OnUnresolved: fires when a thumb cannot be created, e.g. when file name is not found
• RetainUnresolvedItems: keeps empty thumbs in the list
• RowHeight: the row height (equals cell height plus cell spacing)
• ParentBackground: draws the (themed) background of the parent in the border and between the cells
• Proportional: resizes images proportionally
• Sorted: file names are sorted
• Stretch: stretches small images up to the cell size
• VirtualMode: prevents of automatically creating the thumbs
• WheelScrollLines: number of rows to be scrolled with mouse wheel

With thanks to:

• InterfaceLIFT for the images shown in the screenshot above
• How to create a slowing scroll effect on a scrollbox?
• How to get all of the supported file formats from Graphics unit?
• Is it necessary to convert String to WideString?
• Bugfix for BorderWidth > 0 in combination with a scroll bar?

The code is too long to post here, but the OpenSource project is downloadable from the Subversion server here. This is the interface section:

unit AwImageGrid;

interface

{$DEFINE USE_GR32}

uses
  Windows, Classes, SysUtils, Messages, Controls, Graphics, Forms, StdCtrls,
  Grids, GDIPAPI, GDIPOBJ, RTLConsts, Math, Themes
  {$IFDEF USE_GR32}, GR32, GR32_Resamplers {$ENDIF};

const
  DefCellSpacing = 5;
  DefCellWidth = 96;
  DefCellHeight = 60;
  DefColWidth = DefCellWidth + DefCellSpacing;
  DefRowHeight = DefCellHeight + DefCellSpacing;
  MinThumbSize = 4;
  MinCellSize = 8;

type
  PImageGridItem = ^TImageGridItem;
  TImageGridItem = record
    FFileName: TFileName;
    FObject: TObject;
    FImage: TGraphic;
    FThumb: TBitmap;
  end;

  PImageGridItemList = ^TImageGridItemList;
  TImageGridItemList = array[0..MaxListSize div 2] of TImageGridItem;

{ TImageGridItems
  The managing object for holding filename-thumbnail or image-thumbnail
  combinations in an array of TImageGridItem elements. When an item's image
  changes, the item's thumb is freed. When an item's filename changes, then
  the item's thumb is freed only if the item's image is unassigned. }

  TImageGridItems = class(TStrings)
  private
    FCapacity: Integer;
    FChanged: Boolean;
    FCount: Integer;
    FList: PImageGridItemList;
    FOnChanged: TNotifyEvent;
    FOnChanging: TNotifyEvent;
    FOwnsObjects: Boolean;
    FSorted: Boolean;
    procedure ExchangeItems(Index1, Index2: Integer);
    function GetImage(Index: Integer): TGraphic;
    function GetThumb(Index: Integer): TBitmap;
    procedure Grow;
    procedure InsertItem(Index: Integer; const S: String; AObject: TObject;
      AImage: TGraphic; AThumb: TBitmap);
    procedure PutImage(Index: Integer; AImage: TGraphic);
    procedure PutThumb(Index: Integer; AThumb: TBitmap);
    procedure QuickSort(L, R: Integer);
    procedure SetSorted(Value: Boolean);
  protected
    function CompareStrings(const S1, S2: String): Integer; override;
    procedure Changed; virtual;
    procedure Changing; virtual;
    function Get(Index: Integer): String; override;
    function GetCapacity: Integer; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: String); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure PutThumbSilently(Index: Integer; AThumb: TBitmap); virtual;
    procedure SetCapacity(Value: Integer); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    function Add(const S: String): Integer; override;
    function AddImage(const S: String; AImage: TGraphic): Integer; virtual;
    function AddItem(const S: String; AObject: TObject; AImage: TGraphic;
      AThumb: TBitmap): Integer; virtual;
    function AddObject(const S: String; AObject: TObject): Integer; override;
    function AddThumb(const S: String; AThumb: TBitmap): Integer; virtual;
    procedure AddStrings(Strings: TStrings); override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    procedure ClearThumbs; virtual;
    procedure Delete(Index: Integer); override;
    destructor Destroy; override;
    procedure Exchange(Index1, Index2: Integer); override;
    function IndexOf(const S: String): Integer; override;
    procedure Insert(Index: Integer; const S: String); override;
    procedure InsertObject(Index: Integer; const S: String;
      AObject: TObject); override;
    function Find(const S: String; var Index: Integer): Boolean;
    procedure Sort; virtual;
    property FileNames[Index: Integer]: String read Get write Put;
    property Images[Index: Integer]: TGraphic read GetImage write PutImage;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
    property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
    property Sorted: Boolean read FSorted write SetSorted;
    property Thumbs[Index: Integer]: TBitmap read GetThumb write PutThumb;
  end;

{ TBorderControl
  A control with a system drawn border following the current theme, and an
  additional margin as implemented by TWinControl.BorderWidth. }

  TBorderControl = class(TCustomControl)
  private
    FBorderStyle: TBorderStyle;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function TotalBorderWidth: Integer; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle
      default bsSingle;
    property BorderWidth;
  end;

{ TAnimRowScroller
  A scroll box with a vertical scroll bar and vertically stacked items with a
  fixed row height. Scrolling with the scroll bar is animated alike Windows'
  own default list box control. Scrolling is also possible by dragging the
  content with the left mouse button. }

  TAnimRowScroller = class(TBorderControl)
  private
    FAutoHideScrollBar: Boolean;
    FDragScroll: Boolean;
    FDragScrolling: Boolean;
    FDragSpeed: Single;
    FDragStartPos: Integer;
    FPrevScrollPos: Integer;
    FPrevTick: Cardinal;
    FRow: Integer;
    FRowCount: Integer;
    FRowHeight: Integer;
    FScrollingPos: Integer;
    FScrollPos: Integer;
    FWheelScrollLines: Integer;
    procedure Drag;
    function IsWheelScrollLinesStored: Boolean;
    procedure Scroll;
    procedure SetAutoHideScrollBar(Value: Boolean);
    procedure SetRow(Value: Integer);
    procedure SetRowCount(Value: Integer);
    procedure SetScrollPos(Value: Integer; Animate, Snap: Boolean);
    procedure UpdateScrollBar;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  protected
    procedure CreateWnd; override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DrawFocusRect; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
    procedure Resize; override;
    procedure SetRowHeight(Value: Integer); virtual;
    procedure WndProc(var Message: TMessage); override;
    property AutoHideScrollBar: Boolean read FAutoHideScrollBar
      write SetAutoHideScrollBar default True;
    property Row: Integer read FRow write SetRow default -1;
    property RowCount: Integer read FRowCount write SetRowCount;
    property RowHeight: Integer read FRowHeight write SetRowHeight
      default DefRowHeight;
    property DragScroll: Boolean read FDragScroll write FDragScroll
      default True;
    property DragScrolling: Boolean read FDragScrolling;
    property ScrollingPos: Integer read FScrollingPos;
    property WheelScrollLines: Integer read FWheelScrollLines
      write FWheelScrollLines stored IsWheelScrollLinesStored;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseWheelHandler(var Message: TMessage); override;
    function Scrolling: Boolean;
  end;

{ TCustomImageGrid
  The base class of an image grid. It shows images from left to right, then
  from top to bottom. The number of columns is determined by the width of the
  control, possibly resulting in a vertical scroll bar. The coord size is set
  by ColWidth and RowHeight, being the sum of CellWidth resp. CellHeight plus
  CellSpacing. Each cell shows a thumb of the corresponding image. The control
  automatically starts a thumbs generating background thread when an image's
  graphic, filename or its cell size is changed. Before every such change, any
  previously created thread is terminated. Combine multiple changes by calling
  Items.BeginUpdate/Items.EndUpdate to prevent the thread from being recreated
  repeatedly. }

  TCustomImageGrid = class;

  TPath = type String;

  TDrawCellEvent = procedure(Sender: TCustomImageGrid; Index, ACol,
    ARow: Integer; R: TRect) of object;

  TImageEvent = procedure(Sender: TCustomImageGrid; Index: Integer) of object;

  TMeasureThumbEvent = procedure(Sender: TCustomImageGrid; Index: Integer;
    var AThumbWidth, AThumbHeight: Integer) of object;

  TCustomImageGrid = class(TAnimRowScroller)
  private
    FCellAlignment: TAlignment;
    FCellLayout: TTextLayout;
    FCellSpacing: Integer;
    FColCount: Integer;
    FColWidth: Integer;
    FDefaultDrawing: Boolean;
    FDesignPreview: Boolean;
    FFileFormats: TStrings;
    FFolder: TPath;
    FItemIndex: Integer;
    FItems: TImageGridItems;
    FMarkerColor: TColor;
    FMarkerStyle: TPenStyle;
    FOnClickCell: TImageEvent;
    FOnDrawCell: TDrawCellEvent;
    FOnMeasureThumb: TMeasureThumbEvent;
    FOnProgress: TImageEvent;
    FOnUnresolved: TImageEvent;
    FProportional: Boolean;
    FRetainUnresolvedItems: Boolean;
    FStretch: Boolean;
    FThumbsGenerator: TThread;
    FVirtualMode: Boolean;
    procedure DeleteUnresolvedItems;
    procedure FileFormatsChanged(Sender: TObject);
    function GetCellHeight: Integer;
    function GetCellWidth: Integer;
    function GetCount: Integer;
    function GetFileNames: TStrings;
    function GetImage(Index: Integer): TGraphic;
    function GetRowCount: Integer;
    function GetSorted: Boolean;
    function GetThumb(Index: Integer): TBitmap;
    function IsFileNamesStored: Boolean;
    procedure ItemsChanged(Sender: TObject);
    procedure ItemsChanging(Sender: TObject);
    procedure Rearrange;
    procedure SetCellAlignment(Value: TAlignment);
    procedure SetCellHeight(Value: Integer);
    procedure SetCellLayout(Value: TTextLayout);
    procedure SetCellSpacing(Value: Integer);
    procedure SetCellWidth(Value: Integer);
    procedure SetColWidth(Value: Integer);
    procedure SetDefaultDrawing(Value: Boolean);
    procedure SetDesignPreview(Value: Boolean);
    procedure SetFileFormats(Value: TStrings);
    procedure SetFileNames(Value: TStrings);
    procedure SetFolder(Value: TPath);
    procedure SetImage(Index: Integer; Value: TGraphic);
    procedure SetItemIndex(Value: Integer);
    procedure SetItems(Value: TImageGridItems);
    procedure SetMarkerColor(Value: TColor);
    procedure SetMarkerStyle(Value: TPenStyle);
    procedure SetProportional(Value: Boolean);
    procedure SetRetainUnresolvedItems(Value: Boolean);
    procedure SetSorted(Value: Boolean);
    procedure SetStretch(Value: Boolean);
    procedure SetThumb(Index: Integer; Value: TBitmap);
    procedure SetVirtualMode(Value: Boolean);
    procedure TerminateThumbsGenerator;
    procedure ThumbsUpdated(Sender: TObject);
    procedure UpdateThumbs;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
  protected
    procedure ChangeScale(M, D: Integer); override;
    procedure DoClickCell(Index: Integer); virtual;
    procedure DoDrawCell(Index, ACol, ARow: Integer; R: TRect); virtual;
    procedure DoMeasureThumb(Index: Integer; var AThumbWidth,
      AThumbHeight: Integer); virtual;
    procedure DoProgress(Index: Integer); virtual;
    procedure DrawFocusRect; override;
    procedure InvalidateItem(Index: Integer); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer); override;
    procedure Paint; override;
    procedure Resize; override;
    procedure SetRowHeight(Value: Integer); override;
    property CellAlignment: TAlignment read FCellAlignment
      write SetCellAlignment default taCenter;
    property CellHeight: Integer read GetCellHeight write SetCellHeight
      default DefCellHeight;
    property CellLayout: TTextLayout read FCellLayout write SetCellLayout
      default tlCenter;
    property CellSpacing: Integer read FCellSpacing write SetCellSpacing
      default DefCellSpacing;
    property CellWidth: Integer read GetCellWidth write SetCellWidth
      default DefCellWidth;
    property ColCount: Integer read FColCount;
    property ColWidth: Integer read FColWidth write SetColWidth
      default DefColWidth;
    property Count: Integer read GetCount;
    property DefaultDrawing: Boolean read FDefaultDrawing
      write SetDefaultDrawing default True;
    property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
      default False;
    property FileFormats: TStrings read FFileFormats write SetFileFormats;
    property FileNames: TStrings read GetFileNames write SetFileNames
      stored IsFileNamesStored;
    property Folder: TPath read FFolder write SetFolder;
    property Images[Index: Integer]: TGraphic read GetImage write SetImage;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
    property Items: TImageGridItems read FItems write SetItems;
    property MarkerColor: TColor read FMarkerColor write SetMarkerColor
      default clGray;
    property MarkerStyle: TPenStyle read FMarkerStyle write SetMarkerStyle
      default psDash;
    property OnClickCell: TImageEvent read FOnClickCell write FOnClickCell;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
    property OnMeasureThumb: TMeasureThumbEvent read FOnMeasureThumb
      write FOnMeasureThumb;
    property OnProgress: TImageEvent read FOnProgress write FOnProgress;
    property OnUnresolved: TImageEvent read FOnUnresolved write FOnUnresolved;
    property Proportional: Boolean read FProportional write SetProportional
      default True;
    property RetainUnresolvedItems: Boolean read FRetainUnresolvedItems
      write SetRetainUnresolvedItems default False;
    property RowCount: Integer read GetRowCount;
    property Sorted: Boolean read GetSorted write SetSorted default False;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property Thumbs[Index: Integer]: TBitmap read GetThumb write SetThumb;
    property VirtualMode: Boolean read FVirtualMode write SetVirtualMode
      default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CellRect(Index: Integer): TRect;
    function CoordFromIndex(Index: Integer): TGridCoord;
    procedure Clear; virtual;
    function MouseToIndex(X, Y: Integer): Integer;
    procedure ScrollInView(Index: Integer);
    procedure SetCellSize(ACellWidth, ACellHeight: Integer);
    procedure SetCoordSize(AColWidth, ARowHeight: Integer);
    property ParentBackground default False;
  public
    property TabStop default True;
  end;

  TAwImageGrid = class(TCustomImageGrid)
  public
    property ColCount;
    property Count;
    property Images;
    property Items;
    property RowCount;
    property Thumbs;
  published
    property Align;
    property Anchors;
    property AutoHideScrollBar;
    property BorderStyle;
    property BorderWidth;
    property CellAlignment;
    property CellHeight;
    property CellLayout;
    property CellSpacing;
    property CellWidth;
    property ClientHeight;
    property ClientWidth;
    property Color;
    property ColWidth;
    property Constraints;
    property Ctl3D;
    property DefaultDrawing;
    property DesignPreview;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DragScroll;
    property Enabled;
    property FileFormats;
    property FileNames;
    property Folder;
    property ItemIndex;
    property MarkerColor;
    property MarkerStyle;
    property OnCanResize;
    property OnClick;
    property OnClickCell;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawCell;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureThumb;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnProgress;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
    property OnUnresolved;
    property ParentBackground;
    property RetainUnresolvedItems;
    property RowHeight;
    property ParentColor;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property Proportional;
    property ShowHint;
    property Sorted;
    property Stretch;
    property TabOrder;
    property TabStop;
    property VirtualMode;
    property Visible;
    property WheelScrollLines;
  end;

这篇关于寻找自定义图像网格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！