You've already forked lazarus-ccr
3f5a223715
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7466 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2091 lines
60 KiB
ObjectPascal
2091 lines
60 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvCustomItemViewer.PAS, released on 2003-12-01.
|
|
|
|
The Initial Developer of the Original Code is: Peter Thörnqvist
|
|
All Rights Reserved.
|
|
Lazarus port: Micha³ Gawrycki
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
TODO:
|
|
* keyboard multiselect (ctrl+space)
|
|
* caption editing
|
|
* drag'n'drop insertion mark
|
|
* text for imagelist viewer - DONE
|
|
* text layout support (top, bottom) - DONE
|
|
* drag'n'drop edge scrolling - DONE (almost, needs some tweaks to look good as well)
|
|
* icons don't scale, should be handled differently - DONE (explicitly calls DrawIconEx)
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
unit JvCustomItemViewer;
|
|
|
|
{.$I jvcl.inc}
|
|
{$MODE OBJFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
LMessages, LCLVersion,
|
|
Classes, Graphics, Contnrs, Controls, Forms, ComCtrls,
|
|
ExtCtrls, JvConsts, Types, LCLType;
|
|
|
|
const
|
|
CM_UNSELECTITEMS = WM_USER + 1;
|
|
CM_DELETEITEM = WM_USER + 2;
|
|
|
|
DEFAULT_ITEMVIEWEROPTIONS_WIDTH = 120;
|
|
DEFAULT_ITEMVIEWEROPTIONS_HEIGHT = 120;
|
|
DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING = 4;
|
|
DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING = 4;
|
|
|
|
type
|
|
TJvItemViewerScrollBar = (tvHorizontal, tvVertical);
|
|
TJvCustomItemViewer = class;
|
|
|
|
{ TJvBrushPattern }
|
|
|
|
TJvBrushPattern = class(TPersistent)
|
|
private
|
|
FPattern: TBitmap;
|
|
FOddColor: TColor;
|
|
FEvenColor: TColor;
|
|
FActive: Boolean;
|
|
procedure SetEvenColor(const Value: TColor);
|
|
procedure SetOddColor(const Value: TColor);
|
|
public
|
|
function GetBitmap: TBitmap;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Active: Boolean read FActive write FActive default True;
|
|
property EvenColor: TColor read FEvenColor write SetEvenColor default clWhite;
|
|
property OddColor: TColor read FOddColor write SetOddColor default clSkyBlue;
|
|
end;
|
|
|
|
// Base viewer options class. Derive from this when you need to add your own properties
|
|
// to a viewer or publish the available ones. Declare a new Options property in
|
|
// the viewer class (that only needs to call the inherited Options)
|
|
// and override GetOptionsClass to return the property class type
|
|
TJvCustomItemViewerOptions = class(TPersistent)
|
|
private
|
|
FVertSpacing: Integer;
|
|
FHorzSpacing: Integer;
|
|
FHeight: Integer;
|
|
FWidth: Integer;
|
|
FScrollBar: TJvItemViewerScrollBar;
|
|
FOwner: TJvCustomItemViewer;
|
|
FAutoCenter: Boolean;
|
|
FSmooth: Boolean;
|
|
FTracking: Boolean;
|
|
FHotTrack: Boolean;
|
|
FMultiSelect: Boolean;
|
|
FBrushPattern: TJvBrushPattern;
|
|
FLazyRead: Boolean;
|
|
FAlignment: TAlignment;
|
|
FLayout: TTextLayout;
|
|
FShowCaptions: Boolean;
|
|
FRightClickSelect: Boolean;
|
|
FReduceMemoryUsage: Boolean;
|
|
FDragAutoScroll: Boolean;
|
|
procedure SetRightClickSelect(const Value: Boolean);
|
|
procedure SetShowCaptions(const Value: Boolean);
|
|
procedure SetAlignment(const Value: TAlignment);
|
|
procedure SetLayout(const Value: TTextLayout);
|
|
procedure SetHeight(const Value: Integer);
|
|
procedure SetHorzSpacing(const Value: Integer);
|
|
procedure SetScrollBar(const Value: TJvItemViewerScrollBar);
|
|
procedure SetVertSpacing(const Value: Integer);
|
|
procedure SetWidth(const Value: Integer);
|
|
procedure SetAutoCenter(const Value: Boolean);
|
|
procedure SetSmooth(const Value: Boolean);
|
|
procedure SetTracking(const Value: Boolean);
|
|
procedure SetHotTrack(const Value: Boolean);
|
|
procedure SetMultiSelect(const Value: Boolean);
|
|
procedure SetBrushPattern(const Value: TJvBrushPattern);
|
|
procedure SetLazyRead(const Value: Boolean);
|
|
procedure SetReduceMemoryUsage(const Value: Boolean);
|
|
protected
|
|
procedure Change; virtual;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); virtual;
|
|
public
|
|
constructor Create(AOwner: TJvCustomItemViewer); virtual;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
protected
|
|
property Owner: TJvCustomItemViewer read FOwner;
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
|
property DragAutoScroll: Boolean read FDragAutoScroll write FDragAutoScroll default True;
|
|
property Layout: TTextLayout read FLayout write SetLayout default tlBottom;
|
|
property Width: Integer read FWidth write SetWidth default DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
|
|
property Height: Integer read FHeight write SetHeight default DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
|
|
property VertSpacing: Integer read FVertSpacing write SetVertSpacing default DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
|
|
property HorzSpacing: Integer read FHorzSpacing write SetHorzSpacing default DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
|
|
property ScrollBar: TJvItemViewerScrollBar read FScrollBar write SetScrollBar default tvVertical;
|
|
property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions default True;
|
|
property LazyRead: Boolean read FLazyRead write SetLazyRead default True;
|
|
property ReduceMemoryUsage: Boolean read FReduceMemoryUsage write SetReduceMemoryUsage default False;
|
|
property AutoCenter: Boolean read FAutoCenter write SetAutoCenter default False;
|
|
property Smooth: Boolean read FSmooth write SetSmooth default False;
|
|
property Tracking: Boolean read FTracking write SetTracking default True;
|
|
property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
|
|
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
|
|
property BrushPattern: TJvBrushPattern read FBrushPattern write SetBrushPattern;
|
|
property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect default False;
|
|
end;
|
|
|
|
TJvItemViewerOptionsClass = class of TJvCustomItemViewerOptions;
|
|
|
|
TJvViewerItem = class(TPersistent)
|
|
private
|
|
FOwner: TJvCustomItemViewer;
|
|
FData: Pointer;
|
|
FState: TCustomDrawState;
|
|
FDeleting: Boolean;
|
|
FHint: string;
|
|
procedure SetData(const Value: Pointer);
|
|
procedure SetState(const Value: TCustomDrawState);
|
|
protected
|
|
function Changing: Boolean; virtual;
|
|
procedure Changed; virtual;
|
|
procedure ReduceMemoryUsage; virtual;
|
|
public
|
|
constructor Create(AOwner: TJvCustomItemViewer); virtual;
|
|
procedure Delete;
|
|
protected
|
|
property Deleting: Boolean read FDeleting;
|
|
property Owner: TJvCustomItemViewer read FOwner;
|
|
public
|
|
property State: TCustomDrawState read FState write SetState;
|
|
property Hint: string read FHint write FHint;
|
|
property Data: Pointer read FData write SetData;
|
|
end;
|
|
|
|
TJvViewerItemList = class(TObjectList)
|
|
private
|
|
function GetItem(Index: Integer): TJvViewerItem;
|
|
procedure SetItem(Index: Integer; const Value: TJvViewerItem);
|
|
public
|
|
property Items[Index: Integer]: TJvViewerItem read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TJvViewerItemClass = class of TJvViewerItem;
|
|
|
|
// TODO
|
|
TJvViewerDrawStage = (vdsBeforePaint, vdsAfterPaint);
|
|
TJvViewerAdvancedDrawEvent = procedure(Sender: TObject; Stage: TJvViewerDrawStage;
|
|
Canvas: TCanvas; R: TRect; var DefaultDraw: Boolean) of object;
|
|
TJvViewerAdvancedItemDrawEvent = procedure(Sender: TObject; Stage: TJvViewerDrawStage;
|
|
Index: Integer; State: TCustomDrawState; Canvas: TCanvas; ItemRect, TextRect: TRect;
|
|
var DefaultDraw: Boolean) of object;
|
|
|
|
TJvViewerItemDrawEvent = procedure(Sender: TObject; Index: Integer; State: TCustomDrawState;
|
|
Canvas: TCanvas; ItemRect, TextRect: TRect) of object;
|
|
TJvViewerItemChangingEvent = procedure(Sender: TObject; Item: TJvViewerItem; var Allow: Boolean) of object;
|
|
TJvViewerItemChangedEvent = procedure(Sender: TObject; Item: TJvViewerItem) of object;
|
|
TJvViewerItemHintEvent = procedure(Sender: TObject; Index: Integer;
|
|
var HintInfo: THintInfo; var Handled: Boolean) of object;
|
|
|
|
{ TJvCustomItemViewer }
|
|
|
|
TJvCustomItemViewer = class(TScrollingWinControl)
|
|
private
|
|
//FCanvas: TCanvas;
|
|
FItems: TJvViewerItemList;
|
|
FOptions: TJvCustomItemViewerOptions;
|
|
FTopLeft: TPoint;
|
|
FItemSize: TSize;
|
|
FOnDrawItem: TJvViewerItemDrawEvent;
|
|
FDragImages: TDragImageList;
|
|
FCols, FRows, FTempSelected, FSelectedIndex, FLastHotTrack: Integer;
|
|
//FBorderStyle: TBorderStyle;
|
|
FTopLeftIndex: Integer;
|
|
FBottomRightIndex: Integer;
|
|
FOnScroll: TNotifyEvent;
|
|
FOnOptionsChanged: TNotifyEvent;
|
|
FOnItemChanged: TJvViewerItemChangedEvent;
|
|
FOnItemChanging: TJvViewerItemChangingEvent;
|
|
FScrollTimer: TTimer;
|
|
ScrollEdge: Integer;
|
|
FOnDeletion: TJvViewerItemChangedEvent;
|
|
FOnInsertion: TJvViewerItemChangedEvent;
|
|
FOnItemHint: TJvViewerItemHintEvent;
|
|
procedure DoScrollTimer(Sender: TObject);
|
|
|
|
procedure WMHScroll(var Msg: TLMessage); message LM_HSCROLL;
|
|
procedure WMVScroll(var Msg: TLMessage); message LM_VSCROLL;
|
|
//procedure WMNCPaint(var Messages: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
|
|
procedure WMNCHitTest(var Msg: TLMessage); message LM_NCHITTEST;
|
|
procedure WMCancelMode(var Msg: TLMessage); message LM_CANCELMODE;
|
|
|
|
procedure CMUnselectItem(var Msg: TLMessage); message CM_UNSELECTITEMS;
|
|
procedure CMDeleteItem(var Msg: TLMessage); message CM_DELETEITEM;
|
|
//procedure CMCtl3DChanged(var Msg: TLMessage); message CM_CTL3DCHANGED;
|
|
|
|
procedure SetOptions(const Value: TJvCustomItemViewerOptions);
|
|
function GetItems(Index: Integer): TJvViewerItem;
|
|
procedure SetItems(Index: Integer; const Value: TJvViewerItem);
|
|
procedure SetSelectedIndex(const Value: Integer);
|
|
//procedure SetBorderStyle(const Value: TBorderStyle);
|
|
function GetCount: Integer;
|
|
procedure SetCount(const Value: Integer);
|
|
function GetSelected(Item: TJvViewerItem): Boolean;
|
|
procedure SetSelected(Item: TJvViewerItem; const Value: Boolean);
|
|
procedure StopScrollTimer;
|
|
protected
|
|
FUpdateCount: Integer;
|
|
procedure MouseLeave{(Control: TControl)}; override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
|
|
procedure Loaded; override;
|
|
|
|
//procedure GetDlgCode(var Code: TDlgCodes); override;
|
|
procedure BoundsChanged; override;
|
|
//procedure FocusSet(PrevWnd: THandle); override;
|
|
|
|
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
|
|
procedure DoEndDrag(Sender: TObject; X, Y: Integer); override;
|
|
procedure DragCanceled; override;
|
|
|
|
procedure DoUnSelectItems(ExcludeIndex: Integer);
|
|
procedure ToggleSelection(Index: Integer; SetSelection: Boolean);
|
|
procedure ShiftSelection(Index: Integer; SetSelection: Boolean);
|
|
function FindFirstSelected: Integer;
|
|
function FindLastSelected: Integer;
|
|
procedure UpdateAll;
|
|
procedure UpdateOffset;
|
|
procedure CalcIndices;
|
|
procedure DoReduceMemory;
|
|
|
|
procedure CheckHotTrack;
|
|
procedure InvalidateClipRect(R: TRect);
|
|
function ColRowToIndex(ACol, ARow: Integer): Integer;
|
|
procedure OptionsChanged;
|
|
procedure Changed;
|
|
|
|
function GetTextRect(const S: String; var AItemRect: TRect): TRect; virtual;
|
|
function GetTextHeight: Integer; virtual;
|
|
function GetDragImages: TDragImageList; override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
//procedure PaintWindow(DC: HDC); override;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure IndexToColRow(Index: Integer; out ACol, ARow: Integer);
|
|
procedure DrawItem(Index: Integer; State: TCustomDrawState; ACanvas: TCanvas; AItemRect, TextRect: TRect); virtual;
|
|
function GetItemClass: TJvViewerItemClass; virtual;
|
|
function GetOptionsClass: TJvItemViewerOptionsClass; virtual;
|
|
function GetItemState(Index: Integer): TCustomDrawState; virtual;
|
|
procedure Inserted(Item: TJvViewerItem); virtual;
|
|
procedure Deleted(Item: TJvViewerItem); virtual;
|
|
procedure ItemChanging(Item: TJvViewerItem; var AllowChange: Boolean); virtual;
|
|
procedure ItemChanged(Item: TJvViewerItem); virtual;
|
|
//function HintShow(var HintInfo: {$IFDEF RTL200_UP}Controls.{$ENDIF RTL200_UP}THintInfo): Boolean; override;
|
|
procedure DoOnShowHint(HintInfo: PHintInfo); override;
|
|
function DoItemHint(Index: Integer; var HintInfo: THintInfo): Boolean; virtual;
|
|
procedure CustomSort(Compare:TListSortCompare);virtual;
|
|
|
|
function ClientDisplayRect: TRect;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
|
|
property TopLeftIndex: Integer read FTopLeftIndex;
|
|
property BottomRightIndex: Integer read FBottomRightIndex;
|
|
property UpdateCount: Integer read FUpdateCount;
|
|
|
|
//property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
|
property ParentColor default False;
|
|
property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
|
|
property Selected[Item: TJvViewerItem]: Boolean read GetSelected write SetSelected;
|
|
//property Canvas: TCanvas read FCanvas;
|
|
property Options: TJvCustomItemViewerOptions read FOptions write SetOptions;
|
|
property Count: Integer read GetCount write SetCount;
|
|
property Items[Index: Integer]: TJvViewerItem read GetItems write SetItems;
|
|
property ItemSize: TSize read FItemSize;
|
|
property OnDrawItem: TJvViewerItemDrawEvent read FOnDrawItem write FOnDrawItem;
|
|
property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
|
|
property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged;
|
|
property OnItemChanging: TJvViewerItemChangingEvent read FOnItemChanging write FOnItemChanging;
|
|
property OnItemChanged: TJvViewerItemChangedEvent read FOnItemChanged write FOnItemChanged;
|
|
property OnInsertion: TJvViewerItemChangedEvent read FOnInsertion write FOnInsertion;
|
|
property OnDeletion: TJvViewerItemChangedEvent read FOnDeletion write FOnDeletion;
|
|
property OnItemHint: TJvViewerItemHintEvent read FOnItemHint write FOnItemHint;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ScrollBy(DeltaX, DeltaY: Integer); override;
|
|
procedure ScrollIntoView(Index: Integer);
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
procedure SelectAll;
|
|
procedure SelectItems(StartIndex, EndIndex: Integer; AppendSelection: Boolean);
|
|
procedure UnselectItems(StartIndex, EndIndex: Integer);
|
|
procedure Clear;
|
|
function Add(AItem: TJvViewerItem): Integer;
|
|
procedure Insert(Index: Integer; AItem: TJvViewerItem);
|
|
procedure Delete(Index: Integer);
|
|
function IndexOf(Item: TJvViewerItem): Integer;
|
|
function ItemAtPos(X, Y: Integer; Existing: Boolean): Integer; virtual;
|
|
function ItemRect(Index: Integer; IncludeSpacing: Boolean): TRect;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
property BorderStyle default bsSingle;
|
|
end;
|
|
|
|
// Creates a 8x8 brush pattern with alternate odd and even colors
|
|
// If the pattern already exists, no new pattern is created. Instead, the previous pattern is resued.
|
|
// NB! Do *not* free the returned TBitmap! It is freed when the unit is finalized or when ClearBrushPatterns
|
|
// is called
|
|
function CreateBrushPattern(const EvenColor: TColor = clWhite; const OddColor: TColor = clBtnFace): TBitmap;
|
|
// Decrements the reference count for a particular brush pattern. When the ref
|
|
// count reaches 0, the pattern is released
|
|
procedure ReleasePattern(EvenColor, OddColor: TColor);
|
|
|
|
// Clears the internal list of brush patterns.
|
|
// You don't have to call this procedure unless your program uses a lot of brush patterns
|
|
// that are only used short times
|
|
procedure ClearBrushPatterns;
|
|
|
|
function ViewerDrawText(Canvas: TCanvas; S: String; aLength: Integer;
|
|
var R: TRect; Format: Cardinal; Alignment: TAlignment; Layout: TTextLayout; WordWrap: Boolean): Integer;
|
|
function CenterRect(InnerRect, OuterRect: TRect): TRect;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Math, Themes, LCLIntf,
|
|
JvJCLUtils;
|
|
// JvJVCLUtils, ;
|
|
|
|
const
|
|
cScrollDelay = 400;
|
|
cScrollIntervall = 30;
|
|
|
|
type
|
|
TScrollEdge = (seNone, seLeft, seTop, seRight, seBottom);
|
|
TColorPattern = record
|
|
EvenColor: TColor;
|
|
OddColor: TColor;
|
|
UsageCount: Integer;
|
|
Bitmap: TBitmap;
|
|
end;
|
|
|
|
TViewerDrawImageList = class(TDragImageList)
|
|
protected
|
|
procedure Initialize; override;
|
|
end;
|
|
|
|
var
|
|
GlobalPatterns: array of TColorPattern = nil;
|
|
FirstGlobalPatterns: Boolean = True;
|
|
|
|
procedure ReleasePattern(EvenColor, OddColor: TColor);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Length(GlobalPatterns) - 1 do
|
|
if (GlobalPatterns[I].EvenColor = EvenColor) and (GlobalPatterns[I].OddColor = OddColor) then
|
|
begin
|
|
if GlobalPatterns[I].UsageCount > 0 then
|
|
Dec(GlobalPatterns[I].UsageCount);
|
|
if GlobalPatterns[I].UsageCount = 0 then
|
|
FreeAndNil(GlobalPatterns[I].Bitmap);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure ClearBrushPatterns;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Length(GlobalPatterns) - 1 do
|
|
GlobalPatterns[I].Bitmap.Free;
|
|
SetLength(GlobalPatterns, 0);
|
|
end;
|
|
|
|
function CreateBrushPattern(const EvenColor: TColor = clWhite; const OddColor: TColor = clBtnFace):
|
|
TBitmap;
|
|
var
|
|
I, X, Y: Integer;
|
|
Found: Boolean;
|
|
begin
|
|
Found := False;
|
|
Result := nil;
|
|
for I := 0 to Length(GlobalPatterns) - 1 do
|
|
if (GlobalPatterns[I].EvenColor = EvenColor) and (GlobalPatterns[I].OddColor = OddColor) then
|
|
begin
|
|
Result := GlobalPatterns[I].Bitmap;
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
|
|
if not Found then
|
|
begin
|
|
I := Length(GlobalPatterns);
|
|
if FirstGlobalPatterns then
|
|
FirstGlobalPatterns := False;
|
|
SetLength(GlobalPatterns, I + 1);
|
|
end;
|
|
if Result = nil then
|
|
begin
|
|
Result := TBitmap.Create;
|
|
//Result.Dormant; // preserve some DDB handles, use more memory
|
|
Result.Width := 8; { must have this size }
|
|
Result.Height := 8;
|
|
with Result.Canvas do
|
|
begin
|
|
Brush.Style := bsSolid;
|
|
Brush.Color := EvenColor;
|
|
FillRect(Rect(0, 0, Result.Width, Result.Height));
|
|
for Y := 0 to 7 do
|
|
for X := 0 to 7 do
|
|
if (Y mod 2) = (X mod 2) then { toggles between even/odd pixles }
|
|
Pixels[X, Y] := OddColor; { on even/odd rows }
|
|
end;
|
|
GlobalPatterns[I].EvenColor := EvenColor;
|
|
GlobalPatterns[I].OddColor := OddColor;
|
|
GlobalPatterns[I].Bitmap := Result;
|
|
end;
|
|
Inc(GlobalPatterns[I].UsageCount);
|
|
end;
|
|
|
|
function ViewerDrawText(Canvas: TCanvas; S: String; aLength: Integer;
|
|
var R: TRect; Format: Cardinal; Alignment: TAlignment; Layout: TTextLayout; WordWrap: Boolean): Integer;
|
|
const
|
|
Alignments: array [TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
|
Layouts: array [TTextLayout] of Cardinal = (DT_TOP, DT_VCENTER, DT_BOTTOM);
|
|
WordWraps: array [Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK);
|
|
var
|
|
Flags: Cardinal;
|
|
begin
|
|
Flags := Format or Alignments[Alignment] or Layouts[Layout] or WordWraps[WordWrap];
|
|
// (p3) Do we need BiDi support here?
|
|
//if Win32Platform = VER_PLATFORM_WIN32_NT then
|
|
// Result := DrawTextW(Canvas, PWideChar(S), aLength, R, Flags)
|
|
//else
|
|
Result := LCLIntf.DrawText(Canvas.Handle, PChar(S), aLength, R, Flags);
|
|
end;
|
|
|
|
function CenterRect(InnerRect, OuterRect: TRect): TRect;
|
|
begin
|
|
OffsetRect(InnerRect, -InnerRect.Left + OuterRect.Left + (RectWidth(OuterRect) - RectWidth(InnerRect)) div 2,
|
|
-InnerRect.Top + OuterRect.Top + (RectHeight(OuterRect) - RectHeight(InnerRect)) div 2);
|
|
Result := InnerRect;
|
|
end;
|
|
|
|
//=== { TJvBrushPattern } ====================================================
|
|
|
|
constructor TJvBrushPattern.Create;
|
|
begin
|
|
inherited Create;
|
|
FEvenColor := clWhite;
|
|
FOddColor := clSkyBlue;
|
|
FActive := True;
|
|
end;
|
|
|
|
destructor TJvBrushPattern.Destroy;
|
|
begin
|
|
if FPattern <> nil then
|
|
ReleasePattern(EvenColor, OddColor);
|
|
FPattern := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvBrushPattern.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
if Source is TJvBrushPattern then
|
|
begin
|
|
EvenColor := TJvBrushPattern(Source).EvenColor;
|
|
OddColor := TJvBrushPattern(Source).OddColor;
|
|
Active := TJvBrushPattern(Source).Active;
|
|
end;
|
|
end;
|
|
|
|
function TJvBrushPattern.GetBitmap: TBitmap;
|
|
begin
|
|
if Active then
|
|
begin
|
|
if FPattern = nil then
|
|
FPattern := CreateBrushPattern(EvenColor, OddColor);
|
|
end
|
|
else
|
|
begin
|
|
if FPattern <> nil then
|
|
ReleasePattern(EvenColor, OddColor);
|
|
FPattern := nil;
|
|
end;
|
|
Result := FPattern;
|
|
end;
|
|
|
|
procedure TJvBrushPattern.SetEvenColor(const Value: TColor);
|
|
begin
|
|
if FEvenColor <> Value then
|
|
begin
|
|
if FPattern <> nil then
|
|
ReleasePattern(EvenColor, OddColor);
|
|
FEvenColor := Value;
|
|
FPattern := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBrushPattern.SetOddColor(const Value: TColor);
|
|
begin
|
|
if FOddColor <> Value then
|
|
begin
|
|
if FPattern <> nil then
|
|
ReleasePattern(EvenColor, OddColor);
|
|
FOddColor := Value;
|
|
FPattern := nil;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvCustomItemViewerOptions } =========================================
|
|
|
|
constructor TJvCustomItemViewerOptions.Create(AOwner: TJvCustomItemViewer);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FWidth := DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
|
|
FHeight := DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
|
|
FVertSpacing := DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
|
|
FHorzSpacing := DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING;
|
|
FScrollBar := tvVertical;
|
|
FSmooth := False;
|
|
FTracking := True;
|
|
FLazyRead := True;
|
|
FShowCaptions := False;
|
|
FAlignment := taCenter;
|
|
FLayout := tlBottom;
|
|
FDragAutoScroll := True;
|
|
FBrushPattern := TJvBrushPattern.Create;
|
|
end;
|
|
|
|
destructor TJvCustomItemViewerOptions.Destroy;
|
|
begin
|
|
FBrushPattern.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvCustomItemViewerOptions then
|
|
begin
|
|
if Source <> Self then
|
|
begin
|
|
FWidth := TJvCustomItemViewerOptions(Source).Width;
|
|
FHeight := TJvCustomItemViewerOptions(Source).Height;
|
|
FVertSpacing := TJvCustomItemViewerOptions(Source).VertSpacing;
|
|
FHorzSpacing := TJvCustomItemViewerOptions(Source).HorzSpacing;
|
|
FScrollBar := TJvCustomItemViewerOptions(Source).ScrollBar;
|
|
FAutoCenter := TJvCustomItemViewerOptions(Source).AutoCenter;
|
|
FSmooth := TJvCustomItemViewerOptions(Source).Smooth;
|
|
FTracking := TJvCustomItemViewerOptions(Source).Tracking;
|
|
FHotTrack := TJvCustomItemViewerOptions(Source).HotTrack;
|
|
FMultiSelect := TJvCustomItemViewerOptions(Source).MultiSelect;
|
|
BrushPattern.FEvenColor := BrushPattern.EvenColor;
|
|
BrushPattern.FOddColor := BrushPattern.OddColor;
|
|
BrushPattern.FActive := BrushPattern.Active;
|
|
Change;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.Change;
|
|
begin
|
|
if FOwner <> nil then
|
|
FOwner.OptionsChanged;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.DoAutoAdjustLayout(
|
|
const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double);
|
|
begin
|
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
|
begin
|
|
FWidth := Round(FWidth * AXProportion);
|
|
FHeight := Round(FHeight * AYProportion);
|
|
FHorzSpacing := Round(FHorzSpacing * AXProportion);
|
|
FVertSpacing := Round(FVertSpacing * AYProportion);
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetAlignment(const Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
if ShowCaptions then
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetAutoCenter(const Value: Boolean);
|
|
begin
|
|
if FAutoCenter <> Value then
|
|
begin
|
|
FAutoCenter := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetBrushPattern(const Value: TJvBrushPattern);
|
|
begin
|
|
FBrushPattern.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetHeight(const Value: Integer);
|
|
begin
|
|
if FHeight <> Value then
|
|
begin
|
|
FHeight := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetHorzSpacing(const Value: Integer);
|
|
begin
|
|
if FHorzSpacing <> Value then
|
|
begin
|
|
FHorzSpacing := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetHotTrack(const Value: Boolean);
|
|
begin
|
|
if FHotTrack <> Value then
|
|
begin
|
|
FHotTrack := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetLayout(const Value: TTextLayout);
|
|
begin
|
|
if FLayout <> Value then
|
|
begin
|
|
FLayout := Value;
|
|
if ShowCaptions then
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetLazyRead(const Value: Boolean);
|
|
begin
|
|
if LazyRead <> Value then
|
|
begin
|
|
FLazyRead := Value;
|
|
if not FLazyRead then
|
|
FReduceMemoryUsage := False;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetMultiSelect(const Value: Boolean);
|
|
begin
|
|
if FMultiSelect <> Value then
|
|
begin
|
|
FMultiSelect := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetReduceMemoryUsage(const Value: Boolean);
|
|
begin
|
|
if FReduceMemoryUsage <> Value then
|
|
begin
|
|
FReduceMemoryUsage := Value;
|
|
if FReduceMemoryUsage then
|
|
begin
|
|
FLazyRead := True;
|
|
FOwner.DoReduceMemory;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetRightClickSelect(const Value: Boolean);
|
|
begin
|
|
FRightClickSelect := Value;
|
|
// no need to tell owner
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetScrollBar(const Value: TJvItemViewerScrollBar);
|
|
begin
|
|
if FScrollBar <> Value then
|
|
begin
|
|
FScrollBar := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetShowCaptions(const Value: Boolean);
|
|
begin
|
|
if FShowCaptions <> Value then
|
|
begin
|
|
FShowCaptions := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetSmooth(const Value: Boolean);
|
|
begin
|
|
if FSmooth <> Value then
|
|
begin
|
|
FSmooth := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetTracking(const Value: Boolean);
|
|
begin
|
|
if FTracking <> Value then
|
|
begin
|
|
FTracking := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetVertSpacing(const Value: Integer);
|
|
begin
|
|
if FVertSpacing <> Value then
|
|
begin
|
|
FVertSpacing := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewerOptions.SetWidth(const Value: Integer);
|
|
begin
|
|
if FWidth <> Value then
|
|
begin
|
|
FWidth := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvViewerItem } ======================================================
|
|
|
|
constructor TJvViewerItem.Create(AOwner: TJvCustomItemViewer);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
procedure TJvViewerItem.Changed;
|
|
begin
|
|
if FOwner <> nil then
|
|
FOwner.ItemChanged(Self);
|
|
end;
|
|
|
|
function TJvViewerItem.Changing: Boolean;
|
|
begin
|
|
Result := True;
|
|
if FOwner <> nil then
|
|
FOwner.ItemChanging(Self, Result);
|
|
end;
|
|
|
|
procedure TJvViewerItem.Delete;
|
|
begin
|
|
if FOwner <> nil then
|
|
begin
|
|
FDeleting := True;
|
|
PostMessage(FOwner.Handle, CM_DELETEITEM, WPARAM(Self), 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvViewerItem.ReduceMemoryUsage;
|
|
begin
|
|
// override to perform whatever you can to reduce the memory usage
|
|
end;
|
|
|
|
procedure TJvViewerItem.SetData(const Value: Pointer);
|
|
begin
|
|
if (FData <> Value) and Changing then
|
|
begin
|
|
FData := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvViewerItem.SetState(const Value: TCustomDrawState);
|
|
begin
|
|
if (FState <> Value) and Changing then
|
|
begin
|
|
FState := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvCustomItemViewer } ================================================
|
|
|
|
constructor TJvCustomItemViewer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ParentColor := False;
|
|
ControlStyle := [csCaptureMouse, csDisplayDragImage, csClickEvents, csOpaque, csDoubleClicks];
|
|
FItems := TJvViewerItemList.Create;
|
|
FOptions := GetOptionsClass.Create(Self);
|
|
//FCanvas := TControlCanvas.Create;
|
|
//TControlCanvas(FCanvas).Control := Self;
|
|
FSelectedIndex := -1;
|
|
FLastHotTrack := -1;
|
|
AutoScroll := False;
|
|
HorzScrollBar.Smooth := Options.Smooth;
|
|
HorzScrollBar.Tracking := Options.Tracking;
|
|
VertScrollBar.Smooth := Options.Smooth;
|
|
VertScrollBar.Tracking := Options.Tracking;
|
|
DoubleBuffered := True;
|
|
BorderStyle := bsSingle;
|
|
TabStop := True;
|
|
end;
|
|
|
|
destructor TJvCustomItemViewer.Destroy;
|
|
begin
|
|
StopScrollTimer;
|
|
Clear;
|
|
FItems.Free;
|
|
FOptions.Free;
|
|
inherited Destroy;
|
|
// (rom) destroy Canvas always after inherited
|
|
//FreeAndNil(FCanvas);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.Add(AItem: TJvViewerItem): Integer;
|
|
begin
|
|
Insert(FItems.Count, AItem);
|
|
Result := FItems.Count - 1;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.CalcIndices;
|
|
begin
|
|
FTopLeftIndex := ItemAtPos(0, 0, True);
|
|
FBottomRightIndex := ItemAtPos(ClientWidth, ClientHeight, True);
|
|
if FBottomRightIndex < 0 then
|
|
FBottomRightIndex := ItemAtPos(ClientWidth, ClientHeight, False) - 1;
|
|
if FTopLeftIndex < 0 then
|
|
FTopLeftIndex := 0;
|
|
if FTopLeftIndex >= Count then
|
|
FTopLeftIndex := Count - 1;
|
|
if FBottomRightIndex < 0 then
|
|
FBottomRightIndex := 0;
|
|
if FBottomRightIndex >= Count then
|
|
FBottomRightIndex := Count - 1;
|
|
DoReduceMemory;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoAutoAdjustLayout(
|
|
const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double);
|
|
begin
|
|
inherited;
|
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
|
begin
|
|
FOptions.DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
|
|
end;
|
|
end;
|
|
|
|
class function TJvCustomItemViewer.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 200; //185;
|
|
Result.CY := 200; //150;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.OptionsChanged;
|
|
begin
|
|
Changed;
|
|
if Assigned(FOnOptionsChanged) then
|
|
FOnOptionsChanged(Self);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.CheckHotTrack;
|
|
var
|
|
P: TPoint = (X:0; Y:0);
|
|
I: Integer;
|
|
begin
|
|
if Options.HotTrack and GetCursorPos(P) then
|
|
begin
|
|
P := ScreenToClient(P);
|
|
if not PtInRect(ClientRect, P) then
|
|
I := -1
|
|
else
|
|
I := ItemAtPos(P.X, P.Y, True);
|
|
// remove hot track state from previous item
|
|
if (FLastHotTrack >= 0) and (FLastHotTrack < Count) and (I <> FLastHotTrack) then
|
|
Items[FLastHotTrack].State := Items[FLastHotTrack].State - [cdsHot];
|
|
if (I >= 0) and (I < Count) then
|
|
begin
|
|
Items[I].State := Items[I].State + [cdsHot];
|
|
FLastHotTrack := I;
|
|
end
|
|
else
|
|
FLastHotTrack := -1;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Clear;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
FItems.Clear;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
//procedure TJvCustomItemViewer.CMCtl3DChanged(var Msg: TLMessage);
|
|
//begin
|
|
// if FBorderStyle = bsSingle then
|
|
// RecreateWnd(Self);
|
|
// inherited;
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.CMDeleteItem(var Msg: TLMessage);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := FItems.IndexOf(TObject(Msg.WParam));
|
|
if (I >= 0) and (I < Count) then
|
|
begin
|
|
Delete(I);
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.MouseLeave{(Control: TControl)};
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
inherited MouseLeave{(Control)};
|
|
CheckHotTrack;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.CMUnselectItem(var Msg: TLMessage);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Msg.WParam = WPARAM(Self) then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to Count - 1 do
|
|
if (PtrInt(Items[I]) <> Msg.LParam) and
|
|
(cdsSelected in Items[I].State) then
|
|
Items[I].State := Items[I].State - [cdsSelected];
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.ColRowToIndex(ACol, ARow: Integer): Integer;
|
|
begin
|
|
Result := ACol + ARow * FCols
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.CreateParams(var Params: TCreateParams);
|
|
//const
|
|
// BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
//with Params do
|
|
//begin
|
|
// Style := Style or BorderStyles[BorderStyle];
|
|
// //if Ctl3D and (BorderStyle = bsSingle) then
|
|
// //begin
|
|
// // Style := Style and not WS_BORDER;
|
|
// // ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
// //end;
|
|
//end;
|
|
with Params.WindowClass do
|
|
Style := Style or (CS_HREDRAW or CS_VREDRAW); { or CS_SAVEBITS}
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Delete(Index: Integer);
|
|
begin
|
|
Deleted(Items[Index]);
|
|
FItems.Delete(Index);
|
|
if SelectedIndex >= Count then
|
|
SelectedIndex := Count - 1;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.DoMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
|
var
|
|
WD: Integer;
|
|
begin
|
|
if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then
|
|
begin
|
|
if Shift * KeyboardShiftStates = [ssShift] then
|
|
WD := WheelDelta * 3
|
|
else
|
|
WD := WheelDelta;
|
|
if Options.ScrollBar = tvHorizontal then
|
|
HorzScrollBar.Position := HorzScrollBar.Position - WD
|
|
else
|
|
VertScrollBar.Position := VertScrollBar.Position - WD;
|
|
UpdateOffset;
|
|
Invalidate;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoReduceMemory;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Options.ReduceMemoryUsage then
|
|
begin
|
|
for I := 0 to FTopLeftIndex - 1 do
|
|
if FItems[I] <> nil then
|
|
Items[I].ReduceMemoryUsage;
|
|
for I := FBottomRightIndex + 1 to Count - 1 do
|
|
if FItems[I] <> nil then
|
|
Items[I].ReduceMemoryUsage;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DrawItem(Index: Integer; State: TCustomDrawState;
|
|
ACanvas: TCanvas; AItemRect, TextRect: TRect);
|
|
begin
|
|
if Assigned(FOnDrawItem) then
|
|
FOnDrawItem(Self, Index, State, ACanvas, AItemRect, TextRect);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount <= 0 then
|
|
begin
|
|
FUpdateCount := 0;
|
|
UpdateAll;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.FindFirstSelected: Integer;
|
|
begin
|
|
for Result := 0 to Count - 1 do
|
|
if cdsSelected in Items[Result].State then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.FindLastSelected: Integer;
|
|
begin
|
|
for Result := Count - 1 downto 0 do
|
|
if cdsSelected in Items[Result].State then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetDragImages: TDragImageList;
|
|
var
|
|
B: TBitmap;
|
|
P: TPoint = (X:0; Y:0);
|
|
I: Integer;
|
|
AItemRect, TextRect: TRect;
|
|
begin
|
|
GetCursorPos(P);
|
|
P := ScreenToClient(P);
|
|
I := ItemAtPos(P.X, P.Y, True);
|
|
// create an image of the currently selected item
|
|
if I >= 0 then
|
|
begin
|
|
if FDragImages = nil then
|
|
FDragImages := TViewerDrawImageList.Create(Self);
|
|
FDragImages.Clear;
|
|
AItemRect := Rect(0, 0, ItemSize.cx, ItemSize.cy);
|
|
InflateRect(AItemRect, -Options.HorzSpacing, -Options.VertSpacing);
|
|
B := TBitmap.Create;
|
|
try
|
|
B.Width := ItemSize.cx;
|
|
B.Height := ItemSize.cy;
|
|
if Options.ShowCaptions then
|
|
TextRect := GetTextRect('Wg', AItemRect)
|
|
else
|
|
TextRect := Rect(0, 0, 0, 0);
|
|
DrawItem(I, Items[I].State + [cdsSelected, cdsFocused, cdsHot], B.Canvas, AItemRect, TextRect);
|
|
FDragImages.Width := ItemSize.cx;
|
|
FDragImages.Height := ItemSize.cy;
|
|
FDragImages.AddMasked(B, B.TransparentColor);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
// FDragImages.SetDragImage(0, 0, 0);
|
|
AItemRect := Self.ItemRect(I, True);
|
|
FDragImages.SetDragImage(0, P.X - AItemRect.Left, P.Y - AItemRect.Top);
|
|
Result := FDragImages;
|
|
SelectedIndex := I;
|
|
Paint;
|
|
end
|
|
else
|
|
Result := inherited GetDragImages;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetItemClass: TJvViewerItemClass;
|
|
begin
|
|
Result := TJvViewerItem;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetItems(Index: Integer): TJvViewerItem;
|
|
begin
|
|
Result := FItems[Index];
|
|
if Result = nil then
|
|
begin
|
|
Result := GetItemClass.Create(Self);
|
|
FItems[Index] := Result;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetItemState(Index: Integer): TCustomDrawState;
|
|
begin
|
|
// (p3) safer than calling Items[Index].State directly
|
|
if (Index >= 0) and (Index < Count) then
|
|
Result := Items[Index].State
|
|
else
|
|
Result := [];
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetOptionsClass: TJvItemViewerOptionsClass;
|
|
begin
|
|
Result := TJvCustomItemViewerOptions;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetSelected(Item: TJvViewerItem): Boolean;
|
|
begin
|
|
Result := (Item <> nil) and (cdsSelected in Item.State);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetTextHeight: Integer;
|
|
var
|
|
R: TRect;
|
|
S: String;
|
|
begin
|
|
S := 'Wg';
|
|
R := Rect(0, 0, 100, 100);
|
|
Result := ViewerDrawText(Canvas, S, Length(S),
|
|
R, DT_END_ELLIPSIS or DT_CALCRECT, taCenter, tlTop, False) + 4;
|
|
// Result := Canvas.TextHeight('Wg');
|
|
end;
|
|
|
|
function TJvCustomItemViewer.GetTextRect(const S: String; var AItemRect: TRect): TRect;
|
|
var
|
|
TextHeight: Integer;
|
|
begin
|
|
TextHeight := GetTextHeight;
|
|
|
|
case Options.Layout of
|
|
tlTop:
|
|
begin
|
|
Result := Rect(AItemRect.Left, AItemRect.Top, AItemRect.Right, AItemRect.Top + TextHeight);
|
|
AItemRect.Top := Result.Top + TextHeight;
|
|
end;
|
|
tlBottom:
|
|
begin
|
|
Result := Rect(AItemRect.Left, AItemRect.Bottom - TextHeight,
|
|
AItemRect.Right, AItemRect.Bottom);
|
|
AItemRect.Bottom := Result.Top;
|
|
end;
|
|
tlCenter:
|
|
begin
|
|
Result := Rect(AItemRect.Left, AItemRect.Top + (RectHeight(AItemRect) - TextHeight) div 2 + 1,
|
|
AItemRect.Right, 0);
|
|
Result.Bottom := Result.Top + TextHeight;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomItemViewer.IndexOf(Item: TJvViewerItem): Integer;
|
|
begin
|
|
// (p3) need to do it like this because items aren't created until Items[] is called
|
|
for Result := 0 to Count - 1 do
|
|
if Items[Result] = Item then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.IndexToColRow(Index: Integer; out ACol, ARow: Integer);
|
|
begin
|
|
Assert(FCols > 0);
|
|
ACol := Index mod FCols;
|
|
ARow := Index div FCols;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Insert(Index: Integer; AItem: TJvViewerItem);
|
|
begin
|
|
Assert(AItem is GetItemClass);
|
|
FItems.Insert(Index,AItem);
|
|
Inserted(AItem);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.InvalidateClipRect(R: TRect);
|
|
begin
|
|
if IsRectEmpty(R) then
|
|
R := ClientDisplayRect;
|
|
LCLIntf.InvalidateRect(Handle, @R, True);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.ItemAtPos(X, Y: Integer; Existing: Boolean): Integer;
|
|
var
|
|
ARow, ACol: Integer;
|
|
begin
|
|
Result := -1;
|
|
if (FItemSize.cx < 1) or (FItemSize.cy < 1) then
|
|
Exit;
|
|
Dec(X, FTopLeft.X);
|
|
Dec(Y, FTopLeft.Y);
|
|
ACol := X div FItemSize.cx;
|
|
ARow := Y div FItemSize.cy;
|
|
if ((ACol < 0) or (ARow < 0) or (ACol >= FCols) or (ARow >= FRows)) and Existing then
|
|
Exit;
|
|
Result := ColRowToIndex(ACol, ARow);
|
|
if (Result >= Count) and Existing then
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.ItemChanged(Item: TJvViewerItem);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FUpdateCount <> 0 then
|
|
Exit;
|
|
if not HandleAllocated then
|
|
Exit;
|
|
if (Item <> nil) then
|
|
begin
|
|
I := FItems.IndexOf(Item);
|
|
if I > -1 then
|
|
begin
|
|
if (cdsSelected in Item.State) and not Options.MultiSelect then
|
|
FSelectedIndex := I;
|
|
InvalidateClipRect(ItemRect(I, True));
|
|
end;
|
|
end
|
|
else
|
|
Changed;
|
|
if Assigned(FOnItemChanged) then
|
|
FOnItemChanged(Self, Item);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoOnShowHint(HintInfo: PHintInfo);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := ItemAtPos(HintInfo^.CursorPos.X, HintInfo^.CursorPos.Y, True);
|
|
if I >= 0 then
|
|
begin
|
|
HintInfo^.HintStr := Items[I].Hint;
|
|
HintInfo^.CursorRect := ItemRect(I, True);
|
|
DoItemHint(I, HintInfo^);
|
|
end;
|
|
if HintInfo^.HintStr = '' then
|
|
HintInfo^.HintStr := Hint;
|
|
inherited DoOnShowHint(HintInfo);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.ItemChanging(Item: TJvViewerItem;
|
|
var AllowChange: Boolean);
|
|
begin
|
|
AllowChange := True;
|
|
if Assigned(FOnItemChanging) then
|
|
FOnItemChanging(Self, Item, AllowChange);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.ItemRect(Index: Integer; IncludeSpacing: Boolean): TRect;
|
|
var
|
|
ACol, ARow: Integer;
|
|
begin
|
|
IndexToColRow(Index, ACol, ARow);
|
|
if (Index < 0) or (Index >= Count) then
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
Exit;
|
|
end;
|
|
Result := Rect(0, 0, FItemSize.cx, FItemSize.cy);
|
|
OffsetRect(Result, {FTopLeft.X +} FItemSize.cx * ACol,
|
|
{FTopLeft.Y +} FItemSize.cy * ARow);
|
|
if not IncludeSpacing then
|
|
InflateRect(Result, -Options.HorzSpacing, -Options.VertSpacing);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
LIndex: Integer;
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
LIndex := -1;
|
|
if Focused and (Shift * KeyboardShiftStates = []) then
|
|
case Key of
|
|
VK_UP:
|
|
LIndex := SelectedIndex - FCols;
|
|
VK_DOWN:
|
|
LIndex := SelectedIndex + FCols;
|
|
VK_LEFT:
|
|
LIndex := SelectedIndex - 1;
|
|
VK_RIGHT:
|
|
LIndex := SelectedIndex + 1;
|
|
VK_SPACE:
|
|
Click;
|
|
end;
|
|
if (LIndex >= 0) and (LIndex < Count) then
|
|
begin
|
|
if Options.MultiSelect then
|
|
DoUnSelectItems(LIndex);
|
|
SelectedIndex := LIndex;
|
|
ScrollIntoView(LIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
CheckHotTrack;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Paint;
|
|
var
|
|
I: Integer;
|
|
AItemRect, TextRect, AClientRect: TRect;
|
|
|
|
function IsRectVisible(const R, TR: TRect): Boolean;
|
|
begin
|
|
Result := (R.Top + FTopLeft.Y < AClientRect.Bottom) and (R.Bottom + FTopLeft.Y + TR.Height > AClientRect.Top) and
|
|
(R.Left + FTopLeft.X < AClientRect.Right) and (R.Right + FTopLeft.X > AClientRect.Left)
|
|
end;
|
|
|
|
begin
|
|
inherited Paint;
|
|
if FUpdateCount <> 0 then
|
|
Exit;
|
|
AClientRect := ClientRect;
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.Pen.Color := Font.Color;
|
|
Canvas.Font := Font;
|
|
// Canvas.FillRect(Canvas.ClipRect);
|
|
if (FUpdateCount <> 0) or (Count = 0) or
|
|
(ClientWidth <= 0) or (ClientHeight <= 0) or
|
|
(FItemSize.cx <= 0) or (FItemSize.cy <= 0) then
|
|
Exit;
|
|
AItemRect := Rect(0, 0, ItemSize.cx, ItemSize.cy);
|
|
InflateRect(AItemRect, -Options.HorzSpacing, -Options.VertSpacing);
|
|
if Options.ShowCaptions then
|
|
begin
|
|
TextRect := GetTextRect('Wg', AItemRect);
|
|
//OffsetRect(TextRect, FTopLeft.X, FTopLeft.Y);
|
|
end
|
|
else
|
|
TextRect := Rect(0, 0, 0, 0);
|
|
//OffsetRect(AItemRect, FTopLeft.X, FTopLeft.Y);
|
|
// Canvas.FillRect(Rect(Left, Top, Width, Height));
|
|
for I := 0 to Count - 1 do
|
|
if not Items[I].Deleting then
|
|
begin
|
|
if not Options.LazyRead or IsRectVisible(AItemRect, TextRect) then
|
|
DrawItem(I, GetItemState(I), Canvas, AItemRect, TextRect);
|
|
if (I + 1) mod FCols = 0 then
|
|
begin
|
|
OffsetRect(AItemRect, -AItemRect.Left + Options.HorzSpacing {+ FTopLeft.X}, ItemSize.cy);
|
|
if Options.ShowCaptions then
|
|
OffsetRect(TextRect, -TextRect.Left + Options.HorzSpacing {+ FTopLeft.X}, ItemSize.cy);
|
|
end
|
|
else
|
|
begin
|
|
OffsetRect(AItemRect, ItemSize.cx, 0);
|
|
if Options.ShowCaptions then
|
|
OffsetRect(TextRect, ItemSize.cx, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//procedure TJvCustomItemViewer.PaintWindow(DC: HDC);
|
|
//begin
|
|
// if FUpdateCount <> 0 then Exit;
|
|
// FCanvas.Lock;
|
|
// try
|
|
// FCanvas.Handle := DC;
|
|
// try
|
|
// TControlCanvas(FCanvas).UpdateTextFlags;
|
|
// Paint;
|
|
// finally
|
|
// FCanvas.Handle := 0;
|
|
// end;
|
|
// finally
|
|
// FCanvas.Unlock;
|
|
// end;
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.ScrollIntoView(Index: Integer);
|
|
var
|
|
Rect: TRect;
|
|
begin
|
|
Rect := ItemRect(Index, True);
|
|
//Dec(Rect.Left, HorzScrollBar.Margin);
|
|
//Inc(Rect.Right, HorzScrollBar.Margin);
|
|
//Dec(Rect.Top, VertScrollBar.Margin);
|
|
//Inc(Rect.Bottom, VertScrollBar.Margin);
|
|
if Rect.Left < HorzScrollBar.Position then
|
|
with HorzScrollBar do
|
|
Position := {Position +} Rect.Left
|
|
else
|
|
if Rect.Right > HorzScrollBar.Position + ClientWidth then
|
|
begin
|
|
//if Rect.Right - Rect.Left > ClientWidth then
|
|
// Rect.Right := Rect.Left + ClientWidth;
|
|
with HorzScrollBar do
|
|
Position := {Position +} Rect.Right - ClientWidth;
|
|
end;
|
|
if Rect.Top < VertScrollBar.Position then
|
|
VertScrollBar.Position := {VertScrollBar.Position +} Rect.Top
|
|
else
|
|
if Rect.Bottom > VertScrollBar.Position + ClientHeight then
|
|
begin
|
|
//if Rect.Bottom - Rect.Top > VertScrollBar.Position + ClientHeight then
|
|
// Rect.Bottom := Rect.Top + ClientHeight;
|
|
VertScrollBar.Position := {VertScrollBar.Position +} Rect.Bottom - ClientHeight;
|
|
end;
|
|
UpdateAll;
|
|
Invalidate;
|
|
end;
|
|
|
|
//procedure TJvCustomItemViewer.SetBorderStyle(const Value: TBorderStyle);
|
|
//begin
|
|
// if Value <> FBorderStyle then
|
|
// begin
|
|
// FBorderStyle := Value;
|
|
// RecreateWnd;
|
|
// end;
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.SetCount(const Value: Integer);
|
|
begin
|
|
if Value <> Count then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
FItems.Count := Value;
|
|
if FSelectedIndex >= Value then
|
|
FSelectedIndex := -1;
|
|
finally
|
|
EndUpdate;
|
|
UpdateAll;
|
|
if HandleAllocated then
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SetItems(Index: Integer;
|
|
const Value: TJvViewerItem);
|
|
var
|
|
Item: TJvViewerItem;
|
|
begin
|
|
Item := FItems[Index];
|
|
if Item <> Value then
|
|
begin
|
|
if Item = nil then
|
|
Item := GetItemClass.Create(Self);
|
|
Item.Assign(Value);
|
|
FItems[Index] := Item;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SetOptions(const Value: TJvCustomItemViewerOptions);
|
|
begin
|
|
FOptions.Assign(Value);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SetSelected(Item: TJvViewerItem;
|
|
const Value: Boolean);
|
|
begin
|
|
//if (Item <> nil) and not (cdsSelected in Item.State) then
|
|
// Item.State := Item.State + [cdsSelected];
|
|
if Item <> nil then
|
|
if Value then
|
|
Item.State := Item.State + [cdsSelected]
|
|
else
|
|
Item.State := Item.State - [cdsSelected];
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SetSelectedIndex(const Value: Integer);
|
|
begin
|
|
if (FSelectedIndex >= 0) and (FSelectedIndex < Count) and (cdsSelected in Items[FSelectedIndex].State) then
|
|
Items[FSelectedIndex].State := Items[FSelectedIndex].State - [cdsSelected];
|
|
|
|
FSelectedIndex := Value;
|
|
|
|
if (Value >= 0) and (Value < Count) and not (cdsSelected in Items[Value].State) then
|
|
Items[Value].State := Items[Value].State + [cdsSelected];
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.ToggleSelection(Index: Integer;
|
|
SetSelection: Boolean);
|
|
begin
|
|
if cdsSelected in Items[Index].State then
|
|
begin
|
|
Items[Index].State := Items[Index].State - [cdsSelected];
|
|
if Index = SelectedIndex then
|
|
SelectedIndex := FindFirstSelected;
|
|
end
|
|
else
|
|
begin
|
|
Items[Index].State := Items[Index].State + [cdsSelected];
|
|
if SetSelection then
|
|
FSelectedIndex := Index;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.ShiftSelection(Index: Integer; SetSelection: Boolean);
|
|
var
|
|
I: Integer;
|
|
AFromCol, AFromRow: Integer;
|
|
AToCol, AToRow: Integer;
|
|
ACurrCol, ACurrRow: Integer;
|
|
|
|
function InRange(Value, Min, Max: Integer): Boolean;
|
|
begin
|
|
Result := (Value >= Min) and (Value <= Max);
|
|
end;
|
|
|
|
procedure Swap(var X, Y: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := X;
|
|
X := Y;
|
|
Y := I;
|
|
end;
|
|
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
if SelectedIndex < 0 then
|
|
SelectedIndex := 0;
|
|
IndexToColRow(SelectedIndex, AFromCol, AFromRow);
|
|
IndexToColRow(Index, AToCol, AToRow);
|
|
if AFromCol > AToCol then
|
|
Swap(AFromCol, AToCol);
|
|
if AFromRow > AToRow then
|
|
Swap(AFromRow, AToRow);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
IndexToColRow(I, ACurrCol, ACurrRow);
|
|
// access private variables so we don't trigger any OnChange event(s) by accident
|
|
if InRange(ACurrCol, AFromCol, AToCol) and InRange(ACurrRow, AFromRow, AToRow) then
|
|
Items[I].FState := Items[I].FState + [cdsSelected]
|
|
else
|
|
Items[I].FState := Items[I].FState - [cdsSelected];
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoUnSelectItems(ExcludeIndex: Integer);
|
|
var
|
|
Item: TJvViewerItem;
|
|
begin
|
|
if (ExcludeIndex >= 0) and (ExcludeIndex < Count) then
|
|
Item := Items[ExcludeIndex]
|
|
else
|
|
Item := nil;
|
|
PostMessage(Handle, CM_UNSELECTITEMS, WPARAM(Self), LPARAM(Item));
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.UpdateAll;
|
|
begin
|
|
if (csDestroying in ComponentState) or (Parent = nil) then
|
|
Exit;
|
|
|
|
{ wp: Don't call HandleNeeded here!. If the viewer is inserted into a
|
|
PageControl all following pages will be hidden. }
|
|
// HandleNeeded;
|
|
|
|
if not HandleAllocated then
|
|
Exit;
|
|
|
|
HorzScrollBar.Smooth := Options.Smooth;
|
|
VertScrollBar.Smooth := Options.Smooth;
|
|
HorzScrollBar.Tracking := Options.Tracking;
|
|
VertScrollBar.Tracking := Options.Tracking;
|
|
|
|
FItemSize.cx := Options.Width + Options.HorzSpacing;
|
|
FItemSize.cy := Options.Height + Options.VertSpacing;
|
|
if Options.ShowCaptions then
|
|
Inc(FItemSize.cy, GetTextHeight);
|
|
if (FItemSize.cy < 1) or (FItemSize.cx < 1) or (Count < 1) then
|
|
Exit;
|
|
if Options.ScrollBar = tvHorizontal then
|
|
begin
|
|
if Options.AutoCenter then
|
|
FRows := ClientHeight div FItemSize.cy
|
|
else
|
|
FRows := (ClientHeight + FItemSize.cy div 3) div FItemSize.cy;
|
|
if FRows > Count then
|
|
FRows := Count;
|
|
if FRows < 1 then
|
|
FRows := 1;
|
|
// if (ClientHeight mod FItemSize.cy > FItemSize.cy div 2) then
|
|
// Inc(FRows);
|
|
FCols := Count div FRows;
|
|
if FCols < 1 then
|
|
FCols := 1;
|
|
while (FRows * FCols) < Count do
|
|
Inc(FCols);
|
|
HorzScrollBar.Visible := True;
|
|
VertScrollBar.Visible := False;
|
|
end
|
|
else
|
|
begin
|
|
if Options.AutoCenter then
|
|
FCols := ClientWidth div FItemSize.cx
|
|
else
|
|
FCols := (ClientWidth + FItemSize.cx div 3) div FItemSize.cx;
|
|
if FCols > Count then
|
|
FCols := Count;
|
|
if FCols < 1 then
|
|
FCols := 1;
|
|
// if (ClientWidth mod FItemSize.cx > FItemSize.cx div 2) then
|
|
// Inc(FCols);
|
|
FRows := Count div FCols;
|
|
if FRows < 1 then
|
|
FRows := 1;
|
|
while (FRows * FCols) < Count do
|
|
Inc(FRows);
|
|
HorzScrollBar.Visible := False;
|
|
VertScrollBar.Visible := True;
|
|
end;
|
|
HorzScrollBar.Range := FCols * FItemSize.cx;
|
|
VertScrollBar.Range := FRows * FItemSize.cy;
|
|
HorzScrollBar.Page := ClientWidth;
|
|
VertScrollBar.Page := ClientHeight;
|
|
UpdateOffset;
|
|
CalcIndices;
|
|
CheckHotTrack;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.UpdateOffset;
|
|
begin
|
|
if Options.AutoCenter then
|
|
begin
|
|
FTopLeft.X := (ClientWidth - FCols * FItemSize.cx) div 2;
|
|
FTopLeft.Y := (ClientHeight - FRows * FItemSize.cy) div 2;
|
|
end
|
|
else
|
|
begin
|
|
FTopLeft.X := Options.HorzSpacing div 2;
|
|
FTopLeft.Y := Options.VertSpacing div 2;
|
|
end;
|
|
if FTopLeft.X < Options.HorzSpacing div 2 then
|
|
FTopLeft.X := Options.HorzSpacing div 2;
|
|
if FTopLeft.Y < Options.VertSpacing div 2 then
|
|
FTopLeft.Y := Options.VertSpacing div 2;
|
|
if HorzScrollBar.Visible then
|
|
Dec(FTopLeft.X, HorzScrollBar.Position);
|
|
if VertScrollBar.Visible then
|
|
Dec(FTopLeft.Y, VertScrollBar.Position);
|
|
end;
|
|
|
|
//procedure TJvCustomItemViewer.GetDlgCode(var Code: TDlgCodes);
|
|
//begin
|
|
// Code := [dcWantArrows];
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.WMHScroll(var Msg: TLMessage);
|
|
begin
|
|
inherited;
|
|
UpdateAll;
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
if Assigned(FOnScroll) then
|
|
FOnScroll(Self);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Loaded;
|
|
begin
|
|
inherited;
|
|
HandleNeeded;
|
|
UpdateAll;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
if Button = mbLeft then
|
|
begin
|
|
FTempSelected := ItemAtPos(X, Y, True);
|
|
if CanFocus then
|
|
SetFocus;
|
|
end
|
|
else
|
|
if Button = mbRight then
|
|
begin
|
|
StopScrollTimer;
|
|
if Options.RightClickSelect then
|
|
begin
|
|
FTempSelected := ItemAtPos(X, Y, True);
|
|
if CanFocus then
|
|
SetFocus;
|
|
SelectedIndex := FTempSelected;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Button = mbLeft then
|
|
begin
|
|
I := ItemAtPos(X, Y, True);
|
|
if (I = FTempSelected) and (I >= 0) and (I < Count) then
|
|
begin
|
|
if Options.MultiSelect then
|
|
begin
|
|
if (Shift * KeyboardShiftStates = [ssCtrl]) then
|
|
ToggleSelection(FTempSelected, True)
|
|
else
|
|
if Shift * KeyboardShiftStates = [ssShift] then
|
|
ShiftSelection(FTempSelected, True)
|
|
else
|
|
begin
|
|
DoUnSelectItems(FTempSelected);
|
|
SelectedIndex := FTempSelected;
|
|
Invalidate;
|
|
end;
|
|
end
|
|
else
|
|
SelectedIndex := FTempSelected;
|
|
end
|
|
else
|
|
if I < 0 then
|
|
// begin
|
|
DoUnSelectItems(-1);
|
|
// SelectedIndex := -1;
|
|
// end;
|
|
FTempSelected := -1;
|
|
end;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.WMNCHitTest(var Msg: TLMessage);
|
|
begin
|
|
// enable scroll bars at design-time
|
|
DefaultHandler(Msg);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.WMPaint(var Msg: TLMPaint);
|
|
begin
|
|
ControlState := ControlState + [csCustomPaint];
|
|
inherited;
|
|
ControlState := ControlState - [csCustomPaint];
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.WMVScroll(var Msg: TLMessage);
|
|
begin
|
|
inherited;
|
|
UpdateAll;
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
if Assigned(FOnScroll) then
|
|
FOnScroll(Self);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.WMCancelMode(var Msg: TLMessage);
|
|
begin
|
|
inherited;
|
|
StopScrollTimer;
|
|
end;
|
|
|
|
//procedure TJvCustomItemViewer.FocusSet(PrevWnd: THandle);
|
|
//begin
|
|
// inherited FocusSet(PrevWnd);
|
|
// if PrevWnd = Handle then
|
|
// begin
|
|
// if SelectedIndex >= 0 then
|
|
// Invalidate;
|
|
// end;
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.BoundsChanged;
|
|
begin
|
|
UpdateAll;
|
|
if HandleAllocated then
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
inherited BoundsChanged;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Changed;
|
|
begin
|
|
inherited Changed;
|
|
if (FUpdateCount = 0) and HandleAllocated then
|
|
begin
|
|
UpdateAll;
|
|
if not Options.MultiSelect then
|
|
DoUnSelectItems(SelectedIndex);
|
|
InvalidateClipRect(ClientDisplayRect);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoScrollTimer(Sender: TObject);
|
|
var
|
|
DoInvalidate: Boolean;
|
|
P: TPoint = (X:0; Y:0);
|
|
begin
|
|
FScrollTimer.Enabled := False;
|
|
FScrollTimer.Interval := cScrollIntervall;
|
|
DoInvalidate := False;
|
|
GetCursorPos(P);
|
|
if FDragImages <> nil then
|
|
FDragImages.HideDragImage;
|
|
case TScrollEdge(ScrollEdge) of
|
|
seLeft:
|
|
if (Options.ScrollBar = tvHorizontal) and HorzScrollBar.Visible and (HorzScrollBar.Position > 0) then
|
|
DoInvalidate := PostMessage(Handle, LM_HSCROLL, SB_LINELEFT, 0);
|
|
seTop:
|
|
if (Options.ScrollBar = tvVertical) and VertScrollBar.Visible and (VertScrollBar.Position > 0) then
|
|
DoInvalidate := PostMessage(Handle, LM_VSCROLL, SB_LINELEFT, 0);
|
|
seRight:
|
|
if (Options.ScrollBar = tvHorizontal) and HorzScrollBar.Visible and (HorzScrollBar.Position < HorzScrollBar.Range)
|
|
then
|
|
DoInvalidate := PostMessage(Handle, LM_HSCROLL, SB_LINERIGHT, 0);
|
|
seBottom:
|
|
if (Options.ScrollBar = tvVertical) and VertScrollBar.Visible and (VertScrollBar.Position < VertScrollBar.Range)
|
|
then
|
|
DoInvalidate := PostMessage(Handle, LM_VSCROLL, SB_LINERIGHT, 0);
|
|
end;
|
|
if FDragImages <> nil then
|
|
FDragImages.ShowDragImage;
|
|
if (ScrollEdge <> Ord(seNone)) and DoInvalidate then
|
|
Invalidate;
|
|
// UpdateWindow(Handle);
|
|
FScrollTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
const
|
|
cEdgeSize = 4;
|
|
begin
|
|
inherited DragOver(Source, X, Y, State, Accept);
|
|
if Accept and Options.DragAutoScroll then
|
|
begin
|
|
if X <= cEdgeSize then
|
|
ScrollEdge := Ord(seLeft)
|
|
else
|
|
if X >= ClientWidth - cEdgeSize then
|
|
ScrollEdge := Ord(seRight)
|
|
else
|
|
if Y <= cEdgeSize then
|
|
ScrollEdge := Ord(seTop)
|
|
else
|
|
if Y >= ClientHeight - cEdgeSize then
|
|
ScrollEdge := Ord(seBottom)
|
|
else
|
|
ScrollEdge := Ord(seNone);
|
|
if (ScrollEdge = Ord(seNone)) and Assigned(FScrollTimer) then
|
|
StopScrollTimer
|
|
else
|
|
if (ScrollEdge <> Ord(seNone)) and not Assigned(FScrollTimer) then
|
|
begin
|
|
FScrollTimer := TTimer.Create(nil);
|
|
FScrollTimer.Enabled := False;
|
|
FScrollTimer.Interval := cScrollDelay;
|
|
FScrollTimer.OnTimer := @DoScrollTimer;
|
|
FScrollTimer.Enabled := True;
|
|
end;
|
|
end
|
|
else
|
|
StopScrollTimer;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DragCanceled;
|
|
begin
|
|
inherited DragCanceled;
|
|
StopScrollTimer;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.DoEndDrag(Sender: TObject; X, Y: Integer);
|
|
begin
|
|
inherited DoEndDrag(Sender, X, Y);
|
|
StopScrollTimer;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.StopScrollTimer;
|
|
begin
|
|
if FScrollTimer <> nil then
|
|
begin
|
|
FreeAndNil(FScrollTimer);
|
|
UpdateWindow(Handle);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SelectAll;
|
|
begin
|
|
SelectItems(0, Count - 1, True);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.SelectItems(StartIndex, EndIndex: Integer;
|
|
AppendSelection: Boolean);
|
|
var
|
|
I, AIndex: Integer;
|
|
begin
|
|
AIndex := SelectedIndex;
|
|
BeginUpdate;
|
|
if not AppendSelection then
|
|
DoUnSelectItems(-1);
|
|
try
|
|
for I := Max(StartIndex, 0) to Min(Count - 1, EndIndex) do
|
|
Items[I].FState := Items[I].FState + [cdsSelected];
|
|
if (AIndex >= StartIndex) and (AIndex <= EndIndex) then
|
|
FSelectedIndex := AIndex
|
|
else
|
|
FSelectedIndex := StartIndex;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.UnselectItems(StartIndex, EndIndex: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
for I := Max(0, StartIndex) to Min(EndIndex, Count - 1) do
|
|
Items[I].FState := Items[I].FState - [cdsSelected];
|
|
if (SelectedIndex >= StartIndex) and (SelectedIndex <= EndIndex) then
|
|
FSelectedIndex := FindFirstSelected;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
// Unused in LCL
|
|
//procedure TJvCustomItemViewer.WMNCPaint(var Messages: TWMNCPaint);
|
|
//begin
|
|
// inherited;
|
|
// {$IFDEF JVCLThemesEnabled}
|
|
// if StyleServices.Enabled then
|
|
// StyleServices.PaintBorder(TWinControl(Self), False)
|
|
// {$ENDIF JVCLThemesEnabled}
|
|
//end;
|
|
|
|
// Replaced by DoOnShowHint
|
|
//function TJvCustomItemViewer.HintShow(var HintInfo: {$IFDEF RTL200_UP}Controls.{$ENDIF RTL200_UP}THintInfo): Boolean;
|
|
//var
|
|
// I: Integer;
|
|
//begin
|
|
// I := ItemAtPos(HintInfo.CursorPos.X, HintInfo.CursorPos.Y, True);
|
|
// if I >= 0 then
|
|
// begin
|
|
// HintInfo.HintStr := Items[I].Hint;
|
|
// HintInfo.CursorRect := ItemRect(I, True);
|
|
// DoItemHint(I, HintInfo);
|
|
// end;
|
|
// if HintInfo.HintStr = '' then
|
|
// HintInfo.HintStr := Hint;
|
|
// Result := False;
|
|
//end;
|
|
|
|
procedure TJvCustomItemViewer.Deleted(Item: TJvViewerItem);
|
|
begin
|
|
if Assigned(FOnDeletion) then
|
|
FOnDeletion(Self, Item);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.Inserted(Item: TJvViewerItem);
|
|
begin
|
|
if Assigned(FOnInsertion) then
|
|
FOnInsertion(Self, Item);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.DoItemHint(Index: Integer;
|
|
var HintInfo: THintInfo): Boolean;
|
|
begin
|
|
Result := False;
|
|
if Assigned(FOnItemHint) then
|
|
FOnItemHint(Self, Index, HintInfo, Result);
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.ScrollBy(DeltaX, DeltaY: Integer);
|
|
begin
|
|
//if DeltaX <> 0 then
|
|
// HorzScrollBar.Position := HorzScrollBar.Position + DeltaX;
|
|
//if DeltaY <> 0 then
|
|
// VertScrollBar.Position := VertScrollBar.Position + DeltaY;
|
|
inherited;
|
|
UpdateAll;
|
|
end;
|
|
|
|
procedure TJvCustomItemViewer.CustomSort(Compare: TListSortCompare);
|
|
begin
|
|
FItems.Sort(Compare);
|
|
end;
|
|
|
|
function TJvCustomItemViewer.ClientDisplayRect: TRect;
|
|
begin
|
|
Result := ClientRect;
|
|
OffsetRect(Result, HorzScrollBar.Position, VertScrollBar.Position);
|
|
end;
|
|
|
|
//=== { TViewerDrawImageList } ===============================================
|
|
|
|
procedure TViewerDrawImageList.Initialize;
|
|
begin
|
|
inherited Initialize;
|
|
DragCursor := crArrow;
|
|
end;
|
|
|
|
{ TJvViewerItemList }
|
|
|
|
function TJvViewerItemList.GetItem(Index: Integer): TJvViewerItem;
|
|
begin
|
|
Result := inherited Items[Index] as TJvViewerItem;
|
|
end;
|
|
|
|
procedure TJvViewerItemList.SetItem(Index: Integer; const Value: TJvViewerItem);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
//initialization
|
|
// LoadOLEDragCursors;
|
|
|
|
finalization
|
|
ClearBrushPatterns;
|
|
|
|
end.
|