寻找自定义图像网格

Jer*_*dge 10 delphi grid image delphi-7 delphi-xe2

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

它需要使用Delphi 2010,XE2,最好是7.

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

在此输入图像描述

NGL*_*GLN 23

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

ImageGrid示例

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:

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

属性和事件:

  • ColCount:列数,只读
  • Count:图像数量,只读
  • Images:所有手动添加的图像的列表,其中拇指是从内部创建的
  • Items:所有文件名缩略图或图像缩略图组合的列表
  • RowCount:行数,只读
  • Thumbs:所有内部创建的拇指的列表
  • AutoHideScrollBar:当所有行都可见时隐藏滚动条
  • BorderStyle:显示或隐藏主题边框
  • BorderWidth:组件的边距,在滚动条之外
  • CellAlignment:alignes拇指在细胞的左侧,中间或右侧
  • 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服务器下载.这是界面部分:

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;
Run Code Online (Sandbox Code Playgroud)