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,
|
||||
// JvTabBar, JvTabBarXPPainter,
|
||||
JvThumbImage, JvThumbnails, JvThumbViews,
|
||||
JvTimeLine, JvTMTimeLine, JvTimeLineEditor;
|
||||
JvTimeLine, JvTMTimeLine, JvTimeLineEditor,
|
||||
JvImagesViewer, JvImageListViewer, JvOwnerDrawViewer;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
@ -28,7 +29,8 @@ begin
|
||||
TJvOutlookBar,
|
||||
TJvThumbView, TJvThumbnail, TJvThumbImage,
|
||||
TJvTimeLine,
|
||||
TJvTMTimeLine
|
||||
TJvTMTimeLine,
|
||||
TJvImagesViewer, TJvImageListViewer, TJvOwnerDrawViewer
|
||||
]);
|
||||
|
||||
// Timeline
|
||||
|
||||
@ -7,3 +7,6 @@ tjvtmtimeline.bmp
|
||||
tjvthumbnail.bmp
|
||||
tjvthumbimage.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. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="7">
|
||||
<Files Count="11">
|
||||
<Item1>
|
||||
<Filename Value="..\run\JvCustomControls\JvTimeLine.pas"/>
|
||||
<UnitName Value="JvTimeLine"/>
|
||||
@ -47,6 +47,22 @@
|
||||
<Filename Value="..\run\JvCustomControls\JvThumbViews.pas"/>
|
||||
<UnitName Value="JvThumbViews"/>
|
||||
</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>
|
||||
<RequiredPkgs Count="2">
|
||||
<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