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
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.
|
||||
Reference in New Issue
Block a user