寻找自定义图像网格

时间：2012-01-13 15:58:24

标签： image delphi grid delphi-7 delphi-xe2

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

它需要与Delphi 2010，XE2一起使用，最好也适用于7。

以下是如何在下面显示8张图像的3个示例。我并不是说每个图像的大小不同，但大小完全相同。没有2列可以具有不同的宽度，并且与行相同。

enter image description here

2 个答案:

答案 0 :(得分：23)

为了好玩，我为你写了一个ImageGrid组件。

ImageGrid example

它只有一个垂直滚动条;调整控件宽度的大小可调整列数和行数。图像将作为调整大小的位图缓存在内部列表中，并附带文件名。

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

特点：

  • 在后台线程中创建和调整图像大小，从带有GDI +库的文件名或使用Graphics 32库手动添加的图像
  • 自动识别所有已注册的图像文件格式
  • 动画滚​​动
  • 触摸屏支持通过拖动网格滚动
  • 选择拇指的键盘支持
  • OwnerDraw支持，例如为拇指添加字幕
  • 绕过自动创建拇指的虚拟支持

属性和事件：

  • ColCount：列数，只读
  • Count：图片数量，只读
  • Images：从
    • 内部创建拇指的所有手动添加图像的列表
  • Items：所有文件名缩略图或图片缩略图组合的列表
  • RowCount：行数，只读
  • Thumbs：所有内部创建的拇指列表
  • AutoHideScrollBar：当所有行都可见时隐藏滚动条
  • BorderStyle：显示或隐藏主题边框
  • BorderWidth：组件的边距，位于滚动条之外
  • CellAlignment：在单元格的左侧，中间或右侧对齐拇指
  • CellHeight：单元格高度
  • CellLayout：在单元格的顶部，中间或底部竖起拇指
  • CellSpacing：单元格之间的间距
  • CellWidth：单元格宽度
  • Color：边框和单元格间距的背景颜色
  • ColWidth：列宽（等于单元格宽度加上单元格间距）
  • DefaultDrawing：默认情况下绘制所有大拇指
  • DesignPreview：在设计师中显示大拇指
  • DragScroll：支持通过拖动网格滚动网格
  • FileFormats：过滤文件名的图像文件扩展名
  • FileNames：列出所有文件名
  • Folder：组件尝试查找所有图像文件的目录
  • ItemIndex：选定的单元格索引
  • MarkerColor：加载过程中临时拇指标记的颜色
  • MarkerStyle：加载过程中临时拇指标记的样式
  • OnClickCell：点击单元格时触发
  • OnDrawCell：绘制单元格时触发
  • OnMeasureThumb：在计算拇指大小时触发
  • OnProgress：将图片调整为缩略图格式时触发
  • OnUnresolved：无法创建拇指时触发，例如何时找不到文件名
  • RetainUnresolvedItems：在列表中保留空拇指
  • RowHeight：行高（等于单元格高度加上单元格间距）
  • ParentBackground：在边框和单元格之间绘制父级的（主题）背景
  • Proportional：按比例调整图片大小
  • Sorted：文件名已排序
  • Stretch：将小图片拉伸到单元格大小
  • VirtualMode：阻止自动创建拇指
  • WheelScrollLines：使用鼠标滚轮滚动的行数

感谢：

代码太长，无法在此处发布，但OpenSource项目可从Subversion server here下载。这是界面部分：

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;

答案 1 :(得分：2)

我正在使用ImageEn库中的多图片视图。它可以满足您的所有要求，并且速度非常快。我很高兴。你仍然可以从Torry获得一个与Delphi 7一起使用的较旧的免费版本（我没有在XE2上试过它）。

这些方法并不完全直观，但是一旦掌握了它（包括很好的帮助文件），它就会很好用。

最新版本有更多功能，如果您决定许可它并不昂贵。

您可以在我的应用程序中看到video of ImageEn multi-image view in action。

他们甚至有一个Flow View控件，看起来像Mac上的幻灯片。

相关问题
最新问题