You've already forked lazarus-ccr
jvcl: Add new components TJvImagesViewer, TJvImageListViewer, TJvCustomDrawViewer, ported by Michal Gawrycki (issue #34104).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6575 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -19,7 +19,8 @@ uses
|
|||||||
JvOutlookBar, JvOutlookBarEditors,
|
JvOutlookBar, JvOutlookBarEditors,
|
||||||
// JvTabBar, JvTabBarXPPainter,
|
// JvTabBar, JvTabBarXPPainter,
|
||||||
JvThumbImage, JvThumbnails, JvThumbViews,
|
JvThumbImage, JvThumbnails, JvThumbViews,
|
||||||
JvTimeLine, JvTMTimeLine, JvTimeLineEditor;
|
JvTimeLine, JvTMTimeLine, JvTimeLineEditor,
|
||||||
|
JvImagesViewer, JvImageListViewer, JvOwnerDrawViewer;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
@ -28,7 +29,8 @@ begin
|
|||||||
TJvOutlookBar,
|
TJvOutlookBar,
|
||||||
TJvThumbView, TJvThumbnail, TJvThumbImage,
|
TJvThumbView, TJvThumbnail, TJvThumbImage,
|
||||||
TJvTimeLine,
|
TJvTimeLine,
|
||||||
TJvTMTimeLine
|
TJvTMTimeLine,
|
||||||
|
TJvImagesViewer, TJvImageListViewer, TJvOwnerDrawViewer
|
||||||
]);
|
]);
|
||||||
|
|
||||||
// Timeline
|
// Timeline
|
||||||
|
|||||||
@ -7,3 +7,6 @@ tjvtmtimeline.bmp
|
|||||||
tjvthumbnail.bmp
|
tjvthumbnail.bmp
|
||||||
tjvthumbimage.bmp
|
tjvthumbimage.bmp
|
||||||
tjvthumbview.bmp
|
tjvthumbview.bmp
|
||||||
|
tjvimagelistviewer.bmp
|
||||||
|
tjvimagesviewer.bmp
|
||||||
|
tjvownerdrawviewer.bmp
|
||||||
|
|||||||
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
102
components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpi
Normal file
102
components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpi
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
<MainUnitHasScaledStatement Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="JvItemViewerDemo"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
</General>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="0"/>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="RunTimeTypeInfoControls"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="JvCustomLazR"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="JvCoreLazR"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="3">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="JvItemViewerDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="MainFrm.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="frmMain"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="ViewerFrm.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="frmImageViewer"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit2>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
<ObjectPath Value="..\..\run"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<SyntaxMode Value="Delphi"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
@ -0,0 +1,17 @@
|
|||||||
|
program JvItemViewerDemo;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Forms, Interfaces,
|
||||||
|
MainFrm in 'MainFrm.pas' {frmMain},
|
||||||
|
ViewerFrm in 'ViewerFrm.pas' {frmImageViewer};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
// MemChk;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TfrmMain, frmMain);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
18876
components/jvcllaz/examples/JvItemViewer/MainFrm.lfm
Normal file
18876
components/jvcllaz/examples/JvItemViewer/MainFrm.lfm
Normal file
File diff suppressed because it is too large
Load Diff
518
components/jvcllaz/examples/JvItemViewer/MainFrm.pas
Normal file
518
components/jvcllaz/examples/JvItemViewer/MainFrm.pas
Normal file
@ -0,0 +1,518 @@
|
|||||||
|
{******************************************************************
|
||||||
|
|
||||||
|
JEDI-VCL Demo
|
||||||
|
|
||||||
|
Copyright (C) 2002 Project JEDI
|
||||||
|
|
||||||
|
Original author:
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the JEDI-JVCL
|
||||||
|
home page, located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
The contents of this file are used with permission, 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_1Final.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an
|
||||||
|
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||||
|
implied. See the License for the specific language governing
|
||||||
|
rights and limitations under the License.
|
||||||
|
|
||||||
|
******************************************************************}
|
||||||
|
|
||||||
|
unit MainFrm;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
{.$I jvcl.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls,
|
||||||
|
Dialogs, StdCtrls, ExtCtrls, ImgList, ComCtrls, Menus,
|
||||||
|
// if you have units that supports other image formats, add them here *before* including JvItemViewer
|
||||||
|
// GraphicEx, // http://www.delphi-gems.com/Graphics.php#GraphicEx
|
||||||
|
JvCustomItemViewer, JvImagesViewer, JvImageListViewer, JvOwnerDrawViewer,
|
||||||
|
EditBtn, RTTIGrids;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmMain }
|
||||||
|
|
||||||
|
TfrmMain = class(TForm)
|
||||||
|
Label1: TLabel;
|
||||||
|
pnlSettings: TPanel;
|
||||||
|
edDirectory: TDirectoryEdit;
|
||||||
|
lblFolder: TLabel;
|
||||||
|
lblFilemask: TLabel;
|
||||||
|
edFileMask: TEdit;
|
||||||
|
StatusBar1: TStatusBar;
|
||||||
|
ImageList1: TImageList;
|
||||||
|
pgViewers: TPageControl;
|
||||||
|
tabIFViewer: TTabSheet;
|
||||||
|
tabILViewer: TTabSheet;
|
||||||
|
tabODViewer: TTabSheet;
|
||||||
|
PopupMenu1: TPopupMenu;
|
||||||
|
Reload1: TMenuItem;
|
||||||
|
Viewfromfile1: TMenuItem;
|
||||||
|
Viewfrompicture1: TMenuItem;
|
||||||
|
N1: TMenuItem;
|
||||||
|
Splitter1: TSplitter;
|
||||||
|
btnUpdate: TButton;
|
||||||
|
Rename1: TMenuItem;
|
||||||
|
Delete1: TMenuItem;
|
||||||
|
N2: TMenuItem;
|
||||||
|
chkDisconnect: TCheckBox;
|
||||||
|
SelectAll1: TMenuItem;
|
||||||
|
procedure btnUpdateClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure Reload1Click(Sender: TObject);
|
||||||
|
procedure Viewfromfile1Click(Sender: TObject);
|
||||||
|
procedure Viewfrompicture1Click(Sender: TObject);
|
||||||
|
procedure pgViewersChange(Sender: TObject);
|
||||||
|
procedure edDirectoryChange(Sender: TObject);
|
||||||
|
procedure Rename1Click(Sender: TObject);
|
||||||
|
procedure Delete1Click(Sender: TObject);
|
||||||
|
procedure chkDisconnectClick(Sender: TObject);
|
||||||
|
procedure SelectAll1Click(Sender: TObject);
|
||||||
|
private
|
||||||
|
FDragIndex: Integer;
|
||||||
|
procedure BuildColorList;
|
||||||
|
procedure SetDisplayDragImage(AControl: TControl);
|
||||||
|
procedure DoITV2DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
|
||||||
|
procedure DoITV2DragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||||
|
procedure DoITV2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure DoITV2GetCaption(Sender: TObject; ImageIndex: Integer; var ACaption: WideString);
|
||||||
|
procedure DoITV3ItemHint(Sender: TObject; Index: Integer;
|
||||||
|
var HintInfo: THintInfo; var Handled: Boolean);
|
||||||
|
procedure DoITVClick(Sender: TObject);
|
||||||
|
procedure DoITVDblClick(Sender: TObject);
|
||||||
|
procedure DITVLoadBegin(Sender: TObject);
|
||||||
|
procedure DoITVLoadEnd(Sender: TObject);
|
||||||
|
procedure DoITVLoadProgress(Sender: TObject; Item: TJvPictureItem; Stage: TProgressStage;
|
||||||
|
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
|
||||||
|
procedure DoITV3DrawItem(Sender: TObject; AIndex: Integer; AState: TCustomDrawState; ACanvas: TCanvas; ItemRect,
|
||||||
|
TextRect: TRect);
|
||||||
|
procedure DoITV3Click(Sender: TObject);
|
||||||
|
procedure ViewItem(Item: TJvPictureItem; LoadFromFile: Boolean);
|
||||||
|
public
|
||||||
|
ITV: TJvImagesViewer;
|
||||||
|
ITV2: TJvImageListViewer;
|
||||||
|
ITV3: TJvOwnerDrawViewer;
|
||||||
|
AInspector: TTIPropertyGrid;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmMain: TfrmMain;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
JvConsts, // for clMoneyGreen
|
||||||
|
CommCtrl, //Consts,
|
||||||
|
ViewerFrm;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
//=== TfrmMain ===============================================================
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV3DrawItem(Sender: TObject; AIndex: Integer; AState: TCustomDrawState; ACanvas:
|
||||||
|
TCanvas; ItemRect, TextRect: TRect);
|
||||||
|
var
|
||||||
|
AColor: TColor;
|
||||||
|
begin
|
||||||
|
AColor := TColor(ITV3.Items[AIndex].Data);
|
||||||
|
ACanvas.Brush.Color := AColor;
|
||||||
|
ACanvas.FillRect(ItemRect);
|
||||||
|
ACanvas.Pen.Style := psSolid;
|
||||||
|
if [cdsSelected, cdsHot] * AState <> [] then
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Color := clHighlight;
|
||||||
|
ACanvas.Pen.Width := 2;
|
||||||
|
Inc(ItemRect.Left);
|
||||||
|
Inc(ItemRect.Top);
|
||||||
|
ACanvas.Rectangle(ItemRect);
|
||||||
|
Dec(ItemRect.Left);
|
||||||
|
Dec(ItemRect.Top);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Style := psSolid;
|
||||||
|
ACanvas.Pen.Color := clBlack;
|
||||||
|
ACanvas.Pen.Width := 1;
|
||||||
|
ACanvas.Rectangle(ItemRect);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.btnUpdateClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
try
|
||||||
|
ITV.Directory := edDirectory.Text;
|
||||||
|
ITV.FileMask := edFileMask.Text;
|
||||||
|
AInspector.TIObject := nil;
|
||||||
|
//AInspector.BeginUpdate;
|
||||||
|
ITV.LoadImages;
|
||||||
|
AInspector.TIObject := ITV;
|
||||||
|
//AInspector.EndUpdate;
|
||||||
|
StatusBar1.Panels[0].Text := Format(' %d images found and loaded', [ITV.Count]);
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Randomize;
|
||||||
|
SetDisplayDragImage(Self);
|
||||||
|
AInspector := TTIPropertyGrid.Create(Self);
|
||||||
|
AInspector.Parent := Self;
|
||||||
|
AInspector.Left := -100;
|
||||||
|
AInspector.Width := StatusBar1.Panels[0].Width - 2;
|
||||||
|
AInspector.Parent := Self;
|
||||||
|
AInspector.Align := alLeft;
|
||||||
|
|
||||||
|
ITV := TJvImagesViewer.Create(Self);
|
||||||
|
ITV.Align := alClient;
|
||||||
|
ITV.PopupMenu := PopupMenu1;
|
||||||
|
// ITV.Cursor := crHandPoint;
|
||||||
|
ITV.Options.RightClickSelect := True;
|
||||||
|
ITV.Options.ImagePadding := 8;
|
||||||
|
ITV.Options.MultiSelect := True;
|
||||||
|
ITV.Options.HotTrack := True;
|
||||||
|
// ITV.Options.Smooth := True; // don't use smooth with images - looks ugly when scrolling
|
||||||
|
|
||||||
|
ITV.OnDblClick := DoITVDblClick;
|
||||||
|
ITV.OnClick := DoITVClick;
|
||||||
|
ITV.OnLoadBegin := DITVLoadBegin;
|
||||||
|
ITV.OnLoadEnd := DoITVLoadEnd;
|
||||||
|
ITV.OnLoadProgress := DoITVLoadProgress;
|
||||||
|
|
||||||
|
ITV.Parent := tabIFViewer;
|
||||||
|
ITV.Color := clWindow;
|
||||||
|
if edFileMask.Text = '' then
|
||||||
|
edFileMask.Text := ITV.Filemask;
|
||||||
|
|
||||||
|
ITV2 := TJvImageListViewer.Create(Self);
|
||||||
|
ITV2.Align := alClient;
|
||||||
|
ITV2.Options.Width := ImageList1.Width * 2;
|
||||||
|
ITV2.Options.Height := ImageList1.Height * 2;
|
||||||
|
ITV2.Options.FillCaption := False;
|
||||||
|
ITV2.Options.BrushPattern.Active := False;
|
||||||
|
// ITV2.Options.BrushPattern.OddColor := clHighlight;
|
||||||
|
|
||||||
|
ITV2.Images := ImageList1;
|
||||||
|
ITV2.Parent := tabILViewer;
|
||||||
|
// ITV2.Options.BrushPattern.OddColor := clHighlight;
|
||||||
|
// ITV2.Options.BrushPattern.Active := False;
|
||||||
|
ITV2.OnMouseDown := DoITV2MouseDown;
|
||||||
|
ITV2.OnDragOver := DoITV2DragOver;
|
||||||
|
ITV2.OnDragDrop := DoITV2DragDrop;
|
||||||
|
ITV2.OnGetCaption := DoITV2GetCaption;
|
||||||
|
ITV2.Color := clWindow;
|
||||||
|
ITV2.Options.ShowCaptions := True;
|
||||||
|
|
||||||
|
ITV3 := TJvOwnerDrawViewer.Create(Self);
|
||||||
|
ITV3.Options.Smooth := True; // Smooth looks OK here, because these items renders faster
|
||||||
|
ITV3.Options.HotTrack := False;
|
||||||
|
ITV3.Options.Width := 18;
|
||||||
|
ITV3.Options.Height := 18;
|
||||||
|
ITV3.Options.VertSpacing := 2;
|
||||||
|
ITV3.Options.HorzSpacing := 2;
|
||||||
|
ITV3.Align := alClient;
|
||||||
|
ITV3.OnDrawItem := DoITV3DrawItem;
|
||||||
|
ITV3.OnClick := DoITV3Click;
|
||||||
|
ITV3.OnItemHint := DoITV3ItemHint;
|
||||||
|
ITV3.ShowHint := true;
|
||||||
|
|
||||||
|
// ITV3.Count := tbThumbSize.Position;
|
||||||
|
ITV3.Parent := tabODViewer;
|
||||||
|
ITV3.Color := clWindow;
|
||||||
|
|
||||||
|
// add colors to TJvOwnerDrawViewer
|
||||||
|
BuildColorList;
|
||||||
|
|
||||||
|
if edDirectory.Text = '' then
|
||||||
|
begin
|
||||||
|
// this triggers the OnChange event
|
||||||
|
//edDirectory.Text := RegReadString(HKEY_CURRENT_USER,
|
||||||
|
// 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', 'My Pictures');
|
||||||
|
//if edDirectory.Text = '' then
|
||||||
|
edDirectory.Text := GetCurrentDir;
|
||||||
|
end;
|
||||||
|
pgViewersChange(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITVClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if ITV.SelectedIndex > -1 then
|
||||||
|
StatusBar1.Panels[1].Text := ' ' + ITV.Items[ITV.SelectedIndex].FileName
|
||||||
|
else
|
||||||
|
StatusBar1.Panels[1].Text := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DITVLoadBegin(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.BuildColorList;
|
||||||
|
var
|
||||||
|
I, J: Cardinal;
|
||||||
|
begin
|
||||||
|
// example of storing stuff in item's Data property
|
||||||
|
ITV3.Count := $3FFF;
|
||||||
|
Randomize;
|
||||||
|
for I := 0 to $3FFE do
|
||||||
|
begin
|
||||||
|
J := ($3FFE - I) + 500;
|
||||||
|
ITV3.Items[I].Data := Pointer(RGB(Random(J) mod 256, Random(J) mod 256, Random(J) mod 256));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV2MouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
begin
|
||||||
|
if Button = mbLeft then
|
||||||
|
begin
|
||||||
|
FDragIndex := ITV2.ItemAtPos(X, Y, True);
|
||||||
|
if FDragIndex > -1 then
|
||||||
|
ITV2.BeginDrag(False, 10);
|
||||||
|
end;
|
||||||
|
// ITV2.Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV2DragOver(Sender, Source: TObject; X, Y: Integer;
|
||||||
|
State: TDragState; var Accept: Boolean);
|
||||||
|
//var
|
||||||
|
// I: Integer;
|
||||||
|
begin
|
||||||
|
Accept := Source = ITV2;
|
||||||
|
// I := ITV2.ItemAtPos(X, Y);
|
||||||
|
// if I > -1 then
|
||||||
|
// ITV2.SelectedIndex := I;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV2DragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := ITV2.ItemAtPos(X, Y, False);
|
||||||
|
if I >= ITV2.Images.Count then
|
||||||
|
I := ITV2.Images.Count - 1;
|
||||||
|
if (I > -1) and (I <> FDragIndex) then
|
||||||
|
ITV2.Images.Move(FDragIndex, I);
|
||||||
|
ITV2.SelectedIndex := I;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.Reload1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if ITV.SelectedIndex >= 0 then
|
||||||
|
begin
|
||||||
|
ITV.Items[ITV.SelectedIndex].Picture := nil;
|
||||||
|
ITV.Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITVDblClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Viewfrompicture1Click(Sender);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.ViewItem(Item: TJvPictureItem; LoadFromFile: Boolean);
|
||||||
|
begin
|
||||||
|
if LoadFromFile and FileExists(Item.FileName) then
|
||||||
|
TfrmImageViewer.View(Item.FileName, ITV.Options.Transparent, ITV.Color)
|
||||||
|
else
|
||||||
|
TfrmImageViewer.View(Item.Picture, ITV.Options.Transparent, ITV.Color);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.Viewfromfile1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
Item: TJvPictureItem;
|
||||||
|
begin
|
||||||
|
if ITV.Focused and (ITV.SelectedIndex >= 0) then
|
||||||
|
begin
|
||||||
|
Item := ITV.Items[ITV.SelectedIndex];
|
||||||
|
ViewItem(Item, True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.Viewfrompicture1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
Item: TJvPictureItem;
|
||||||
|
begin
|
||||||
|
if ITV.Focused and (ITV.SelectedIndex >= 0) then
|
||||||
|
begin
|
||||||
|
Item := ITV.Items[ITV.SelectedIndex];
|
||||||
|
ViewItem(Item, False);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITVLoadProgress(Sender: TObject; Item: TJvPictureItem;
|
||||||
|
Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
|
||||||
|
const R: TRect; const Msg: string);
|
||||||
|
begin
|
||||||
|
if PercentDone >= 100 then
|
||||||
|
StatusBar1.Panels[1].Text := ''
|
||||||
|
else
|
||||||
|
StatusBar1.Panels[1].Text := Format(' Loading "%s", %d%% done...', [Item.FileName, PercentDone]);
|
||||||
|
StatusBar1.Update;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITVLoadEnd(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
pgViewersChange(Sender);
|
||||||
|
//for I := 0 to ITV.Count - 1 do
|
||||||
|
// if Assigned(ITV.Items[I].Picture) and Assigned(ITV.Items[I].Picture.Graphic) and
|
||||||
|
// (ITV.Items[I].Picture.Graphic is TJvAni) then
|
||||||
|
// TJvAni(ITV.Items[I].Picture.Graphic).Animated := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure EnableControls(AControl: TControl; Enable: Boolean);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
AControl.Enabled := Enable;
|
||||||
|
if AControl is TWinControl then
|
||||||
|
for I := 0 to TWinControl(AControl).ControlCount - 1 do
|
||||||
|
EnableControls(TWinControl(AControl).Controls[I], Enable);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.pgViewersChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
case pgViewers.ActivePageIndex of
|
||||||
|
0:
|
||||||
|
begin
|
||||||
|
EnableControls(pnlSettings, True);
|
||||||
|
Statusbar1.Panels[1].Text := ' Double-click to view full size, right-click for popup menu';
|
||||||
|
AInspector.TIObject := ITV;
|
||||||
|
end;
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
EnableControls(pnlSettings, False);
|
||||||
|
Statusbar1.Panels[1].Text := ' Drag and drop images to rearrange';
|
||||||
|
AInspector.TIObject := ITV2;
|
||||||
|
end;
|
||||||
|
2:
|
||||||
|
begin
|
||||||
|
EnableControls(pnlSettings, False);
|
||||||
|
Statusbar1.Panels[1].Text := ' Click color square to see its color value in status bar';
|
||||||
|
AInspector.TIObject := ITV3;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV3Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if (ITV3.SelectedIndex >= 0) and (ITV3.SelectedIndex < ITV3.Count) then
|
||||||
|
StatusBar1.Panels[0].Text := ColorToString(TColor(ITV3.Items[ITV3.SelectedIndex].Data));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV2GetCaption(Sender: TObject; ImageIndex: Integer;
|
||||||
|
var ACaption: WideString);
|
||||||
|
begin
|
||||||
|
if ITV2.Options.ShowCaptions then
|
||||||
|
begin
|
||||||
|
if Odd(ImageIndex) then
|
||||||
|
ACaption := Format('#%d', [ImageIndex])
|
||||||
|
else
|
||||||
|
ACaption := Format('$%x', [ImageIndex])
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.edDirectoryChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if DirectoryExists(edDirectory.Text) then
|
||||||
|
btnUpdate.Click;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.Rename1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
AItem: TJvPictureItem;
|
||||||
|
begin
|
||||||
|
if ITV.SelectedIndex < 0 then
|
||||||
|
Exit;
|
||||||
|
AItem := ITV.Items[ITV.SelectedIndex];
|
||||||
|
S := AItem.FileName;
|
||||||
|
if InputQuery('Rename', 'New name', S) and not AnsiSameText(AItem.FileName, S) then
|
||||||
|
begin
|
||||||
|
S := ExpandUNCFileName(S);
|
||||||
|
if RenameFile(ITV.ITems[ITV.SelectedIndex].FileName, S) then
|
||||||
|
begin
|
||||||
|
AItem.FileName := S;
|
||||||
|
AItem.Caption := ExtractFileName(S);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ShowMessage('Could not rename file!');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.Delete1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
AItem: TJvPictureItem;
|
||||||
|
begin
|
||||||
|
if ITV.SelectedIndex < 0 then
|
||||||
|
Exit;
|
||||||
|
if MessageDlg('Are you sure you want to delete the selected file?',
|
||||||
|
mtConfirmation, [mbYes, mbNo], 0) = mrYEs then
|
||||||
|
begin
|
||||||
|
AItem := ITV.Items[ITV.SelectedIndex];
|
||||||
|
if not DeleteFile(AItem.FileName) then
|
||||||
|
ShowMessage('Could not delete the file!')
|
||||||
|
else
|
||||||
|
AItem.Delete;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.chkDisconnectClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if chkDisconnect.Checked then
|
||||||
|
begin
|
||||||
|
AInspector.TIObject := nil;
|
||||||
|
AInspector.Visible := False;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
AInspector.Visible := True;
|
||||||
|
pgViewersChange(Sender);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.SetDisplayDragImage(AControl: TControl);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
AControl.ControlStyle := AControl.ControlStyle + [csDisplayDragImage];
|
||||||
|
if AControl is TWinControl then
|
||||||
|
for I := 0 to TWinControl(AControl).ControlCOunt - 1 do
|
||||||
|
SetDisplayDragImage(TWinControl(AControl).Controls[I]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.SelectAll1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ITV.SelectAll;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TfrmMain.DoITV3ItemHint(Sender: TObject; Index: Integer;
|
||||||
|
var HintInfo: THintInfo; var Handled: Boolean);
|
||||||
|
var
|
||||||
|
AColor: TColor;
|
||||||
|
begin
|
||||||
|
AColor := TColor(ITV3.Items[Index].Data);
|
||||||
|
HintInfo.HintColor := AColor;
|
||||||
|
HintInfo.HintStr := ColorToString(AColor);
|
||||||
|
Handled := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
85
components/jvcllaz/examples/JvItemViewer/ViewerFrm.lfm
Normal file
85
components/jvcllaz/examples/JvItemViewer/ViewerFrm.lfm
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
object frmImageViewer: TfrmImageViewer
|
||||||
|
Left = 328
|
||||||
|
Height = 454
|
||||||
|
Top = 112
|
||||||
|
Width = 562
|
||||||
|
BorderIcons = [biSystemMenu, biMaximize]
|
||||||
|
Caption = 'Image Viewer'
|
||||||
|
ClientHeight = 454
|
||||||
|
ClientWidth = 562
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'MS Shell Dlg 2'
|
||||||
|
KeyPreview = True
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnKeyDown = FormKeyDown
|
||||||
|
OnMouseWheel = FormMouseWheel
|
||||||
|
OnResize = FormResize
|
||||||
|
OnShow = FormShow
|
||||||
|
LCLVersion = '1.9.0.0'
|
||||||
|
Scaled = False
|
||||||
|
object StatusBar1: TStatusBar
|
||||||
|
Left = 0
|
||||||
|
Height = 23
|
||||||
|
Top = 431
|
||||||
|
Width = 562
|
||||||
|
Panels = <
|
||||||
|
item
|
||||||
|
Width = 50
|
||||||
|
end>
|
||||||
|
SimplePanel = False
|
||||||
|
end
|
||||||
|
object ScrollBox1: TScrollBox
|
||||||
|
Left = 0
|
||||||
|
Height = 431
|
||||||
|
Top = 0
|
||||||
|
Width = 562
|
||||||
|
HorzScrollBar.Page = 225
|
||||||
|
HorzScrollBar.Tracking = True
|
||||||
|
VertScrollBar.Page = 201
|
||||||
|
VertScrollBar.Tracking = True
|
||||||
|
Align = alClient
|
||||||
|
BorderStyle = bsNone
|
||||||
|
ClientHeight = 431
|
||||||
|
ClientWidth = 562
|
||||||
|
Color = clWindow
|
||||||
|
Font.Color = clWindowText
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
PopupMenu = PopupMenu1
|
||||||
|
TabOrder = 1
|
||||||
|
object Image1: TImage
|
||||||
|
Left = 0
|
||||||
|
Height = 201
|
||||||
|
Top = 0
|
||||||
|
Width = 225
|
||||||
|
AutoSize = True
|
||||||
|
Center = True
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ActionList1: TActionList
|
||||||
|
left = 56
|
||||||
|
top = 32
|
||||||
|
object acFullScreen: TAction
|
||||||
|
Caption = 'Full Screen'
|
||||||
|
OnExecute = acFullScreenExecute
|
||||||
|
ShortCut = 122
|
||||||
|
end
|
||||||
|
object acClose: TAction
|
||||||
|
Caption = 'Close'
|
||||||
|
OnExecute = acCloseExecute
|
||||||
|
ShortCut = 27
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object PopupMenu1: TPopupMenu
|
||||||
|
left = 144
|
||||||
|
top = 32
|
||||||
|
object FullScreen1: TMenuItem
|
||||||
|
Action = acFullScreen
|
||||||
|
end
|
||||||
|
object Close1: TMenuItem
|
||||||
|
Action = acClose
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
250
components/jvcllaz/examples/JvItemViewer/ViewerFrm.pas
Normal file
250
components/jvcllaz/examples/JvItemViewer/ViewerFrm.pas
Normal file
@ -0,0 +1,250 @@
|
|||||||
|
{******************************************************************
|
||||||
|
|
||||||
|
JEDI-VCL Demo
|
||||||
|
|
||||||
|
Copyright (C) 2002 Project JEDI
|
||||||
|
|
||||||
|
Original author:
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the JEDI-JVCL
|
||||||
|
home page, located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
The contents of this file are used with permission, 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_1Final.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an
|
||||||
|
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||||
|
implied. See the License for the specific language governing
|
||||||
|
rights and limitations under the License.
|
||||||
|
|
||||||
|
******************************************************************}
|
||||||
|
|
||||||
|
unit ViewerFrm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms,
|
||||||
|
Dialogs, ExtCtrls, ComCtrls, ActnList, Menus;
|
||||||
|
|
||||||
|
type
|
||||||
|
TfrmImageViewer = class(TForm)
|
||||||
|
StatusBar1: TStatusBar;
|
||||||
|
ScrollBox1: TScrollBox;
|
||||||
|
Image1: TImage;
|
||||||
|
ActionList1: TActionList;
|
||||||
|
acFullScreen: TAction;
|
||||||
|
acClose: TAction;
|
||||||
|
PopupMenu1: TPopupMenu;
|
||||||
|
FullScreen1: TMenuItem;
|
||||||
|
Close1: TMenuItem;
|
||||||
|
procedure FormResize(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
|
||||||
|
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
||||||
|
procedure acFullScreenExecute(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure acCloseExecute(Sender: TObject);
|
||||||
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
private
|
||||||
|
procedure AdjustFormSize;
|
||||||
|
public
|
||||||
|
class function View(const Filename: string; Transparent: Boolean; BackColor: TColor): Boolean; overload;
|
||||||
|
class function View(Picture: TPicture; Transparent: Boolean; BackColor: TColor): Boolean; overload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Math, LCLType, LCLIntf;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
class function TfrmImageViewer.View(const Filename: string; Transparent: Boolean; BackColor: TColor): Boolean;
|
||||||
|
var
|
||||||
|
frmImageViewer: TfrmImageViewer;
|
||||||
|
begin
|
||||||
|
frmImageViewer := Self.Create(Application);
|
||||||
|
try
|
||||||
|
frmImageViewer.Image1.Transparent := Transparent;
|
||||||
|
frmImageViewer.Image1.Picture.LoadFromFile(Filename);
|
||||||
|
frmImageViewer.Caption := Filename;
|
||||||
|
frmImageViewer.ScrollBox1.Color := BackColor;
|
||||||
|
with frmImageViewer.Image1 do
|
||||||
|
frmImageViewer.StatusBar1.Panels[0].Text := Format('(%s) - %d x %d',
|
||||||
|
[Picture.Graphic.ClassName, Picture.Width, Picture.Height]);
|
||||||
|
frmImageViewer.Left := (Screen.Width - frmImageViewer.Width) div 2;
|
||||||
|
frmImageViewer.Top := (Screen.Height - frmImageViewer.Height) div 2;
|
||||||
|
frmImageViewer.ShowModal;
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
frmImageViewer.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TfrmImageViewer.View(Picture: TPicture; Transparent: Boolean; BackColor: TColor): Boolean;
|
||||||
|
var
|
||||||
|
frmImageViewer: TfrmImageViewer;
|
||||||
|
begin
|
||||||
|
frmImageViewer := Self.Create(Application);
|
||||||
|
try
|
||||||
|
frmImageViewer.Image1.Picture.Assign(Picture);
|
||||||
|
frmImageViewer.Image1.Transparent := Transparent;
|
||||||
|
frmImageViewer.Caption := Picture.Graphic.ClassName;
|
||||||
|
frmImageViewer.ScrollBox1.Color := BackColor;
|
||||||
|
frmImageViewer.StatusBar1.Panels[0].Text := Format(' (%s) - %d x %d',
|
||||||
|
[Picture.Graphic.ClassName, Picture.Width, Picture.Height]);
|
||||||
|
frmImageViewer.Left := (Screen.Width - frmImageViewer.Width) div 2;
|
||||||
|
frmImageViewer.Top := (Screen.Height - frmImageViewer.Height) div 2;
|
||||||
|
|
||||||
|
frmImageViewer.ShowModal;
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
frmImageViewer.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.FormResize(Sender: TObject);
|
||||||
|
begin
|
||||||
|
// make sure these are set correctly
|
||||||
|
// Image1.AutoSize := True;
|
||||||
|
// Image1.Center := True;
|
||||||
|
if ScrollBox1.ClientWidth < Image1.Width then
|
||||||
|
Image1.Left := -ScrollBox1.HorzScrollBar.Position
|
||||||
|
else
|
||||||
|
Image1.Left := (ScrollBox1.ClientWidth - Image1.Width) div 2;
|
||||||
|
if ScrollBox1.ClientHeight < Image1.Height then
|
||||||
|
Image1.Top := -ScrollBox1.VertScrollBar.Position
|
||||||
|
else
|
||||||
|
Image1.Top := (ScrollBox1.ClientHeight - Image1.Height) div 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
// minimize flicker
|
||||||
|
ScrollBox1.DoubleBuffered := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.FormMouseWheel(Sender: TObject;
|
||||||
|
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
|
||||||
|
var Handled: Boolean);
|
||||||
|
begin
|
||||||
|
// handle wheel event in form so scrolbox doesn't have to be focused to scroll
|
||||||
|
Handled := True;
|
||||||
|
if ScrollBox1.VertScrollBar.IsScrollBarVisible and not (ssShift in Shift) then
|
||||||
|
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - WheelDelta
|
||||||
|
else
|
||||||
|
ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - WheelDelta;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.acFullScreenExecute(Sender: TObject);
|
||||||
|
//var
|
||||||
|
// P: TWindowPlacement;
|
||||||
|
begin
|
||||||
|
acFullScreen.Checked := not acFullScreen.Checked;
|
||||||
|
//FillChar(P, SizeOf(P), 0);
|
||||||
|
//P.length := SizeOf(P);
|
||||||
|
// get default and current values
|
||||||
|
//GetWindowPlacement(Handle, @P);
|
||||||
|
// adjust UI
|
||||||
|
if acFullScreen.Checked then
|
||||||
|
begin
|
||||||
|
BorderStyle := bsNone;
|
||||||
|
StatusBar1.Visible := False;
|
||||||
|
//P.showCmd := SW_SHOWMAXIMIZED;
|
||||||
|
WindowState := wsFullScreen;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
BorderStyle := bsSizeable;
|
||||||
|
StatusBar1.Visible := True;
|
||||||
|
//P.showCmd := SW_RESTORE;
|
||||||
|
WindowState := wsNormal;
|
||||||
|
end;
|
||||||
|
// set new size/position
|
||||||
|
//SetWindowPlacement(Handle, @P);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.AdjustFormSize;
|
||||||
|
var
|
||||||
|
R: TRect;
|
||||||
|
W, H: Integer;
|
||||||
|
begin
|
||||||
|
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
|
||||||
|
W := R.Right - R.Left;
|
||||||
|
H := R.Bottom - R.Top;
|
||||||
|
with Image1 do
|
||||||
|
begin
|
||||||
|
if Picture.Width > Self.Width then
|
||||||
|
begin
|
||||||
|
if Picture.Width + 32 < W then
|
||||||
|
Self.Width := Picture.Width + 32
|
||||||
|
else
|
||||||
|
Self.Width := W;
|
||||||
|
Self.Left := R.Left + (W - Self.Width) div 2;
|
||||||
|
end;
|
||||||
|
if Picture.Height + StatusBar1.Height > Self.Height then
|
||||||
|
begin
|
||||||
|
if Picture.Height + 32 < H then
|
||||||
|
Self.Height := Picture.Height + StatusBar1.Height + 32
|
||||||
|
else
|
||||||
|
Self.Height := H;
|
||||||
|
Self.Top := R.Top + (H - Self.Height) div 2;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
AdjustFormSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.acCloseExecute(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if acFullScreen.Checked then
|
||||||
|
acFullScreen.Execute
|
||||||
|
else
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmImageViewer.FormKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
var
|
||||||
|
Value: Integer;
|
||||||
|
begin
|
||||||
|
if ssCtrl in Shift then
|
||||||
|
Value := 10
|
||||||
|
else
|
||||||
|
Value := 1;
|
||||||
|
case Key of
|
||||||
|
VK_LEFT:
|
||||||
|
with ScrollBox1.HorzScrollBar do
|
||||||
|
Position := Position - Increment * Value;
|
||||||
|
VK_RIGHT:
|
||||||
|
with ScrollBox1.HorzScrollBar do
|
||||||
|
Position := Position + Increment * Value;
|
||||||
|
VK_UP:
|
||||||
|
with ScrollBox1.VertScrollBar do
|
||||||
|
Position := Position - Increment * Value;
|
||||||
|
VK_DOWN:
|
||||||
|
with ScrollBox1.VertScrollBar do
|
||||||
|
Position := Position + Increment * Value;
|
||||||
|
VK_PRIOR:
|
||||||
|
ScrollBox1.VertScrollBar.Position := 0;
|
||||||
|
VK_NEXT:
|
||||||
|
with ScrollBox1.VertScrollBar do
|
||||||
|
Position := Range;
|
||||||
|
VK_HOME:
|
||||||
|
ScrollBox1.HorzScrollBar.Position := 0;
|
||||||
|
VK_END:
|
||||||
|
with ScrollBox1.HorzScrollBar do
|
||||||
|
Position := Range;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@ -18,7 +18,7 @@
|
|||||||
"/>
|
"/>
|
||||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||||
<Version Major="1" Release="4"/>
|
<Version Major="1" Release="4"/>
|
||||||
<Files Count="7">
|
<Files Count="11">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\run\JvCustomControls\JvTimeLine.pas"/>
|
<Filename Value="..\run\JvCustomControls\JvTimeLine.pas"/>
|
||||||
<UnitName Value="JvTimeLine"/>
|
<UnitName Value="JvTimeLine"/>
|
||||||
@ -47,6 +47,22 @@
|
|||||||
<Filename Value="..\run\JvCustomControls\JvThumbViews.pas"/>
|
<Filename Value="..\run\JvCustomControls\JvThumbViews.pas"/>
|
||||||
<UnitName Value="JvThumbViews"/>
|
<UnitName Value="JvThumbViews"/>
|
||||||
</Item7>
|
</Item7>
|
||||||
|
<Item8>
|
||||||
|
<Filename Value="..\run\JvCustomControls\JvCustomItemViewer.pas"/>
|
||||||
|
<UnitName Value="JvCustomItemViewer"/>
|
||||||
|
</Item8>
|
||||||
|
<Item9>
|
||||||
|
<Filename Value="..\run\JvCustomControls\JvImageListViewer.pas"/>
|
||||||
|
<UnitName Value="JvImageListViewer"/>
|
||||||
|
</Item9>
|
||||||
|
<Item10>
|
||||||
|
<Filename Value="..\run\JvCustomControls\JvImagesViewer.pas"/>
|
||||||
|
<UnitName Value="JvImagesViewer"/>
|
||||||
|
</Item10>
|
||||||
|
<Item11>
|
||||||
|
<Filename Value="..\run\JvCustomControls\JvOwnerDrawViewer.pas"/>
|
||||||
|
<UnitName Value="JvOwnerDrawViewer"/>
|
||||||
|
</Item11>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs Count="2">
|
<RequiredPkgs Count="2">
|
||||||
<Item1>
|
<Item1>
|
||||||
|
|||||||
Binary file not shown.
2027
components/jvcllaz/run/JvCustomControls/JvCustomItemViewer.pas
Normal file
2027
components/jvcllaz/run/JvCustomControls/JvCustomItemViewer.pas
Normal file
File diff suppressed because it is too large
Load Diff
344
components/jvcllaz/run/JvCustomControls/JvImageListViewer.pas
Normal file
344
components/jvcllaz/run/JvCustomControls/JvImageListViewer.pas
Normal file
@ -0,0 +1,344 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvImageListViewer.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:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvImageListViewer;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{.$I jvcl.inc}
|
||||||
|
{$MODE OBJFPC}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Controls, Graphics, StdCtrls, ComCtrls, ImgList,
|
||||||
|
JvCustomItemViewer;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvImageListViewerOptions = class(TJvCustomItemViewerOptions)
|
||||||
|
private
|
||||||
|
FDrawingStyle: TDrawingStyle;
|
||||||
|
FSelectedStyle: TDrawingStyle;
|
||||||
|
FFillCaption: Boolean;
|
||||||
|
FFrameSize: Word;
|
||||||
|
procedure SetDrawingStyle(const Value: TDrawingStyle);
|
||||||
|
procedure SetSelectedStyle(const Value: TDrawingStyle);
|
||||||
|
procedure SetFillCaption(const Value: Boolean);
|
||||||
|
procedure SetFrameSize(const Value: Word);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TJvCustomItemViewer); override;
|
||||||
|
published
|
||||||
|
property AutoCenter;
|
||||||
|
property BrushPattern;
|
||||||
|
property DragAutoScroll;
|
||||||
|
property DrawingStyle: TDrawingStyle read FDrawingStyle write SetDrawingStyle default dsTransparent;
|
||||||
|
property FillCaption: Boolean read FFillCaption write SetFillCaption default True;
|
||||||
|
property SelectedStyle: TDrawingStyle read FSelectedStyle write SetSelectedStyle default dsSelected;
|
||||||
|
property FrameSize: Word read FFrameSize write SetFrameSize default 1;
|
||||||
|
property Height;
|
||||||
|
property Layout;
|
||||||
|
property RightClickSelect;
|
||||||
|
property ScrollBar;
|
||||||
|
property ShowCaptions;
|
||||||
|
property Tracking;
|
||||||
|
property Width;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvImageListViewerCaptionEvent = procedure(Sender: TObject;
|
||||||
|
ImageIndex: Integer; var ACaption: WideString) of object;
|
||||||
|
|
||||||
|
TJvImageListViewer = class(TJvCustomItemViewer)
|
||||||
|
private
|
||||||
|
FChangeLink: TChangeLink;
|
||||||
|
FImages: TCustomImageList;
|
||||||
|
FOnGetCaption: TJvImageListViewerCaptionEvent;
|
||||||
|
procedure SetImages(const Value: TCustomImageList);
|
||||||
|
function GetOptions: TJvImageListViewerOptions;
|
||||||
|
procedure SetOptions(const Value: TJvImageListViewerOptions);
|
||||||
|
protected
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
procedure DoImageChange(Sender: TObject);
|
||||||
|
procedure DrawItem(Index: Integer; State: TCustomDrawState; ACanvas: TCanvas;
|
||||||
|
AItemRect, TextRect: TRect); override;
|
||||||
|
function GetOptionsClass: TJvItemViewerOptionsClass; override;
|
||||||
|
function GetCaption(ImageIndex: Integer): WideString; virtual;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
property Images: TCustomImageList read FImages write SetImages;
|
||||||
|
property Options: TJvImageListViewerOptions read GetOptions write SetOptions;
|
||||||
|
property SelectedIndex;
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
// property BiDiMode;
|
||||||
|
property BorderSpacing;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DockSite;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
// property ParentBiDiMode;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDockDrop;
|
||||||
|
property OnDockOver;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnGetCaption: TJvImageListViewerCaptionEvent read FOnGetCaption write FOnGetCaption;
|
||||||
|
property OnDrawItem;
|
||||||
|
property OnOptionsChanged;
|
||||||
|
property OnItemChanging;
|
||||||
|
property OnItemChanged;
|
||||||
|
property OnItemHint;
|
||||||
|
property OnGetSiteInfo;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUnDock;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
CommCtrl, LCLType, LCLProc, LCLIntf,
|
||||||
|
Math,
|
||||||
|
JvJCLUtils, JvJVCLUtils;
|
||||||
|
|
||||||
|
//=== { TJvImageListViewerOptions } ==========================================
|
||||||
|
|
||||||
|
constructor TJvImageListViewerOptions.Create(AOwner: TJvCustomItemViewer);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FDrawingStyle := dsTransparent;
|
||||||
|
FSelectedStyle := dsSelected;
|
||||||
|
FFillCaption := True;
|
||||||
|
FFrameSize := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewerOptions.SetDrawingStyle(const Value: TDrawingStyle);
|
||||||
|
begin
|
||||||
|
if FDrawingStyle <> Value then
|
||||||
|
begin
|
||||||
|
FDrawingStyle := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewerOptions.SetFillCaption(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FFillCaption <> Value then
|
||||||
|
begin
|
||||||
|
FFillCaption := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewerOptions.SetFrameSize(const Value: Word);
|
||||||
|
begin
|
||||||
|
if FFrameSize <> Value then
|
||||||
|
begin
|
||||||
|
FFrameSize := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewerOptions.SetSelectedStyle(const Value: TDrawingStyle);
|
||||||
|
begin
|
||||||
|
if FSelectedStyle <> Value then
|
||||||
|
begin
|
||||||
|
FSelectedStyle := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvImageListViewer } =================================================
|
||||||
|
|
||||||
|
constructor TJvImageListViewer.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FChangeLink := TChangeLink.Create;
|
||||||
|
FChangeLink.OnChange := @DoImageChange;
|
||||||
|
Color := clWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvImageListViewer.Destroy;
|
||||||
|
begin
|
||||||
|
Images := nil;
|
||||||
|
FChangeLink.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewer.DoImageChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Images <> nil then
|
||||||
|
Count := Images.Count
|
||||||
|
else
|
||||||
|
Count := 0;
|
||||||
|
Repaint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewer.DrawItem(Index: Integer; State: TCustomDrawState;
|
||||||
|
ACanvas: TCanvas; AItemRect, TextRect: TRect);
|
||||||
|
//const
|
||||||
|
// DrawingStyles: array [TDrawingStyle] of Cardinal =
|
||||||
|
// (ILD_FOCUS, ILD_SELECTED, ILD_NORMAL, ILD_TRANSPARENT);
|
||||||
|
// DrawMask: array [Boolean] of Cardinal =
|
||||||
|
// (ILD_MASK, ILD_NORMAL);
|
||||||
|
var
|
||||||
|
X, Y: Integer;
|
||||||
|
S: WideString;
|
||||||
|
DrawStyle: TDrawingStyle;
|
||||||
|
Flags: Cardinal;
|
||||||
|
begin
|
||||||
|
ACanvas.Brush.Color := Color;
|
||||||
|
ACanvas.Font := Self.Font;
|
||||||
|
if Images <> nil then
|
||||||
|
begin
|
||||||
|
Flags := DT_END_ELLIPSIS or DT_EDITCONTROL;
|
||||||
|
S := GetCaption(Index);
|
||||||
|
// determine where to draw image
|
||||||
|
X := Max(AItemRect.Left, AItemRect.Left + (RectWidth(AItemRect) - Images.Width) div 2);
|
||||||
|
Y := AItemRect.Top + (RectHeight(AItemRect) - Images.Height) div 2;
|
||||||
|
if not Options.FillCaption then
|
||||||
|
OffsetRect(TextRect,0,2);
|
||||||
|
if cdsSelected in State then
|
||||||
|
begin
|
||||||
|
if Options.BrushPattern.Active then
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Color := Options.BrushPattern.OddColor;
|
||||||
|
ACanvas.Brush.Bitmap := Options.BrushPattern.GetBitmap;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Color := Options.BrushPattern.OddColor;
|
||||||
|
ACanvas.Brush.Color := Options.BrushPattern.OddColor;
|
||||||
|
end;
|
||||||
|
if Options.FrameSize > 0 then
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Width := Options.FrameSize;
|
||||||
|
ACanvas.Rectangle(AItemRect);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ACanvas.FillRect(AItemRect);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ACanvas.Brush.Color := Color;
|
||||||
|
ACanvas.FillRect(AItemRect);
|
||||||
|
end;
|
||||||
|
if cdsSelected in Items[Index].State then
|
||||||
|
DrawStyle := {DrawingStyles[}Options.SelectedStyle{]}
|
||||||
|
else
|
||||||
|
DrawStyle := {DrawingStyles[}Options.DrawingStyle{]};
|
||||||
|
//ImageList_Draw(Images.Handle, Index, ACanvas.Handle, X, Y,
|
||||||
|
// DrawStyle or DrawMask[Images.ImageType = itImage]);
|
||||||
|
Images.Draw(ACanvas, X, Y, Index, DrawStyle, itImage);
|
||||||
|
if S <> '' then
|
||||||
|
begin
|
||||||
|
if cdsSelected in State then
|
||||||
|
begin
|
||||||
|
ACanvas.Brush.Color := clHighlight; // Options.BrushPattern.OddColor;
|
||||||
|
ACanvas.Font.Color := clHighlightText; // Options.BrushPattern.EvenColor;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
SetBkMode(ACanvas.Handle, {Windows.}TRANSPARENT);
|
||||||
|
if (Options.Layout <> tlCenter) and Options.FillCaption then
|
||||||
|
ACanvas.FillRect(TextRect)
|
||||||
|
else
|
||||||
|
S := ' ' + S + ' ';
|
||||||
|
ViewerDrawText(ACanvas, PWideChar(S), Length(S), TextRect, Flags, taCenter, tlCenter, True);
|
||||||
|
end;
|
||||||
|
// if not Options.BrushPattern.Active and (cdsSelected in State) then
|
||||||
|
// begin
|
||||||
|
// ACanvas.DrawFocusRect(AItemRect);
|
||||||
|
// end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImageListViewer.GetCaption(ImageIndex: Integer): WideString;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
if Assigned(FOnGetCaption) then
|
||||||
|
FOnGetCaption(Self, ImageIndex, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImageListViewer.GetOptions: TJvImageListViewerOptions;
|
||||||
|
begin
|
||||||
|
Result := TJvImageListViewerOptions(inherited Options);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImageListViewer.GetOptionsClass: TJvItemViewerOptionsClass;
|
||||||
|
begin
|
||||||
|
Result := TJvImageListViewerOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewer.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if (Operation = opRemove) and (AComponent = FImages) then
|
||||||
|
Images := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewer.SetImages(const Value: TCustomImageList);
|
||||||
|
begin
|
||||||
|
if FImages <> Value then
|
||||||
|
begin
|
||||||
|
ReplaceImageListReference(Self, Value, FImages, FChangeLink);
|
||||||
|
Count := 0;
|
||||||
|
if FImages <> nil then
|
||||||
|
begin
|
||||||
|
Options.Width := Max(Options.Width, FImages.Width);
|
||||||
|
Options.Height := Max(Options.Height, FImages.Height);
|
||||||
|
end;
|
||||||
|
DoImageChange(Value);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageListViewer.SetOptions(const Value: TJvImageListViewerOptions);
|
||||||
|
begin
|
||||||
|
inherited Options := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
691
components/jvcllaz/run/JvCustomControls/JvImagesViewer.pas
Normal file
691
components/jvcllaz/run/JvCustomControls/JvImagesViewer.pas
Normal file
@ -0,0 +1,691 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvImagesViewer.PAS, released on 2003-12-01.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is: Peter Thrnqvist
|
||||||
|
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:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvImagesViewer;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{.$I jvcl.inc}
|
||||||
|
{$MODE OBJFPC}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Controls, Graphics, StdCtrls, ComCtrls,
|
||||||
|
JvCustomItemViewer, FPImage;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TJvPictureItem }
|
||||||
|
|
||||||
|
TJvPictureItem = class(TJvViewerItem)
|
||||||
|
private
|
||||||
|
FFileName: String;
|
||||||
|
FPicture: TPicture;
|
||||||
|
FCaption: String;
|
||||||
|
procedure SetFileName(const Value: String);
|
||||||
|
procedure SetCaption(const Value: String);
|
||||||
|
procedure SetPicture(const Value: TPicture);
|
||||||
|
function GetPicture: TPicture;
|
||||||
|
procedure CreatePicture;
|
||||||
|
protected
|
||||||
|
procedure DoPictureChange(Sender: TObject); virtual;
|
||||||
|
procedure DoLoadProgress(Sender: TObject; Stage: TFPImgProgressStage;
|
||||||
|
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
|
||||||
|
const Msg: AnsiString; var Continue : Boolean); virtual;
|
||||||
|
procedure ReduceMemoryUsage; override;
|
||||||
|
public
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Refresh;
|
||||||
|
public
|
||||||
|
property FileName: String read FFileName write SetFileName;
|
||||||
|
property Picture: TPicture read GetPicture write SetPicture;
|
||||||
|
property Caption: String read FCaption write SetCaption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvImageViewerOptions = class(TJvCustomItemViewerOptions)
|
||||||
|
private
|
||||||
|
FImagePadding: Integer;
|
||||||
|
FFrameColor: TColor;
|
||||||
|
FHotFrameSize: Integer;
|
||||||
|
FHotColor: TColor;
|
||||||
|
FTransparent: Boolean;
|
||||||
|
procedure SetImagePadding(const Value: Integer);
|
||||||
|
procedure SetFrameColor(const Value: TColor);
|
||||||
|
procedure SetHotColor(const Value: TColor);
|
||||||
|
procedure SetHotFrameSize(const Value: Integer);
|
||||||
|
procedure SetTransparent(const Value: Boolean);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TJvCustomItemViewer); override;
|
||||||
|
published
|
||||||
|
property AutoCenter;
|
||||||
|
property Alignment;
|
||||||
|
property BrushPattern;
|
||||||
|
property DragAutoScroll;
|
||||||
|
property FrameColor: TColor read FFrameColor write SetFrameColor default clGray;
|
||||||
|
property Height;
|
||||||
|
property HorzSpacing;
|
||||||
|
property HotColor: TColor read FHotColor write SetHotColor default clHighlight;
|
||||||
|
property HotFrameSize: Integer read FHotFrameSize write SetHotFrameSize default 2;
|
||||||
|
property HotTrack;
|
||||||
|
property ImagePadding: Integer read FImagePadding write SetImagePadding default 8;
|
||||||
|
property Layout;
|
||||||
|
property LazyRead;
|
||||||
|
property MultiSelect;
|
||||||
|
property ReduceMemoryUsage;
|
||||||
|
property RightClickSelect;
|
||||||
|
property Transparent: Boolean read FTransparent write SetTransparent default False;
|
||||||
|
property ScrollBar;
|
||||||
|
property ShowCaptions default True;
|
||||||
|
property Tracking;
|
||||||
|
property VertSpacing;
|
||||||
|
property Width;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvImageLoadEvent = procedure(Sender: TObject; Item: TJvPictureItem) of object;
|
||||||
|
TJvImageLoadErrorEvent = procedure(Sender: TObject; E: Exception;
|
||||||
|
const FileName: String; var Handled: Boolean) of object;
|
||||||
|
TJvImageViewerLoadProgress = procedure(Sender: TObject; Item: TJvPictureItem; Stage: TProgressStage;
|
||||||
|
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object;
|
||||||
|
|
||||||
|
TJvImagesViewer = class(TJvCustomItemViewer)
|
||||||
|
private
|
||||||
|
FFileMask: String;
|
||||||
|
FDirectory: String;
|
||||||
|
FOnLoadError: TJvImageLoadErrorEvent;
|
||||||
|
FOnLoadProgress: TJvImageViewerLoadProgress;
|
||||||
|
FOnLoadBegin: TNotifyEvent;
|
||||||
|
FOnLoadEnd: TNotifyEvent;
|
||||||
|
procedure SetDirectory(const Value: String);
|
||||||
|
procedure SetFileMask(const Value: String);
|
||||||
|
function GetItems(Index: Integer): TJvPictureItem;
|
||||||
|
procedure ExpandFileMask(const Mask: String; Strings: TStrings);
|
||||||
|
function ScaleRect(ARect, RefRect: TRect): TRect;
|
||||||
|
function GetOptions: TJvImageViewerOptions;
|
||||||
|
procedure SetOptions(const Value: TJvImageViewerOptions);
|
||||||
|
protected
|
||||||
|
function GetItemClass: TJvViewerItemClass; override;
|
||||||
|
function GetOptionsClass: TJvItemViewerOptionsClass; override;
|
||||||
|
function LoadErrorHandled(E: Exception; const FileName: String): Boolean;
|
||||||
|
procedure DoLoadBegin; virtual;
|
||||||
|
procedure DoLoadProgress(Item: TJvPictureItem; Stage: TProgressStage; PercentDone: Byte;
|
||||||
|
RedrawNow: Boolean; const R: TRect; const Msg: String);
|
||||||
|
procedure DoLoadEnd; virtual;
|
||||||
|
procedure DrawItem(Index: Integer; State: TCustomDrawState; ACanvas: TCanvas;
|
||||||
|
AItemRect, TextRect: TRect); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
function LoadImages: Boolean;virtual;
|
||||||
|
procedure CustomSort(Compare: TListSortCompare); override;
|
||||||
|
|
||||||
|
property Items[Index: Integer]: TJvPictureItem read GetItems;
|
||||||
|
property Count;
|
||||||
|
published
|
||||||
|
property Directory: String read FDirectory write SetDirectory;
|
||||||
|
property FileMask: String read FFileMask write SetFileMask;
|
||||||
|
property Options: TJvImageViewerOptions read GetOptions write SetOptions;
|
||||||
|
property SelectedIndex;
|
||||||
|
property OnScroll;
|
||||||
|
property OnLoadBegin: TNotifyEvent read FOnLoadBegin write FOnLoadBegin;
|
||||||
|
property OnLoadEnd: TNotifyEvent read FOnLoadEnd write FOnLoadEnd;
|
||||||
|
property OnLoadError: TJvImageLoadErrorEvent read FOnLoadError write FOnLoadError;
|
||||||
|
property OnLoadProgress: TJvImageViewerLoadProgress read FOnLoadProgress write FOnLoadProgress;
|
||||||
|
property OnDrawItem;
|
||||||
|
property OnOptionsChanged;
|
||||||
|
property OnItemChanging;
|
||||||
|
property OnItemChanged;
|
||||||
|
property OnItemHint;
|
||||||
|
property OnInsertion;
|
||||||
|
property OnDeletion;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
// property BiDiMode;
|
||||||
|
property BorderSpacing;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DockSite;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
// property ParentBiDiMode;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDockDrop;
|
||||||
|
property OnDockOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnGetSiteInfo;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnUnDock;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
JvJCLUtils, LCLIntf, LCLType;
|
||||||
|
|
||||||
|
//=== { TJvImageViewerOptions } ==============================================
|
||||||
|
|
||||||
|
constructor TJvImageViewerOptions.Create(AOwner: TJvCustomItemViewer);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FImagePadding := 20;
|
||||||
|
FFrameColor := clGray;
|
||||||
|
FHotColor := clHighlight;
|
||||||
|
FHotFrameSize := 2;
|
||||||
|
ShowCaptions := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageViewerOptions.SetFrameColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
if FFrameColor <> Value then
|
||||||
|
begin
|
||||||
|
FFrameColor := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageViewerOptions.SetHotColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
FHotColor := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageViewerOptions.SetHotFrameSize(const Value: Integer);
|
||||||
|
begin
|
||||||
|
FHotFrameSize := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageViewerOptions.SetImagePadding(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FImagePadding <> Value then
|
||||||
|
begin
|
||||||
|
FImagePadding := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImageViewerOptions.SetTransparent(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FTransparent <> Value then
|
||||||
|
begin
|
||||||
|
FTransparent := Value;
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvPictureItem } =====================================================
|
||||||
|
|
||||||
|
destructor TJvPictureItem.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FPicture);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.CreatePicture;
|
||||||
|
var
|
||||||
|
S: String;
|
||||||
|
begin
|
||||||
|
if FPicture = nil then
|
||||||
|
begin
|
||||||
|
FPicture := TPicture.Create;
|
||||||
|
FPicture.OnChange := @DoPictureChange;
|
||||||
|
FPicture.OnProgress := @DoLoadProgress;
|
||||||
|
S := ExpandUNCFileName(FileName);
|
||||||
|
if (S <> '') and FileExists(S) then
|
||||||
|
try
|
||||||
|
FPicture.LoadFromFile(S);
|
||||||
|
if FPicture.Graphic <> nil then
|
||||||
|
FPicture.Graphic.Transparent := TJvImagesViewer(Owner).Options.Transparent;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
if not TJvImagesViewer(Owner).LoadErrorHandled(E, FileName) then
|
||||||
|
raise
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Delete;
|
||||||
|
FreeAndNil(FPicture);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.DoPictureChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.DoLoadProgress(Sender: TObject;
|
||||||
|
Stage: TFPImgProgressStage; PercentDone: Byte; RedrawNow: Boolean;
|
||||||
|
const R: TRect; const Msg: AnsiString; var Continue: Boolean);
|
||||||
|
begin
|
||||||
|
if Owner is TJvImagesViewer then
|
||||||
|
TJvImagesViewer(Owner).DoLoadProgress(Self, Stage, PercentDone, RedrawNow, R, Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvPictureItem.GetPicture: TPicture;
|
||||||
|
begin
|
||||||
|
CreatePicture;
|
||||||
|
Result := FPicture;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.SetFileName(const Value: String);
|
||||||
|
begin
|
||||||
|
if (AnsiCompareFileName(FFileName, Value) <> 0) and Changing then
|
||||||
|
begin
|
||||||
|
FFileName := Value;
|
||||||
|
// don't load image until .Picture is used
|
||||||
|
FreeAndNil(FPicture);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.SetPicture(const Value: TPicture);
|
||||||
|
begin
|
||||||
|
if Changing then
|
||||||
|
begin
|
||||||
|
if Value <> nil then
|
||||||
|
GetPicture.Assign(Value)
|
||||||
|
else
|
||||||
|
if Assigned(FPicture) then
|
||||||
|
begin
|
||||||
|
FreeAndNil(FPicture);
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.SetCaption(const Value: String);
|
||||||
|
begin
|
||||||
|
if (FCaption <> Value) and Changing then
|
||||||
|
begin
|
||||||
|
FCaption := Value;
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.ReduceMemoryUsage;
|
||||||
|
begin
|
||||||
|
inherited ReduceMemoryUsage;
|
||||||
|
if FileName <> '' then // release image if we can recreate it from it's filename
|
||||||
|
Picture := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvPictureItem.Refresh;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FPicture);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvImagesViewer } ====================================================
|
||||||
|
|
||||||
|
constructor TJvImagesViewer.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
// FDirectory := GetCurrentDir;
|
||||||
|
FFileMask := Graphics.GraphicFileMask(TGraphic);
|
||||||
|
Color := clWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.ScaleRect(ARect, RefRect: TRect): TRect;
|
||||||
|
var
|
||||||
|
w, h, cw, ch: Integer;
|
||||||
|
XYAspect: Double;
|
||||||
|
begin
|
||||||
|
w := ARect.Right - ARect.Left;
|
||||||
|
h := ARect.Bottom - ARect.Top;
|
||||||
|
cw := RefRect.Right - RefRect.Left;
|
||||||
|
ch := RefRect.Bottom - RefRect.Top;
|
||||||
|
|
||||||
|
if (w > cw) or (h > ch) then
|
||||||
|
begin
|
||||||
|
if (w > 0) and (h > 0) then
|
||||||
|
begin
|
||||||
|
XYAspect := w / h;
|
||||||
|
if w > h then
|
||||||
|
begin
|
||||||
|
w := cw;
|
||||||
|
h := Trunc(cw / XYAspect);
|
||||||
|
if h > ch then
|
||||||
|
begin
|
||||||
|
h := ch;
|
||||||
|
w := Trunc(ch * XYAspect);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
h := ch;
|
||||||
|
w := Trunc(ch * XYAspect);
|
||||||
|
if w > cw then
|
||||||
|
begin
|
||||||
|
w := cw;
|
||||||
|
h := Trunc(cw / XYAspect);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
w := cw;
|
||||||
|
h := ch;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
with Result do
|
||||||
|
begin
|
||||||
|
Left := 0;
|
||||||
|
Top := 0;
|
||||||
|
Right := w;
|
||||||
|
Bottom := h;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.DrawItem(Index: Integer; State: TCustomDrawState;
|
||||||
|
ACanvas: TCanvas; AItemRect, TextRect: TRect);
|
||||||
|
var
|
||||||
|
ImageRect: TRect;
|
||||||
|
TotalPadding, BottomRightShift: Integer;
|
||||||
|
AItem: TJvPictureItem;
|
||||||
|
S: String;
|
||||||
|
|
||||||
|
procedure ModifyRect(var R: TRect; ALeft, ATop, ARight, ABottom: Integer);
|
||||||
|
begin
|
||||||
|
Inc(R.Left, ALeft);
|
||||||
|
Inc(R.Top, ATop);
|
||||||
|
Inc(R.Right, ARight);
|
||||||
|
Inc(R.Bottom, ABottom);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
inherited DrawItem(Index, State, ACanvas, AItemRect, TextRect);
|
||||||
|
//{$IFDEF MSWINDOWS}
|
||||||
|
//if Win32Platform = VER_PLATFORM_WIN32_NT then
|
||||||
|
// BottomRightShift := 1
|
||||||
|
//else
|
||||||
|
//{$ENDIF MSWINDOWS}
|
||||||
|
BottomRightShift := 0;
|
||||||
|
AItem := Items[Index];
|
||||||
|
ACanvas.Font := Font;
|
||||||
|
ACanvas.Brush.Color := Color;
|
||||||
|
ACanvas.Pen.Color := Font.Color;
|
||||||
|
TotalPadding := Options.ImagePadding;
|
||||||
|
if Options.ShowCaptions then
|
||||||
|
begin
|
||||||
|
Dec(AItemRect.Bottom, 2);
|
||||||
|
Inc(TextRect.Top, 2);
|
||||||
|
S := AItem.Caption;
|
||||||
|
if S = '' then
|
||||||
|
S := ExtractFileName(AItem.FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if cdsHot in State then
|
||||||
|
begin
|
||||||
|
ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline];
|
||||||
|
ACanvas.Font.Color := clHighlight;
|
||||||
|
ACanvas.Pen.Color := Options.HotColor;
|
||||||
|
ACanvas.Pen.Width := Options.HotFrameSize;
|
||||||
|
ACanvas.Brush.Style := bsClear;
|
||||||
|
ModifyRect(AItemRect,Options.HotFrameSize div 2,Options.HotFrameSize div 2,
|
||||||
|
-Options.HotFrameSize div 2 + BottomRightShift,-Options.HotFrameSize div 2 + BottomRightShift);
|
||||||
|
ACanvas.Rectangle(AItemRect);
|
||||||
|
ModifyRect(AItemRect,-Options.HotFrameSize div 2,-Options.HotFrameSize div 2,
|
||||||
|
Options.HotFrameSize div 2 - BottomRightShift,Options.HotFrameSize div 2 - BottomRightShift);
|
||||||
|
ACanvas.Brush.Style := bsSolid;
|
||||||
|
SetBkMode(ACanvas.Handle, {Windows.}TRANSPARENT);
|
||||||
|
ACanvas.Pen.Width := 1;
|
||||||
|
end;
|
||||||
|
if cdsSelected in State then
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Color := clBtnFace;
|
||||||
|
ACanvas.Brush.Color := clHighlight;
|
||||||
|
if Options.BrushPattern.Active then
|
||||||
|
ACanvas.Brush.Bitmap := Options.BrushPattern.GetBitmap
|
||||||
|
else
|
||||||
|
ACanvas.Brush.Color := Options.BrushPattern.OddColor;
|
||||||
|
ACanvas.Rectangle(AItemRect);
|
||||||
|
ACanvas.Brush.Bitmap := nil;
|
||||||
|
ACanvas.Brush.Style := bsClear;
|
||||||
|
ACanvas.Pen.Color := Options.HotColor;
|
||||||
|
ACanvas.Pen.Width := Options.HotFrameSize;
|
||||||
|
ModifyRect(AItemRect,Options.HotFrameSize div 2, Options.HotFrameSize div 2,
|
||||||
|
-Options.HotFrameSize div 2 + BottomRightShift, -Options.HotFrameSize div 2 + BottomRightShift);
|
||||||
|
ACanvas.Rectangle(AItemRect);
|
||||||
|
ModifyRect(AItemRect,-Options.HotFrameSize div 2, -Options.HotFrameSize div 2,
|
||||||
|
Options.HotFrameSize div 2 - BottomRightShift, Options.HotFrameSize div 2 - BottomRightShift);
|
||||||
|
ACanvas.Font.Color := clHighlightText;
|
||||||
|
ACanvas.Brush.Style := bsSolid;
|
||||||
|
ACanvas.Brush.Color := clHighlight;
|
||||||
|
ACanvas.Pen.Width := 1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (Options.FrameColor <> clNone) and not (cdsHot in State) then
|
||||||
|
begin
|
||||||
|
ACanvas.Brush.Color := Options.FrameColor;
|
||||||
|
ACanvas.FrameRect(AItemRect);
|
||||||
|
SetBkMode(ACanvas.Handle, {Windows.}TRANSPARENT);
|
||||||
|
end;
|
||||||
|
// make space around image
|
||||||
|
InflateRect(AItemRect, -TotalPadding, -TotalPadding);
|
||||||
|
if AItem.Picture <> nil then // access Picture to load image
|
||||||
|
begin
|
||||||
|
ImageRect := Rect(0, 0, AItem.Picture.Width, AItem.Picture.Height);
|
||||||
|
ImageRect := CenterRect(ScaleRect(ImageRect, AItemRect), AItemRect);
|
||||||
|
if (RectWidth(ImageRect) > 0) and (RectHeight(ImageRect) > 0) then
|
||||||
|
{if AItem.Picture.Graphic is TIcon then
|
||||||
|
// and (RectWidth(ImageRect) < RectWidth(R)) and (RectHeight(ImageRect) < RectHeight(R)) then
|
||||||
|
// TIcon doesn't scale it's content
|
||||||
|
DrawIconEx(ACanvas.Handle, ImageRect.Left, ImageRect.Top, AItem.Picture.Icon.Handle,
|
||||||
|
ImageRect.Right - ImageRect.Left, ImageRect.Bottom - ImageRect.Top, 0, 0, DI_NORMAL)
|
||||||
|
else}
|
||||||
|
ACanvas.StretchDraw(ImageRect, AItem.Picture.Graphic);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Options.ShowCaptions and (S <> '') then
|
||||||
|
begin
|
||||||
|
if Options.Layout = tlCenter then
|
||||||
|
S := ' ' + S + ' ';
|
||||||
|
ViewerDrawText(ACanvas, S, Length(S),
|
||||||
|
TextRect, DT_END_ELLIPSIS or DT_EDITCONTROL, Options.Alignment, tlCenter, False);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.GetItems(Index: Integer): TJvPictureItem;
|
||||||
|
begin
|
||||||
|
Result := TJvPictureItem(inherited Items[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.GetItemClass: TJvViewerItemClass;
|
||||||
|
begin
|
||||||
|
Result := TJvPictureItem;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.LoadImages: Boolean;
|
||||||
|
var
|
||||||
|
I, J: Integer;
|
||||||
|
F: TSearchRec;
|
||||||
|
Files, FileMasks: TStringList;
|
||||||
|
TmpDir: String;
|
||||||
|
begin
|
||||||
|
BeginUpdate;
|
||||||
|
try
|
||||||
|
Count := 0;
|
||||||
|
TmpDir := ExpandUNCFileName(Directory);
|
||||||
|
FileMasks := TStringList.Create;
|
||||||
|
try
|
||||||
|
FileMasks.Sorted := True; // make sure no duplicates are added
|
||||||
|
ExpandFileMask(FileMask, FileMasks);
|
||||||
|
if TmpDir <> '' then
|
||||||
|
TmpDir := IncludeTrailingPathDelimiter(TmpDir);
|
||||||
|
DoLoadBegin;
|
||||||
|
Files := TStringList.Create;
|
||||||
|
try
|
||||||
|
Files.Sorted := True;
|
||||||
|
for I := 0 to FileMasks.Count - 1 do
|
||||||
|
begin
|
||||||
|
if SysUtils.FindFirst(TmpDir + FileMasks[I], faAnyFile, F) = 0 then
|
||||||
|
try
|
||||||
|
repeat
|
||||||
|
if F.Attr and faDirectory = 0 then
|
||||||
|
Files.Add(TmpDir + F.Name);
|
||||||
|
until SysUtils.FindNext(F) <> 0;
|
||||||
|
Count := Files.Count;
|
||||||
|
J := 0;
|
||||||
|
while J < Files.Count do
|
||||||
|
begin
|
||||||
|
Items[J].FileName := Files[J];
|
||||||
|
Inc(J);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SysUtils.FindClose(F);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Files.Free;
|
||||||
|
end;
|
||||||
|
DoLoadEnd;
|
||||||
|
finally
|
||||||
|
FileMasks.Free;
|
||||||
|
end;
|
||||||
|
Result := Count > 0;
|
||||||
|
finally
|
||||||
|
EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.SetDirectory(const Value: String);
|
||||||
|
begin
|
||||||
|
if FDirectory <> Value then
|
||||||
|
begin
|
||||||
|
FDirectory := Value;
|
||||||
|
LoadImages;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.SetFileMask(const Value: String);
|
||||||
|
begin
|
||||||
|
if FFileMask <> Value then
|
||||||
|
begin
|
||||||
|
FFileMask := Value;
|
||||||
|
LoadImages;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.ExpandFileMask(const Mask: String;
|
||||||
|
Strings: TStrings);
|
||||||
|
var
|
||||||
|
Start, Current: PChar;
|
||||||
|
TmpChar: Char;
|
||||||
|
begin
|
||||||
|
Current := PChar(string(Mask));
|
||||||
|
Start := Current;
|
||||||
|
while (Current <> nil) and (Current^ <> #0) do
|
||||||
|
begin
|
||||||
|
if CharInSet(Current^, [',', ';']) then
|
||||||
|
begin
|
||||||
|
TmpChar := Current^;
|
||||||
|
Current^ := #0;
|
||||||
|
if Start <> '' then
|
||||||
|
Strings.Add(Start);
|
||||||
|
Current^ := TmpChar;
|
||||||
|
Start := Current + 1;
|
||||||
|
end;
|
||||||
|
Inc(Current);
|
||||||
|
end;
|
||||||
|
if Start <> '' then
|
||||||
|
Strings.Add(Start);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.LoadErrorHandled(E: Exception; const FileName: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Assigned(FOnLoadError) then
|
||||||
|
FOnLoadError(Self, E, FileName, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.DoLoadBegin;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnLoadBegin) then
|
||||||
|
FOnLoadBegin(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.DoLoadProgress(Item: TJvPictureItem;
|
||||||
|
Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
|
||||||
|
const R: TRect; const Msg: String);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnLoadProgress) then
|
||||||
|
FOnLoadProgress(Self, Item, Stage, PercentDone, RedrawNow, R, Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.DoLoadEnd;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnLoadEnd) then
|
||||||
|
FOnLoadEnd(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.GetOptionsClass: TJvItemViewerOptionsClass;
|
||||||
|
begin
|
||||||
|
Result := TJvImageViewerOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvImagesViewer.GetOptions: TJvImageViewerOptions;
|
||||||
|
begin
|
||||||
|
Result := TJvImageViewerOptions(inherited Options);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.SetOptions(const Value: TJvImageViewerOptions);
|
||||||
|
begin
|
||||||
|
inherited Options := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SortByFilename(Item1, Item2:Pointer):integer;
|
||||||
|
begin
|
||||||
|
Result := AnsiCompareFileName(TJvPictureItem(Item1).Filename, TJvPictureItem(Item2).Filename);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvImagesViewer.CustomSort(Compare: TListSortCompare);
|
||||||
|
begin
|
||||||
|
if Assigned(Compare) then
|
||||||
|
inherited CustomSort(Compare)
|
||||||
|
else
|
||||||
|
inherited CustomSort(@SortByFilename);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
143
components/jvcllaz/run/JvCustomControls/JvOwnerDrawViewer.pas
Normal file
143
components/jvcllaz/run/JvCustomControls/JvOwnerDrawViewer.pas
Normal file
@ -0,0 +1,143 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvOwnerDrawViewer.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:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvOwnerDrawViewer;
|
||||||
|
|
||||||
|
{.$I jvcl.inc}
|
||||||
|
{$MODE OBJFPC}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, Graphics, JvCustomItemViewer;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvOwnerDrawViewerOptions = class(TJvCustomItemViewerOptions)
|
||||||
|
published
|
||||||
|
property Alignment;
|
||||||
|
property AutoCenter;
|
||||||
|
property BrushPattern;
|
||||||
|
property DragAutoScroll;
|
||||||
|
property Height;
|
||||||
|
property HorzSpacing;
|
||||||
|
property HotTrack;
|
||||||
|
property Layout;
|
||||||
|
property LazyRead;
|
||||||
|
property MultiSelect;
|
||||||
|
property RightClickSelect;
|
||||||
|
property ScrollBar;
|
||||||
|
property ShowCaptions;
|
||||||
|
property Smooth;
|
||||||
|
property Tracking;
|
||||||
|
property VertSpacing;
|
||||||
|
property Width;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvOwnerDrawViewer = class(TJvCustomItemViewer)
|
||||||
|
private
|
||||||
|
function GetOptions: TJvOwnerDrawViewerOptions;
|
||||||
|
procedure SetOptions(const Value: TJvOwnerDrawViewerOptions);
|
||||||
|
protected
|
||||||
|
function GetOptionsClass: TJvItemViewerOptionsClass; override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
property Count;
|
||||||
|
property Items;
|
||||||
|
published
|
||||||
|
property Options: TJvOwnerDrawViewerOptions read GetOptions write SetOptions;
|
||||||
|
property SelectedIndex;
|
||||||
|
property OnDrawItem;
|
||||||
|
property OnOptionsChanged;
|
||||||
|
property OnItemChanging;
|
||||||
|
property OnItemChanged;
|
||||||
|
property OnItemHint;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
// property BiDiMode;
|
||||||
|
property BorderSpacing;
|
||||||
|
property Color;
|
||||||
|
property Constraints;
|
||||||
|
property DockSite;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
// property ParentBiDiMode;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDockDrop;
|
||||||
|
property OnDockOver;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnGetSiteInfo;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnUnDock;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
constructor TJvOwnerDrawViewer.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
Color := clWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvOwnerDrawViewer.GetOptions: TJvOwnerDrawViewerOptions;
|
||||||
|
begin
|
||||||
|
Result := TJvOwnerDrawViewerOptions(inherited Options);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvOwnerDrawViewer.GetOptionsClass: TJvItemViewerOptionsClass;
|
||||||
|
begin
|
||||||
|
Result := TJvOwnerDrawViewerOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvOwnerDrawViewer.SetOptions(const Value: TJvOwnerDrawViewerOptions);
|
||||||
|
begin
|
||||||
|
inherited Options := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user