pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Add thumbnail components (incl demo).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6264 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-03-23 00:10:05 +00:00
parent 5aa89cc915
commit c3a0621532
22 changed files with 6230 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/jvcllaz/design/JvCore/JvDsgnConsts.pas
View File

@ -565,10 +565,11 @@ resourcestring
resourcestring
RsEFmtInterfaceNotSupported = '%s does not support the required interface (%s)';
RsPageListEditorEllipsis = 'Page List Editor...';
RsNextPageAmp = 'Ne&xt Page';
RsPrevPage = '&Previous Page';
RsNewPage = '&New Page';
RsDelPage = '&Delete Page';
RsNextPageAmp = 'Ne&xt page';
RsPrevPage = '&Previous page';
RsNewPage = '&New page';
RsDelPage = '&Delete page';
RsShowPage = 'Show page';
//=== JvPageManagerForm.pas ==================================================
resourcestring

3
components/jvcllaz/design/JvCustomControls/images/images.txt
View File

@ -4,3 +4,6 @@ Tjvtabbarxppainter.bmp
tjvoutlookbar.bmp
tjvtimeline.bmp
tjvtmtimeline.bmp
tjvthumbnail.bmp
tjvthumbimage.bmp
tjvthumbview.bmp

BIN
components/jvcllaz/design/JvCustomControls/images/tjvthumbimage.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
components/jvcllaz/design/JvCustomControls/images/tjvthumbnail.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
components/jvcllaz/design/JvCustomControls/images/tjvthumbview.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

2
components/jvcllaz/design/JvCustomControls/jvcustomreg.pas
View File

@ -18,6 +18,7 @@ uses
JvDsgnConsts,
JvOutlookBar, JvOutlookBarEditors,
JvTabBar, JvTabBarXPPainter,
JvThumbImage, JvThumbnails, JvThumbViews,
JvTimeLine, JvTMTimeline, JvTimeLineEditor;
procedure Register;
@ -25,6 +26,7 @@ begin
RegisterComponents(RsPaletteJvcl, [
TJvTabBar, TJvModernTabBarPainter, TJvTabBarXPPainter,
TJvOutlookBar,
TJvThumbView, TJvThumbnail, TJvThumbImage,
TJvTimeLine,
TJvTMTimeLine
]);

4
components/jvcllaz/design/JvCustomControls/jvoutlookbareditors.pas
View File

@ -31,9 +31,9 @@ interface
uses
SysUtils, Classes,
Windows, Controls, Forms, ToolWin,
Controls, Forms, ToolWin,
Menus, ActnList, ComCtrls, ImgList,
PropEdits, GraphPropEdits,ComponentEditors,
PropEdits, GraphPropEdits, ComponentEditors,
// DesignEditors, DesignIntf, DesignMenus, DesignWindows,
//JvDsgnEditors,
JvOutlookBar;

461
components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.lfm Normal file
View File

@ -0,0 +1,461 @@
object JvThumbnailChildForm: TJvThumbnailChildForm
Left = 367
Height = 529
Top = 149
Width = 770
Caption = 'JvThumbNail Demo'
ClientHeight = 529
ClientWidth = 770
Color = clBtnFace
Font.Color = clWindowText
OnShow = FormShow
LCLVersion = '1.9.0.0'
object Splitter2: TSplitter
Left = 238
Height = 529
Top = 0
Width = 3
end
object Panel6: TPanel
Left = 0
Height = 529
Top = 0
Width = 238
Align = alLeft
ClientHeight = 529
ClientWidth = 238
TabOrder = 0
object Splitter4: TSplitter
Cursor = crVSplit
Left = 1
Height = 3
Top = 121
Width = 236
Align = alTop
ResizeAnchor = akTop
end
object ShellTreeView: TShellTreeView
Left = 1
Height = 120
Top = 1
Width = 236
Align = alTop
BackgroundColor = clDefault
Color = clDefault
FileSortType = fstNone
HideSelection = False
ReadOnly = True
TabOrder = 0
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
ObjectTypes = [otFolders]
ShellListView = ShellListView
end
object ShellListView: TShellListView
Left = 1
Height = 168
Top = 147
Width = 236
Align = alClient
Color = clDefault
HideSelection = False
Mask = '*.ICO;*.BMP;*.EMF;*.WMF;*.JPG;*.JPEG;'
ReadOnly = True
TabOrder = 1
OnChange = ShellListViewChange
ObjectTypes = [otNonFolders]
ShellTreeView = ShellTreeView
end
object Panel8: TPanel
Left = 1
Height = 213
Top = 315
Width = 236
Align = alBottom
BevelOuter = bvNone
ClientHeight = 213
ClientWidth = 236
TabOrder = 2
OnResize = Panel8Resize
object Label6: TLabel
Left = 8
Height = 13
Top = 0
Width = 226
Alignment = taCenter
AutoSize = False
Caption = 'RED'
Color = clRed
Font.Color = clWhite
Font.Height = -11
Font.Name = 'MS Sans Serif'
ParentColor = False
ParentFont = False
Transparent = False
end
object Label7: TLabel
Left = 8
Height = 14
Top = 45
Width = 226
Alignment = taCenter
AutoSize = False
Caption = 'GREEN'
Color = clLime
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
ParentColor = False
ParentFont = False
Transparent = False
end
object Label8: TLabel
Left = 7
Height = 14
Top = 89
Width = 226
Alignment = taCenter
AutoSize = False
Caption = 'BLUE'
Color = clBlue
Font.Color = clWhite
Font.Height = -11
Font.Name = 'MS Sans Serif'
ParentColor = False
ParentFont = False
Transparent = False
end
object Label9: TLabel
Left = 6
Height = 14
Top = 137
Width = 91
Alignment = taCenter
AutoSize = False
Caption = 'CONTRAST'
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
ParentColor = False
ParentFont = False
end
object Label1: TLabel
Left = 134
Height = 14
Top = 137
Width = 91
Alignment = taCenter
AutoSize = False
Caption = 'LIGHTNESS'
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
ParentColor = False
ParentFont = False
end
object REDBar: TTrackBar
Left = 0
Height = 29
Top = 13
Width = 241
Frequency = 51
Max = 255
Min = -255
PageSize = 20
Position = 0
TickStyle = tsNone
TabOrder = 0
end
object GreenBar: TTrackBar
Left = 0
Height = 30
Top = 59
Width = 241
Frequency = 51
Max = 255
Min = -255
PageSize = 20
Position = 0
TickStyle = tsNone
TabOrder = 1
end
object BlueBar: TTrackBar
Left = -1
Height = 30
Top = 107
Width = 241
Frequency = 51
Max = 255
Min = -255
PageSize = 20
Position = 0
TickStyle = tsNone
TabOrder = 2
end
object contrastBar: TTrackBar
Left = -1
Height = 30
Top = 152
Width = 106
Frequency = 51
Max = 100
Min = -100
PageSize = 20
Position = 0
TickStyle = tsNone
TabOrder = 3
end
object Button2: TButton
Left = 8
Height = 25
Top = 184
Width = 225
Caption = 'APPLY'
OnClick = Button2Click
TabOrder = 4
end
object LightnessBar: TTrackBar
Left = 127
Height = 30
Top = 152
Width = 106
Frequency = 51
Max = 100
Min = -100
PageSize = 20
Position = 0
TickStyle = tsNone
TabOrder = 5
end
end
object Panel10: TPanel
Left = 1
Height = 23
Top = 124
Width = 236
Align = alTop
BevelOuter = bvNone
Caption = 'Panel10'
ClientHeight = 23
ClientWidth = 236
TabOrder = 3
OnResize = Panel10Resize
object FilterComboBox1: TFilterComboBox
Left = 2
Height = 23
Top = 0
Width = 235
Filter = 'All Known Formats|*.ICO;*.BMP;*.EMF;*.WMF;*.JPG;*.JPEG;|All Files (*.*)|*.*|JPEG Files|*.JPG;*.JPEG;|BMP Files|*.BMP|WMF Files|*.WMF|EMF Files |*.EMF|ICONS |*.ICO'
ItemIndex = 0
ShellListView = ShellListView
TabOrder = 0
end
end
end
object Panel7: TPanel
Left = 241
Height = 529
Top = 0
Width = 529
Align = alClient
ClientHeight = 529
ClientWidth = 529
TabOrder = 1
object ThumbImage1: TJvThumbImage
Left = 1
Height = 376
Top = 144
Width = 518
AutoSize = True
IgnoreMouse = False
Angle = AT0
Zoom = 0
end
object Panel5: TPanel
Left = 1
Height = 144
Top = 1
Width = 527
Align = alTop
ClientHeight = 144
ClientWidth = 527
TabOrder = 0
object Bevel1: TBevel
Left = 156
Height = 137
Top = 3
Width = 232
end
object Label5: TLabel
Left = 161
Height = 13
Hint = 'You can set the thumbnails title to what ever you want it to be '
Top = 100
Width = 193
AutoSize = False
Caption = 'Thumbnails Title'
ParentColor = False
end
object CbAsButton: TCheckBox
Left = 161
Height = 19
Hint = 'This will give a button effect when the thumbnail is clicked '
Top = 7
Width = 69
Caption = 'AsButton'
Checked = True
OnClick = CbAsButtonClick
State = cbChecked
TabOrder = 0
end
object CbAutoLoad: TCheckBox
Left = 161
Height = 19
Hint = 'If AutoLoad = true when you pass a name to the filename it automatically loads it else not(for Future reference where the will be a thumblist file)'
Top = 31
Width = 69
Caption = 'Autoload'
Checked = True
OnClick = CbAutoLoadClick
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 1
end
object CbMinimizeMem: TCheckBox
Left = 161
Height = 19
Hint = 'This will forse the thumbimage to convert all the thumbs in BMP and reduce memory usage us much as possible'
Top = 55
Width = 114
Caption = 'MinimizeMemory'
Checked = True
OnClick = CbMinimizeMemClick
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 2
end
object GbTitlePlacement: TRadioGroup
Left = 265
Height = 65
Hint = 'The position of the thumbnail''s title'
Top = 9
Width = 113
AutoFill = True
Caption = ' Title Placement '
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 45
ClientWidth = 109
ItemIndex = 0
Items.Strings = (
'T_UP'
'T_Down'
)
OnClick = GbTitlePlacementClick
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object Edit1: TEdit
Left = 161
Height = 23
Hint = 'You can set the thumbnails title to what ever you want it to be '
Top = 116
Width = 224
TabOrder = 4
Text = 'Edit1'
end
object GroupBox1: TGroupBox
Left = 390
Height = 75
Top = 0
Width = 125
Caption = 'THUMBIMAGE'
ClientHeight = 55
ClientWidth = 121
TabOrder = 5
object BtnInvert: TButton
Left = 8
Height = 25
Top = 0
Width = 108
Caption = 'INVERT'
OnClick = BtnInvertClick
TabOrder = 0
end
object Button5: TButton
Left = 8
Height = 25
Top = 28
Width = 108
Caption = 'GRAYSCALE'
OnClick = Button5Click
TabOrder = 1
end
end
object BtnExit: TButton
Left = 265
Height = 25
Top = 80
Width = 113
Caption = 'EXIT'
ModalResult = 1
TabOrder = 6
end
object GbAngle: TRadioGroup
Left = 390
Height = 60
Top = 81
Width = 125
AutoFill = True
Caption = ' ThumbImage Angle '
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 40
ClientWidth = 121
Columns = 2
Items.Strings = (
'0'
'90'
'180'
'270'
)
OnClick = GbAngleClick
TabOrder = 7
end
object ThumbNail1: TJvThumbnail
Left = 1
Height = 142
Top = 1
Width = 154
ClientHeight = 119
ClientWidth = 146
TabOrder = 8
OnClick = ThumbNail1Click
TitleColor = clBtnFace
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
AsButton = False
MinimizeMemory = True
StreamFileType = grBMP
ShowTitle = False
TitlePlacement = tpUp
AutoLoad = True
ShadowColor = clSilver
ShowShadow = False
end
end
end
end

199
components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.pas Normal file
View File

@ -0,0 +1,199 @@
{******************************************************************
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.
******************************************************************}
{$mode objfpc}{$H+}
unit JvThumbnailChildFormU;
interface
uses
Classes, SysUtils, Controls, Forms,
StdCtrls, ExtCtrls, FileCtrl, ComCtrls, ShellCtrls,
JvThumbImage, JvThumbNails, JvBaseThumbnail, JvExExtCtrls;
type
TJvThumbnailChildForm = class(TForm)
Splitter2: TSplitter;
Panel6: TPanel;
Splitter4: TSplitter;
ShellTreeView: TShellTreeView;
ShellListView: TShellListView;
Panel8: TPanel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
REDBar: TTrackBar;
GreenBar: TTrackBar;
BlueBar: TTrackBar;
contrastBar: TTrackBar;
Button2: TButton;
Panel10: TPanel;
FilterComboBox1: TFilterComboBox;
Panel7: TPanel;
Panel5: TPanel;
Label5: TLabel;
Bevel1: TBevel;
CbAsButton: TCheckBox;
CbAutoLoad: TCheckBox;
CbMinimizeMem: TCheckBox;
GbTitlePlacement: TRadioGroup;
Edit1: TEdit;
GroupBox1: TGroupBox;
BtnInvert: TButton;
Button5: TButton;
Label1: TLabel;
LightnessBar: TTrackBar;
BtnExit: TButton;
GbAngle: TRadioGroup;
ThumbNail1: TJVThumbNail;
ThumbImage1: TJvThumbImage;
procedure Button2Click(Sender: TObject);
procedure ShellListViewChange(Sender: TObject);
procedure CbAsButtonClick(Sender: TObject);
procedure CbAutoLoadClick(Sender: TObject);
procedure CbMinimizeMemClick(Sender: TObject);
procedure GbTitlePlacementClick(Sender: TObject);
procedure Panel8Resize(Sender: TObject);
procedure BtnInvertClick(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure thumbnail1Click(Sender: TObject);
procedure Panel10Resize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GbAngleClick(Sender: TObject);
public
procedure SetFileName(AFileName: String);
function GetFileName: String;
end;
var
JvThumbnailChildForm: TJvThumbnailChildForm;
implementation
{$R *.lfm}
procedure TJvThumbnailChildForm.Button2Click(Sender: TObject);
begin
ThumbImage1.ChangeRGB(redbar.Position,greenbar.Position,bluebar.Position);
ThumbImage1.Contrast(contrastbar.Position);
ThumbImage1.Lightness(LightnessBar.Position);
RedBar.Position := 0;
GreenBar.Position :=0;
BlueBar.Position := 0;
ContrastBar.Position := 0;
LightnessBar.Position := 0;
end;
procedure TJvThumbnailChildForm.ShellListViewChange(Sender: TObject);
var
fn: String;
begin
if ShellListView.Selected <> nil then begin
fn := ShellListView.GetPathFromItem(ShellListView.Selected);
Thumbnail1.FileName := fn;
ThumbImage1.Loadfromfile(fn);
end;
end;
procedure TJvThumbnailChildForm.CbAsButtonClick(Sender: TObject);
begin
THumbnail1.Asbutton := CbAsButton.Checked;
end;
procedure TJvThumbnailChildForm.CbAutoLoadClick(Sender: TObject);
begin
thumbnail1.autoload := CbAutoLoad.Checked;
end;
procedure TJvThumbnailChildForm.CbMinimizeMemClick(Sender: TObject);
begin
thumbnail1.minimizememory:=CbMinimizeMem.Checked;
end;
procedure TJvThumbnailChildForm.GbTitlePlacementClick(Sender: TObject);
begin
thumbnail1.TitlePlacement := ttitlepos(GbTitlePlacement.ItemIndex);
end;
procedure TJvThumbnailChildForm.Panel8Resize(Sender: TObject);
begin
RedBar.Width := panel8.ClientWidth;
end;
procedure TJvThumbnailChildForm.BtnInvertClick(Sender: TObject);
begin
ThumbImage1.Invert;
end;
procedure TJvThumbnailChildForm.Button5Click(Sender: TObject);
begin
ThumbImage1.GrayScale;
end;
procedure TJvThumbnailChildForm.thumbnail1Click(Sender: TObject);
begin
if thumbnail1.FileName<>'' then
thumbimage1.Loadfromfile(thumbnail1.FileName);
end;
procedure TJvThumbnailChildForm.Panel10Resize(Sender: TObject);
begin
filtercombobox1.Width := panel10.ClientWidth;
filtercombobox1.Height:= panel10.ClientHeight;
end;
procedure TJvThumbnailChildForm.FormShow(Sender: TObject);
begin
//thumbimage1.Picture.Free;
GbTitlePlacement.ItemIndex := integer(thumbnail1.titlePlacement);
GbAngle.ItemIndex := integer(thumbimage1.angle);
end;
procedure TJvThumbnailChildForm.GbAngleClick(Sender: TObject);
begin
thumbimage1.angle := TAngle(GbAngle.ItemIndex)
end;
function TJvThumbnailChildForm.GetfileName: String;
begin
Result := ShellListView.GetPathFromItem(ShellListView.Selected);
end;
procedure TJvThumbnailChildForm.SetFileName(AFileName: String);
var
dir, fn: String;
begin
dir := ExtractFilePath(AFileName);
fn := ExtractFileName(AFileName);
if dir <> ShellListView.Root then
ShellTreeView.Path := dir;
ShellListView.Selected := ShellListView.Items.FindCaption(0, fn, false, false, false);
end;
end.

91
components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpi Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="JvThumbnailDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</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="2">
<Item1>
<PackageName Value="JvCustomLazR"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="JvThumbnailDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="JvThumbnailMainFormU.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="JvThumbnailMainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="JvThumbnailChildFormU.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="JvThumbnailChildForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="JvThumbnailDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

14
components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpr Normal file
View File

@ -0,0 +1,14 @@
program JvThumbnailDemo;
uses
Forms, Interfaces, JvThumbnailMainFormU, JvThumbnailChildFormU {JvThumbnailMainForm};
{$R *.RES}
begin
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TJvThumbnailMainForm, JvThumbnailMainForm);
// Application.CreateForm(TJvThumbnailChildForm, JvThumbnailChildForm);
Application.Run;
end.

438
components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.lfm Normal file
View File

@ -0,0 +1,438 @@
object JvThumbnailMainForm: TJvThumbnailMainForm
Left = 295
Height = 656
Top = 100
Width = 878
Caption = 'JvThumbView Demo'
ClientHeight = 656
ClientWidth = 878
Color = clBtnFace
Constraints.MinHeight = 430
Constraints.MinWidth = 760
DefaultMonitor = dmDesktop
Font.Color = clWindowText
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '1.9.0.0'
Scaled = False
object PageControl1: TPageControl
Left = 0
Height = 632
Top = 0
Width = 878
ActivePage = TabSheet1
Align = alClient
TabIndex = 0
TabOrder = 0
object TabSheet1: TTabSheet
Caption = 'ThumbView Component'
ClientHeight = 604
ClientWidth = 870
object Splitter1: TSplitter
Left = 153
Height = 546
Top = 58
Width = 3
end
object Panel1: TPanel
Left = 0
Height = 58
Top = 0
Width = 870
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 58
ClientWidth = 870
TabOrder = 0
object LblThumbSize: TLabel
AnchorSideLeft.Control = TbThumbSize
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = TbThumbSize
AnchorSideRight.Side = asrBottom
Left = 0
Height = 15
Top = 8
Width = 150
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
Caption = 'Thumbnail size'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = SpinEdit1
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = SpinEdit1
AnchorSideRight.Side = asrBottom
Left = 569
Height = 16
Hint = 'Change the thumbgup to change the space between the thumbnails '
Top = 8
Width = 64
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
AutoSize = False
BorderSpacing.Top = 8
Caption = 'Gap:'
ParentColor = False
ParentShowHint = False
ShowHint = True
end
object Label4: TLabel
AnchorSideLeft.Control = SpinEdit2
AnchorSideTop.Control = Label3
AnchorSideRight.Control = SpinEdit2
AnchorSideRight.Side = asrBottom
Left = 649
Height = 16
Hint = 'Change the selected to select the Nth element in the list.'
Top = 8
Width = 64
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'Selected:'
ParentColor = False
ParentShowHint = False
ShowHint = True
end
object TbThumbSize: TTrackBar
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = LblThumbSize
AnchorSideTop.Side = asrBottom
Left = 0
Height = 28
Hint = 'Changes the size of the thumbs, it accepts values between 10 and 100'
Top = 25
Width = 150
Frequency = 10
Max = 100
Min = 10
OnChange = TbThumbSizeChange
PageSize = 10
Position = 100
TickMarks = tmTopLeft
TickStyle = tsNone
BorderSpacing.Top = 2
BorderSpacing.Bottom = 4
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object CbAutoScrolling: TCheckBox
AnchorSideLeft.Control = TbThumbSize
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 166
Height = 19
Hint = 'Set "AutoScrolling" to true to let the ThumbView component scroll the selected thumb into the screen automatically'
Top = 8
Width = 92
BorderSpacing.Left = 16
BorderSpacing.Top = 8
Caption = 'AutoScrolling'
Checked = True
OnClick = CbAutoScrollingClick
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 1
end
object CbAutoHandleKeyboard: TCheckBox
AnchorSideLeft.Control = TbThumbSize
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbAutoScrolling
AnchorSideTop.Side = asrBottom
Left = 166
Height = 19
Hint = 'Set "AutoHandlekeyboard" to true to let the Thumbview capture the cursor key and navigate through the view using them'
Top = 31
Width = 134
BorderSpacing.Left = 16
BorderSpacing.Top = 4
Caption = 'AutoHandleKeyboard'
Checked = True
OnClick = CbAutoHandleKeyboardClick
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 2
end
object SpinEdit1: TSpinEdit
AnchorSideLeft.Control = BtnEditSelThumb
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
Left = 569
Height = 23
Hint = 'Changes the space between the thumbnails '
Top = 27
Width = 64
BorderSpacing.Left = 16
BorderSpacing.Top = 3
MaxValue = 300
MinValue = 1
OnChange = SpinEdit1Change
ParentShowHint = False
ShowHint = True
TabOrder = 3
Value = 1
end
object SpinEdit2: TSpinEdit
AnchorSideLeft.Control = SpinEdit1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = SpinEdit1
Left = 649
Height = 23
Hint = 'Selects the thumbnail with this index'
Top = 27
Width = 64
BorderSpacing.Left = 16
MaxValue = 0
OnChange = SpinEdit2Change
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object CbSorted: TCheckBox
AnchorSideLeft.Control = CbMinMemory
AnchorSideTop.Control = CbAutoScrolling
Left = 316
Height = 19
Hint = 'Set "Sorted" to true to sort the files found in the directory by name (other posibilities in the next version)'
Top = 8
Width = 54
Caption = 'Sorted'
Checked = True
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 5
end
object CbMinMemory: TCheckBox
AnchorSideLeft.Control = CbAutoHandleKeyboard
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbAutoHandleKeyboard
Left = 316
Height = 19
Top = 31
Width = 86
BorderSpacing.Left = 16
Caption = 'MinMemory'
Checked = True
OnClick = CbMinMemoryClick
ParentShowHint = False
ShowHint = True
State = cbChecked
TabOrder = 6
end
object BtnStopLoading: TButton
AnchorSideLeft.Control = BtnEditSelThumb
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = BtnEditSelThumb
AnchorSideRight.Side = asrBottom
Left = 418
Height = 25
Top = 2
Width = 135
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 2
Caption = 'Stop Loading'
Enabled = False
OnClick = BtnStopLoadingClick
TabOrder = 8
end
object BtnEditSelThumb: TButton
AnchorSideLeft.Control = CbMinMemory
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnStopLoading
AnchorSideTop.Side = asrBottom
Left = 418
Height = 25
Top = 29
Width = 135
AutoSize = True
BorderSpacing.Left = 16
BorderSpacing.Top = 2
BorderSpacing.Bottom = 4
Caption = 'Edit Selected Thumb'
OnClick = BtnEditSelThumbClick
TabOrder = 7
end
end
object Panel2: TPanel
Left = 0
Height = 546
Top = 58
Width = 153
Align = alLeft
BevelOuter = bvNone
Caption = 'Panel2'
ClientHeight = 546
ClientWidth = 153
TabOrder = 1
object ShellTreeView: TShellTreeView
Left = 0
Height = 376
Hint = 'Set directory where your images are located and watch the thumbview creating the thumbs'
Top = 0
Width = 153
Align = alClient
FileSortType = fstNone
HideSelection = False
ReadOnly = True
TabOrder = 0
OnChange = ShellTreeViewChange
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
ObjectTypes = [otFolders]
end
object RadioGroup1: TRadioGroup
Left = 0
Height = 77
Hint = 'Change the AlignView property to either use the thumbGup (VTNormal) autocalculate the empty space to equall parts(VTSPACEEQUAL) or Cender the thumbs in the using the htumbgup between them.'
Top = 384
Width = 153
Align = alBottom
AutoFill = True
AutoSize = True
BorderSpacing.Top = 8
Caption = ' AlignView '
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 57
ClientWidth = 149
ItemIndex = 0
Items.Strings = (
'VTNormal'
'VTCenter'
'VTFitToScreen'
)
OnClick = RadioGroup1Click
TabOrder = 1
end
object RadioGroup2: TRadioGroup
Left = 0
Height = 77
Hint = 'Change the ScrollMode to change the direction the thumb are scrolling in the screen SMVertical You will see a vertical scrollbar SMHorizontal For A horizontal ScrollBar or SMBoth to create a square view '
Top = 469
Width = 153
Align = alBottom
AutoFill = True
AutoSize = True
BorderSpacing.Top = 8
Caption = ' ScrollMode '
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 57
ClientWidth = 149
ItemIndex = 2
Items.Strings = (
'SMHorizontal'
'SMVertical'
'SMBoth'
)
OnClick = RadioGroup2Click
TabOrder = 2
end
end
object Panel3: TPanel
Left = 156
Height = 546
Top = 58
Width = 714
Align = alClient
BevelOuter = bvNone
Caption = 'Panel3'
ClientHeight = 546
ClientWidth = 714
TabOrder = 2
object DirInfoPanel: TPanel
Left = 0
Height = 16
Hint = 'Read the selectedFile property to get the path+filename of the selected thumb'
Top = 530
Width = 714
Align = alBottom
BevelOuter = bvLowered
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object ThumbView: TJvThumbView
Left = 0
Height = 530
Top = 0
Width = 714
HorzScrollBar.Page = 1
HorzScrollBar.Tracking = True
VertScrollBar.Page = 1
VertScrollBar.Tracking = True
Align = alClient
TabOrder = 1
TabStop = True
OnDblClick = ThumbViewDblClick
OnMouseUp = ThumbViewMouseUp
AlignView = vtNormal
AutoScrolling = True
ThumbGap = 4
AutoHandleKeyb = True
MinMemory = True
MaxWidth = 200
MaxHeight = 200
Size = 100
ScrollMode = smHorizontal
Sorted = True
OnStartScanning = ThumbViewStartScanning
OnStopScanning = ThumbViewStopScanning
OnScanProgress = ThumbViewScanProgress
OnChange = ThumbViewChange
OnKeyUp = ThumbViewKeyUp
AsButtons = False
Filter = 'Portable Graphics Network (*.png)|*.png|PCX Image (*.pcx)|*.pcx|ANI Image (*.ani)|*.ani|JPEG Image File (*.jpg)|*.jpg|Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.ico|Enhanced Metafiles (*.emf)|*.emf|Metafiles (*.wmf)|*.wmf'
ThumbColor = clNone
ShowShadow = False
ShadowColor = clBlack
end
end
end
end
object Panel5: TPanel
Left = 0
Height = 24
Top = 632
Width = 878
Align = alBottom
BorderWidth = 2
ClientHeight = 24
ClientWidth = 878
TabOrder = 1
object Bevel1: TBevel
Left = 3
Height = 18
Top = 3
Width = 291
Align = alLeft
end
object ProgressBar: TProgressBar
Left = 5
Height = 13
Top = 5
Width = 284
Step = 0
TabOrder = 0
Visible = False
end
end
end

250
components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.pas Normal file
View 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 JvThumbnailMainFormU;
{$mode objfpc}{$H+}
interface
uses
Classes, Controls, Forms, StdCtrls, ExtCtrls, FileCtrl, ComCtrls, Spin, ShellCtrls,
JvThumbNails, {JvSpecialProgress, }JvThumbViews, JvBaseThumbnail;
{
JvListBox, JvDriveCtrls, JvCombobox, JvExControls, JvComponent,
JvExStdCtrls, JvExForms; }
type
{ TJvThumbnailMainForm }
TJvThumbnailMainForm = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Splitter1: TSplitter;
Panel1: TPanel;
LblThumbSize: TLabel;
Label3: TLabel;
Label4: TLabel;
TbThumbSize: TTrackBar;
CbAutoScrolling: TCheckBox;
CbAutoHandleKeyboard: TCheckBox;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
CbSorted: TCheckBox;
CbMinMemory: TCheckBox;
Panel2: TPanel;
ShellTreeView: TShellTreeView;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
Panel3: TPanel;
DirInfoPanel: TPanel;
BtnStopLoading: TButton;
BtnEditSelThumb: TButton;
ThumbView: TJVTHumbview;
Panel5: TPanel;
ProgressBar: TProgressBar;
Bevel1: TBevel;
procedure ShellTreeViewChange(Sender: TObject; Node: TTreeNode);
procedure ThumbViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ThumbViewMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ThumbViewScanProgress(Sender: TObject; APosition: Integer;
var Break: Boolean);
procedure ThumbViewStartScanning(Sender: TObject; AMax: Integer);
procedure ThumbViewStopScanning(Sender: TObject);
procedure BtnStopLoadingClick(Sender: TObject);
procedure CbAutoScrollingClick(Sender: TObject);
procedure CbAutoHandleKeyboardClick(Sender: TObject);
procedure CbMinMemoryClick(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TbThumbSizeChange(Sender: TObject);
procedure ThumbViewDblClick(Sender: TObject);
procedure BtnEditSelThumbClick(Sender: TObject);
procedure ThumbViewChange(Sender: TObject);
public
NewDir: Boolean;
Scanning: Boolean;
end;
var
JvThumbnailMainForm: TJvThumbnailMainForm;
implementation
uses JvThumbnailChildFormU;
{$R *.lfm}
procedure TJvThumbnailMainForm.ThumbViewMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DirInfoPanel.Caption := ThumbView.SelectedFile;
end;
procedure TJvThumbnailMainForm.ThumbViewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
DirInfoPanel.Caption := ThumbView.SelectedFile;
end;
procedure TJvThumbnailMainForm.ThumbViewScanProgress(Sender: TObject;
APosition: Integer;
var Break: Boolean);
begin
ProgressBar.Position := APosition;
break := Newdir;
end;
procedure TJvThumbnailMainForm.ThumbViewStartScanning(Sender: TObject; AMax: Integer);
begin
Scanning := True;
// ShellTreeView.Enabled := False;
BtnStopLoading.Enabled := True;
ProgressBar.Max := AMax;
ProgressBar.Visible := true;
end;
procedure TJvThumbnailMainForm.ThumbViewStopScanning(Sender: TObject);
begin
Scanning := False;
// ShellTreeView.Enabled := True;
Spinedit2.MaxValue := ThumbView.Count - 1;
newdir := False;
BtnStopLoading.Enabled := False;
ProgressBar.Position := 0;
ProgressBar.Visible := false;
end;
procedure TJvThumbnailMainForm.BtnStopLoadingClick(Sender: TObject);
begin
NewDir := True;
end;
procedure TJvThumbnailMainForm.CbAutoScrollingClick(Sender: TObject);
begin
ThumbView.AutoScrolling := CbAutoScrolling.Checked;
end;
procedure TJvThumbnailMainForm.CbAutoHandleKeyboardClick(Sender: TObject);
begin
ThumbView.AutoHandleKeyb := CbAutoHandleKeyboard.Checked;
end;
procedure TJvThumbnailMainForm.CbMinMemoryClick(Sender: TObject);
begin
ThumbView.MinMemory := CbMinMemory.Checked;
end;
procedure TJvThumbnailMainForm.SpinEdit1Change(Sender: TObject);
begin
if spinedit1.Text <> '' then ThumbView.ThumbGap := spinedit1.Value;
end;
procedure TJvThumbnailMainForm.SpinEdit2Change(Sender: TObject);
begin
ThumbView.Selected := spinedit2.Value;
end;
procedure TJvThumbnailMainForm.RadioGroup1Click(Sender: TObject);
begin
ThumbView.AlignView := TViewType(radiogroup1.ItemIndex);
end;
procedure TJvThumbnailMainForm.RadioGroup2Click(Sender: TObject);
begin
ThumbView.ScrollMode := TscrollMode(radiogroup2.ItemIndex);
end;
procedure TJvThumbnailMainForm.ShellTreeViewChange(Sender: TObject;
Node: TTreeNode);
begin
if not scanning then
repeat
ThumbView.Directory := ShellTreeView.Path;
until ThumbView.Directory = ShellTreeView.Path
else
NewDir := True;
end;
procedure TJvThumbnailMainForm.FormShow(Sender: TObject);
begin
CbAutoScrolling.Checked := ThumbView.AutoScrolling;
CbAutoHandleKeyboard.Checked := ThumbView.AutoHandleKeyb;
CbSorted.Checked := ThumbView.Sorted;
CbSorted.Checked := ThumbView.MinMemory;
spinedit1.Value := ThumbView.ThumbGap;
spinedit2.MaxValue := 0;
spinedit1.MinValue := 0;
radiogroup1.ItemIndex := integer(ThumbView.alignview);
radiogroup2.ItemIndex := integer(ThumbView.scrollMode);
Newdir := False;
Scanning := False;
end;
procedure TJvThumbnailMainForm.TbThumbSizeChange(Sender: TObject);
begin
ThumbView.Size := TbThumbSize.Position;
end;
procedure TJvThumbnailMainForm.ThumbViewDblClick(Sender: TObject);
var
F: TJvThumbnailChildForm;
begin
F := TJvThumbnailChildForm.Create(Self);
try
F.ShelLTreeView.Path := ShellTreeView.Path;
if Sender is TJvThumbView then
begin
F.SetFileName(TJvThumbView(Sender).SelectedFile);
// F.FileListBox1.FileName := tjvThumbView(Sender).SelectedFile;
end;
if Sender is TJvThumbnail then
begin
F.SetFileName(TJvThumbnail(Sender).FileName);
// F.FileListBox1.FileName := tjvthumbnail(Sender).FileName;
end;
F.ShowModal;
finally
F.Free;
end;
end;
procedure TJvThumbnailMainForm.BtnEditSelThumbClick(Sender: TObject);
begin
ThumbViewDblClick(ThumbView);
end;
procedure TJvThumbnailMainForm.ThumbViewChange(Sender: TObject);
begin
DirInfoPanel.Caption := ThumbView.SelectedFile;
end;
end.

9
components/jvcllaz/packages/JvCoreLazR.lpk
View File

@ -23,7 +23,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="8">
<Files Count="9">
<Item1>
<Filename Value="..\run\JvCore\JvTypes.pas"/>
<UnitName Value="JvTypes"/>
@ -56,6 +56,10 @@
<Filename Value="..\run\JvCore\JvResources.pas"/>
<UnitName Value="JvResources"/>
</Item8>
<Item9>
<Filename Value="..\run\JvCore\JvThemes.pas"/>
<UnitName Value="JvThemes"/>
</Item9>
</Files>
<RequiredPkgs Count="2">
<Item1>
@ -73,5 +77,8 @@
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
<CustomOptions Items="ExternHelp" Version="2">
<_ExternHelp Items="Count"/>
</CustomOptions>
</Package>
</CONFIG>

18
components/jvcllaz/packages/jvcustomlazr.lpk
View File

@ -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="5">
<Files Count="9">
<Item1>
<Filename Value="..\run\JvCustomControls\jvtimeline.pas"/>
<UnitName Value="JvTimeLine"/>
@ -39,6 +39,22 @@
<Filename Value="..\run\JvCustomControls\JvTabBarXPPainter.pas"/>
<UnitName Value="JvTabBarXPPainter"/>
</Item5>
<Item6>
<Filename Value="..\run\JvCustomControls\JvBaseThumbnail.pas"/>
<UnitName Value="JvBaseThumbnail"/>
</Item6>
<Item7>
<Filename Value="..\run\JvCustomControls\JvThumbImage.pas"/>
<UnitName Value="JvThumbImage"/>
</Item7>
<Item8>
<Filename Value="..\run\JvCustomControls\JvThumbnails.pas"/>
<UnitName Value="JvThumbnails"/>
</Item8>
<Item9>
<Filename Value="..\run\JvCustomControls\JvThumbViews.pas"/>
<UnitName Value="JvThumbViews"/>
</Item9>
</Files>
<RequiredPkgs Count="2">
<Item1>

BIN
components/jvcllaz/resource/jvcustomreg.res
View File

Binary file not shown.

1042
components/jvcllaz/run/JvCore/JvThemes.pas Normal file
View File

File diff suppressed because it is too large Load Diff

686
components/jvcllaz/run/JvCustomControls/JvBaseThumbnail.pas Normal file
View File

@ -0,0 +1,686 @@
{-----------------------------------------------------------------------------
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: JvBasethb.PAS, released on 2002-07-03.
The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
All Rights Reserved.
Contributor(s):
You may Thumb the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Known Issues:
This file contains (most likely) greek comments.
-----------------------------------------------------------------------------}
// $Id$
unit JvBaseThumbnail;
{$mode objfpc}{$H+}
//{$I crossplatform.inc}
interface
uses
LclIntf, LCLType, LMessages,
(*
Windows, // TWin32FindData
{$IFDEF HAS_UNIT_LIBC}
Libc, // stat()
{$ENDIF HAS_UNIT_LIBC}
Messages,
*)
Classes, Graphics, Controls, Forms, ExtCtrls,
//JclBase,
//JvExForms,
JvExExtCtrls;
// (rom) TFileName is already declared in SysUtils
type
{ The TFileName object has been created to handle the first field of a Thumb
Which is the Thumbs actual FileName complete with the Path because no
duplicates are allowed in the final list.
It Has the following properties
01) FileName : it keeps the filename as given by the user
02) LongName : it always returns the LongName of the file
03) ShortName: it always returns the short name of the file
04) Size : it returns the size in Bytes that it will occupy if saved in a stream
05) Length : the "FileName" property Length;
and the following methods
01) LoadFromStream(AStream: TStream; APos: Integer); loads a filename from a stream
if APos < 0 then don't change the cursor position in the stream
else AStream.Seek(APos, 0);
02) SaveToStream(AStream: TStream; APos: Integer); Save the FileName to AStream
if APos > -1 then AStream.Seek(APos, 0);
SaveData;
}
TProgressNotify = procedure(Sender: TObject; Position: Integer; var Stop: Boolean) of object;
TInvalidImageEvent = procedure(Sender: TObject; const AFileName: string) of object;
// (rom) renamed
TGRFKind = (grBMP, grJPG, grWMF, grEMF, grICO, grPNG); //,grPCX,grTGA);
TPercent = -100..100;
{$M+}
TJvFileName = class(TObject) // was: TFileName, renamed to TJvFileName to avoid conflict with existing type
private
FLongName: string;
FShortName: string;
FFileName: string;
FCreated: TDateTime;
FAccessed: TDateTime;
FModified: TDateTime;
FFileSize: Longint;
protected
procedure SetName(NewName: string); virtual;
function GetLength: Integer;
procedure SetLength(NewLength: Integer);
procedure Init;
public
procedure LoadFromStream(AStream: TStream; APos: Integer); //Load From stream
// both of this routines are inserting extract data to the stream its self
// like a header and data end string;
procedure SaveToStream(AStream: TStream; APos: Integer); // Save to a Stream
// (rom) moved to public
property LongName: string read FLongName; // The LongName of this filename
property ShortName: string read FShortName; // shortname of this filename
published
property FileName: string read FFileName write SetName; // The FileName as given by the user
property Length: Integer read GetLength write SetLength;
end;
{$M-}
{ The Following classes are declared here so I can handle interaction of the mouse
between the three components.
}
TJvThumbTitle = class(TPanel) //TJvExPanel)
protected
{ wp: removed }
// function DoEraseBackground(ACanvas: TCanvas; Param: LPARAM): Boolean; override;
procedure Click; override;
procedure DblClick; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent); override;
end;
TJvBaseThumbImage = class(TImage) //TJvExImage)
private
FIgnoreMouse: Boolean;
protected
{ wp removed
function HitTest(X, Y: Integer): Boolean; override; }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Click; override;
procedure DblClick; override;
public
constructor Create(AOwner: TComponent); override;
published
property IgnoreMouse: Boolean read FIgnoreMouse write FIgnoreMouse;
end;
TJvBaseThumbnail = class(TPanel) //JvExPanel)
protected
{ wp removed
function DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean; override; }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Click; override;
procedure DblClick; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent); override;
end;
TJvBaseThumbView = class(TScrollbox) //JvExScrollBox)
protected
// function DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean; override;
public
constructor Create(AOwner: TComponent); override;
end;
function BoundByte(Min, Max, Value: Integer): Byte;
procedure InsertStr(var Str: string; const NewStr: string; Pos: Longint);
function ProportionalSize(PhysicalSize, NewSize: TPoint): TPoint;
function ReplaceChar(const AStr: string; const CharToFind, NewChar: Char;
ReplaceNo: Longint; CaseSensitive: Boolean): string;
function JkCeil(I: Extended): Longint;
function ReplaceAllStr(const Str, SearchFor, ReplaceWith: string;
CaseSensitive: Boolean): string;
implementation
uses
SysUtils, Types, //LazFileUtils,
JvJCLUtils, JvThemes;
function ReplaceAllStr(const Str, SearchFor, ReplaceWith: string;
CaseSensitive: Boolean): string;
var
Cnt: Integer;
S1, S2, SF: string;
begin
S1 := Str;
if CaseSensitive then
begin
S2 := S1;
SF := SearchFor;
end
else
begin
S2 := UpperCase(S1);
SF := UpperCase(SearchFor);
end;
Result := '';
repeat
Cnt := Pos(SF, S2);
if Cnt > 0 then
begin
Result := Result + Copy(S1, 1, Cnt - 1) + ReplaceWith;
S1 := Copy(S1, Cnt + Length(SF), Length(S1));
if CaseSensitive then
S2 := S1
else
S2 := UpperCase(S1);
end
else
Result := Result + S1;
until Cnt <= 0;
end;
function JkCeil(I: Extended): Longint;
var
T: Longint;
begin
T := Trunc(I);
if T <> I then
if I > 0 then
T := T + 1
else
T := T - 1;
Result := T;
end;
function ReplaceChar(const AStr: string; const CharToFind, NewChar: Char;
ReplaceNo: Longint; CaseSensitive: Boolean): string;
var
Count: Longint;
RepCount: Longint;
Res: string;
begin
Res := AStr;
if ReplaceNo > 0 then
RepCount := 0
else
RepCount := -1;
Count := 1;
if Length(Res) > 0 then
repeat
if Res[Count] = CharToFind then
begin
Res[Count] := NewChar;
if RepCount >= 0 then
Inc(RepCount, 1);
end;
Inc(Count, 1);
until (Count > Length(Res)) or (RepCount >= ReplaceNo);
Result := Res;
end;
function ProportionalSize(PhysicalSize, NewSize: TPoint): TPoint;
var
Percent: Single;
TempX, TempY: Single;
begin
// Õðïëïãéóìüò ðïóïóôïý åðß ôçò åêáôü ðïõ èá åðéäïèåß óôçí ôéìÞ ðñïò
// áëëáãÞ. [This seems to be greek, couldn't find translator]
if PhysicalSize.X <> 0 then
TempX := ((NewSize.X) / PhysicalSize.X) * 100.0
else
TempX := 0;
if PhysicalSize.Y <> 0 then
TempY := ((NewSize.Y) / PhysicalSize.Y) * 100.0
else
TempY := 0;
//Åõñåóç ìéêñüôåñïõ ðïóïóôïý áëáãÞò êáé ÷ñÞóç áõôïý.
// [this seems to be greek, couldn't find translator]
if TempX <= TempY then
Percent := TempX
else
Percent := TempY;
//Fs.X:=round((PhysicalSize.X/100)*Percent);
//Fs.Y:=round((PhysicalSize.Y/100)*Percent);
Result.X := Trunc((PhysicalSize.X / 100.0) * Percent);
Result.Y := Trunc((PhysicalSize.Y / 100.0) * Percent);
end;
procedure InsertStr(var Str: string; const NewStr: string; Pos: Longint);
begin
System.Insert(NewStr, Str, Pos);
{
SetLength(Str, Length(Str) + Length(NewStr));
MoveChar(Str, Pos, Str, Pos + Length(NewStr), Length(Str) - Pos - Length(NewStr));
MoveChar(NewStr, 0, Str, Pos, Length(NewStr));
}
end;
function BoundByte(Min, Max, Value: Integer): Byte;
begin
if Value < Min then
Result := Min
else
if Value > Max then
Result := Max
else
Result := Value;
end;
//=== { TJvThumbTitle } ======================================================
constructor TJvThumbTitle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if AOwner is TJvBaseThumbnail then
ControlStyle := ControlStyle - [csSetCaption, csCaptureMouse, csClickEvents, csDoubleClicks]
else
ControlStyle := ControlStyle - [csSetCaption];
IncludeThemeStyle(Self, [csNeedsBorderPaint]);
end;
{ wp removed
function TJvThumbTitle.DoEraseBackground(ACanvas: TCanvas; Param: LPARAM): Boolean;
begin
inherited DoEraseBackground(ACanvas, Param);
Result := True;
end;
}
procedure TJvThumbTitle.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseDown(Button, Shift, X + Left, Y + Top)
else
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TJvThumbTitle.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseUp(Button, Shift, X + Left, Y + Top)
else
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TJvThumbTitle.Click;
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).Click
else
inherited Click;
end;
procedure TJvThumbTitle.DblClick;
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).DblClick
else
inherited DblClick;
end;
procedure TJvThumbTitle.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseMove(Shift, X + Left, Y + Top)
else
inherited MouseMove(Shift, X, Y);
end;
function TJvThumbTitle.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbnail then
Result := TJvBaseThumbnail(Parent).DoMouseWheel(Shift, WheelDelta, MousePos)
else
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;
function TJvThumbTitle.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbnail then
Result := TJvBaseThumbnail(Parent).DoMouseWheelDown(Shift, MousePos)
else
Result := inherited DoMouseWheelDown(Shift, MousePos);
end;
function TJvThumbTitle.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbnail then
Result := TJvBaseThumbnail(Parent).DoMouseWheelUp(Shift, MousePos)
else
Result := inherited DoMouseWheelUp(Shift, MousePos);
end;
procedure TJvThumbTitle.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).KeyDown(Key, Shift)
else
inherited KeyDown(Key, Shift);
end;
procedure TJvThumbTitle.KeyUp(var Key: Word; Shift: TShiftState);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).KeyUp(Key, Shift)
else
inherited KeyUp(Key, Shift);
end;
procedure TJvThumbTitle.KeyPress(var Key: Char);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).KeyPress(Key)
else
inherited KeyPress(Key);
end;
//=== { TJvBaseThumbImage } ==================================================
constructor TJvBaseThumbImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csSetCaption];
{ If AOwner is TJvBaseThumbnail then
begin
ControlStyle := ControlStyle - [csCaptureMouse];
FIgnoreMouse := True;
end
else}
FIgnoreMouse := False;
end;
procedure TJvBaseThumbImage.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseDown(Button, Shift, X + Left, Y + Top)
else
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TJvBaseThumbImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseUp(Button, Shift, X + Left, Y + Top)
else
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TJvBaseThumbImage.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).MouseMove(Shift, X + Left, Y + Top)
else
inherited MouseMove(Shift, X, Y);
end;
procedure TJvBaseThumbImage.Click;
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).Click
else
inherited Click;
end;
procedure TJvBaseThumbImage.DblClick;
begin
if Parent is TJvBaseThumbnail then
TJvBaseThumbnail(Parent).DblClick
else
inherited DblClick;
end;
(************ NOT CONVERTED ***
function TJvBaseThumbImage.HitTest(X, Y: Integer): Boolean;
{const
Hits: array [Boolean] of Longint = (HTCLIENT, HTNOWHERE);}
begin
if csDesigning in ComponentState then
Result := inherited HitTest(X, Y)
else
Result := not IgnoreMouse;
//Msg.Result := Hits[IgnoreMouse];
end;
**************)
//=== { TJvBaseThumbnail } ===================================================
constructor TJvBaseThumbnail.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if AOwner is TJvBaseThumbView then
ControlStyle := ControlStyle - [csSetCaption, csCaptureMouse]
// csClickEvents,csDoubleClicks]
else
ControlStyle := ControlStyle - [csSetCaption];
end;
procedure TJvBaseThumbnail.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).MouseDown(Button, Shift, Left + X, Top + Y)
else
inherited MouseDown(Button, Shift, X, Y);
end;
{ wp removed
function TJvBaseThumbnail.DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean;
begin
inherited DoEraseBackground(Canvas, Param);
Result := True;
end;
}
procedure TJvBaseThumbnail.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).MouseMove(Shift, Left + X, Top + Y)
else
inherited MouseMove(Shift, X, Y);
end;
function TJvBaseThumbnail.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbView then
Result := TJvBaseThumbView(Parent).DoMouseWheel(Shift, WheelDelta, MousePos)
else
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;
function TJvBaseThumbnail.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbView then
Result := TJvBaseThumbView(Parent).DoMouseWheelDown(Shift, MousePos)
else
Result := inherited DoMouseWheelDown(Shift, MousePos);
end;
function TJvBaseThumbnail.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
if Parent is TJvBaseThumbView then
Result := TJvBaseThumbView(Parent).DoMouseWheelUp(Shift, MousePos)
else
Result := inherited DoMouseWheelUp(Shift, MousePos);
end;
procedure TJvBaseThumbnail.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).KeyDown(Key, Shift)
else
inherited KeyDown(Key, Shift);
end;
procedure TJvBaseThumbnail.KeyUp(var Key: Word; Shift: TShiftState);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).KeyUp(Key, Shift)
else
inherited KeyUp(Key, Shift);
end;
procedure TJvBaseThumbnail.KeyPress(var Key: Char);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).KeyPress(Key)
else
inherited KeyPress(Key);
end;
procedure TJvBaseThumbnail.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).MouseUp(Button, Shift, Left + X, Top + Y)
else
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TJvBaseThumbnail.Click;
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).Click
else
inherited Click;
end;
procedure TJvBaseThumbnail.DblClick;
begin
if Parent is TJvBaseThumbView then
TJvBaseThumbView(Parent).DblClick
else
inherited DblClick;
end;
//=== { TJvBaseThumbView } ===================================================
constructor TJvBaseThumbView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlState := ControlState + [csFocusing];
ControlStyle := ControlStyle + [csOpaque] - [csSetCaption];
IncludeThemeStyle(Self, [csNeedsBorderPaint]);
end;
{
function TJvBaseThumbView.DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean;
begin
//Result :=
inherited DoEraseBackground(Canvas, Param);
Result := False;
end;
}
//=== { TJvFileName } ==========================================================
procedure TJvFileName.SetName(NewName: string);
begin
FFileName := NewName;
if (NewName <> LongName) and (NewName <> ShortName) then
Init;
end;
procedure TJvFileName.Init;
var
Dft: DWORD;
Lft: TFileTime;
sr: TSearchRec;
begin
if FindFirst(FFileName, faAnyFile or faDirectory, sr) = 0 then
begin
FindClose(sr);
FLongName := sr.FindData.cFileName;
FShortName := sr.FindData.cAlternateFileName;
if FLongName = '' then
FLongName := FShortName;
if FShortName = '' then
FShortName := FLongName;
// FIX ME !!!
(**************** NOT CONVERTED ***
//fdFileAccessed
FileTimeToLocalFileTime(sr.FindData.ftLastAccessTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
FAccessed := Dft;
//fdFilechanged
FileTimeToLocalFileTime(sr.FindData.ftLastwriteTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
FModified := Dft;
//fdFilecreated
FileTimeToLocalFileTime(sr.FindData.ftCreationTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
FCreated := Dft;
**************)
FFileSize := (sr.FindData.nFileSizeHigh * MAXDWORD) + sr.FindData.nFileSizeLow;
//FFileName:=NewName;
end;
end;
procedure TJvFileName.LoadFromStream(AStream: TStream; APos: Integer);
begin
// Under Construction;
end;
procedure TJvFileName.SaveToStream(AStream: TStream; APos: Integer);
begin
//Under Construction
end;
function TJvFileName.GetLength: Integer;
begin
Result := System.Length(FFileName);
end;
procedure TJvFileName.SetLength(NewLength: Integer);
begin
System.SetLength(FFileName, NewLength);
end;
end.

2
components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas
View File

@ -22,6 +22,8 @@ Known Issues:
-----------------------------------------------------------------------------}
// $Id$
{$MODE objfpc}{$H+}
unit JvTabBarXPPainter;

1146
components/jvcllaz/run/JvCustomControls/JvThumbImage.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1219
components/jvcllaz/run/JvCustomControls/JvThumbViews.pas Normal file
View File

File diff suppressed because it is too large Load Diff

645
components/jvcllaz/run/JvCustomControls/JvThumbnails.pas Normal file
View File

@ -0,0 +1,645 @@
{-----------------------------------------------------------------------------
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: JvThumbNail.PAS, released on 2002-07-03.
The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
All Rights Reserved.
Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Description:
Thumbimage, ThumbNail components
Thumbimage is a TImage descentant wich passes the control of the mouse events
to the ThumbNail and have the ability to change an images look by changing
the rgb values with the changergb,changergbcurve procedures.
You can have precise control over the images look.
The changergb procedure just adds the values you pass to its rgb variables to
the actual values of the image.
The Changergbcurves procedure just replaces the value of the rgb values
accordingly with the values that passed in the the arrays.
e.g.
the r array in the position 15 has a value of 35 this meens that wherever in
the Picture there is a pixels which has a red value equall to 15 it will be ]
replaced with the value 35.
ThumbNail is what the name says a component to simply shrink an image
proportionally to fit in a portion of the screen with some extra mouse handling
to Create a Button like effect. Just give it a FileName and it will do the work
for you.
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvThumbnails;
{$MODE objfpc}{$H+}
interface
uses
LCLIntf, LCLType, LMessages,
Classes, Controls, ExtCtrls, SysUtils, Graphics, Forms,
JvThumbImage, JvBaseThumbnail, Dialogs;
const
TH_IMAGESIZECHANGED = WM_USER + 1;
type
// (rom) elements renamed
TTitlePos = (tpUp, tpDown, tpNone);
TTitleNotify = procedure(Sender: TObject; FileName: string;
var ThumbnailTitle: string) of object;
TJvThumbnail = class(TJvBaseThumbnail)
private
FTitle: string;
FTitlePanel: TJvThumbTitle;
FTitleColor: TColor;
FTitleFont: TFont;
FStreamFileKind: TGRFKind;
FDFileCreated: string;
FDFileChanged: string;
FDFileAccessed: string;
FShowTitle: Boolean;
FDFileSize: Longint;
FStream: TStream;
FImageWidth: Longint;
FImageHeight: Longint;
FClientHeight: Word;
FClientWidth: Word;
FShadowObj: TShape;
FUpdated: Boolean;
FImageReady: Boolean;
FTitlePlacement: TTitlePos;
FPhotoName: TJvFileName;
FPhoto: TJvThumbImage;
FOnGetTitle: TTitleNotify;
FMousePressed: Boolean;
FDestroying: Boolean;
FAsButton: Boolean;
FMinimizeMemory: Boolean;
FAutoLoad: Boolean; // if True then load the image either from a thumb file or Create it from the FileName
FShadowColor: TColor;
FShowShadow: Boolean;
FHShadowOffset: Word;
FVShadowOffset: Word;
procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
(************** NOT CONVERTED ***
procedure PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean;
const R: TRect; const Msg: string);
*******************************)
procedure RefreshFont(Sender: TObject);
procedure SetFileName(const AFile: string);
function LoadFile(AFile: string): string;
function GetFileName: string;
procedure CalculateImageSize; virtual;
procedure SetClientWidth(AWidth: Word);
procedure SetDummyStr(AStr: string);
procedure SetMinimizeMemory(Min: Boolean);
procedure SetDummyCard(AInt: Longint);
procedure SetClientHeight(AHeight: Word);
procedure SetShowTitle(const AState: Boolean);
procedure SetTitlePlacement(const AState: TTitlePos);
procedure SetTitle(const Value: string);
procedure SetTitleColor(const Value: TColor);
procedure SetStream(const AStream: TStream);
procedure SetTitleFont(const Value: TFont);
procedure GetFileInfo(AName: string);
procedure SetShowShadow(AShow: Boolean);
// procedure SetShadowColor(aColor: TColor);
protected
procedure THSizeChanged(var Msg: TLMessage); message TH_IMAGESIZECHANGED;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure BoundsChanged; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetTitlePanel(ATitle: string; AFont: TFont; AColor: TColor);
procedure Refresh;
property Stream: TStream read FStream write SetStream;
property Photo: TJvThumbImage read FPhoto write FPhoto;
published
property FileName: string read GetFileName write SetFileName;
property Title: string read FTitle write SetTitle;
property TitleColor: TColor read FTitleColor write SetTitleColor;
property TitleFont: TFont read FTitleFont write SetTitleFont;
property ImageReady: Boolean read FImageReady;
property OnGetTitle: TTitleNotify read FOnGetTitle write FOnGetTitle;
property ClientWidth: Word read FClientWidth write SetClientWidth;
property ClientHeight: Word read FClientHeight write SetClientHeight;
{ Do not store dummies }
property FileSize: Longint read FDFileSize write SetDummyCard stored False;
property FileAccessed: string read FDFileAccessed write SetDummyStr stored False;
property FileCreated: string read FDFileCreated write SetDummyStr stored False;
property FileChanged: string read FDFileChanged write SetDummyStr stored False;
property ImageWidth: Longint read FImageWidth default 0;
property ImageHeight: Longint read FImageHeight default 0;
property AsButton: Boolean read FAsButton write FAsButton;
property MinimizeMemory: Boolean read FMinimizeMemory write SetMinimizeMemory;
property StreamFileType: TGRFKind read FStreamFileKind write FStreamFileKind;
property ShowTitle: Boolean read FShowTitle write SetShowTitle;
property TitlePlacement: TTitlePos read FTitlePlacement write SetTitlePlacement;
property AutoLoad: Boolean read FAutoLoad write FAutoLoad;
property ShadowColor: TColor read FShadowColor write FShadowColor;
property ShowShadow: Boolean read FShowShadow write SetShowShadow;
end;
implementation
uses
FileUtil,
JvThumbViews, JvResources;
constructor TJvThumbnail.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPhotoName := TJvFileName.Create;
FHShadowOffset := 3;
FVShadowOffset := 3;
FShowShadow := False;
FShadowColor := clSilver;
FShadowObj := TShape.Create(Self);
FShadowObj.Visible := FShowShadow;
FShadowObj.Brush.Color := FShadowColor;
FShadowObj.Parent := Self;
FShadowObj.Pen.Style := psClear;
Photo := TJvThumbImage.Create(Self);
Photo.AutoSize := False;
Photo.Align := alNone;
Photo.Stretch := True;
(************** NOT CONVERTED)
Photo.OnProgress := PhotoOnProgress;
**************)
FShadowObj.Width := Photo.Width;
FShadowObj.Height := Photo.Height;
FShadowObj.Left := Photo.Left + FHShadowOffset;
FShadowObj.Top := Photo.Top + FVShadowOffset;
FTitlePanel := TJvThumbTitle.Create(Self);
FTitlePanel.Align := alTop;
FTitlePanel.Height := 15;
FTitlePanel.Alignment := taCenter;
FTitleColor := clBtnFace;
FTitlePanel.Color := FTitleColor;
FTitleFont := TFont.Create;
FTitleFont.OnChange := @RefreshFont;
FTitlePanel.BevelOuter := bvLowered;
FTitlePanel.ParentColor := True;
FTitlePanel.Color := Self.Color;
if FTitlePlacement = tpNone then
FTitlePanel.Visible := False;
FTitle := '';
FUpdated := False;
InsertControl(Photo);
InsertControl(FTitlePanel);
Align := alNone;
if AOwner is TJvThumbView then
begin
Width := TJvThumbView(Owner).MaxWidth;
Height := TJvThumbView(Owner).MaxHeight;
end
else
begin
Width := 120;
Height := 120;
end;
FMinimizeMemory := True;
AsButton := False;
Left := 10;
Top := 10;
Visible := True;
BevelOuter := bvRaised;
StreamFileType := grBMP;
FAutoLoad := True;
end;
destructor TJvThumbnail.Destroy;
begin
FDestroying := True;
(************* NOT CONVERTED ***
Photo.OnProgress := nil;
**********)
FPhotoName.Free;
FTitleFont.OnChange := nil;
FTitleFont.Free;
inherited Destroy;
end;
procedure TJvThumbnail.SetShowTitle(const AState: Boolean);
begin
if AState <> FShowTitle then
begin
FShowTitle := AState;
FTitlePanel.Visible := AState;
end
end;
procedure TJvThumbnail.BoundsChanged;
begin
CalculateImageSize;
inherited BoundsChanged;
end;
procedure TJvThumbnail.SetStream(const AStream: TStream);
var
Bmp: Graphics.TBitmap;
Size: TPoint;
Img2: TJPEGImage;
begin
case StreamFileType of
grBMP:
Photo.Picture.Bitmap.LoadFromStream(AStream);
(********* NOT CONVERTED ***
grEMF, grWMF:
Photo.Picture.Metafile.LoadFromStream(AStream);
*************************)
grJPG:
begin
Img2 := TJPEGImage.Create;
Img2.LoadFromStream(AStream);
Photo.Picture.Assign(Img2);
FreeAndNil(Img2);
end;
end;
if FMinimizeMemory then
begin
Bmp := Graphics.TBitmap.Create;
if Parent is TJvThumbView then
Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
Point(TJvThumbView(Parent).MaxWidth, TJvThumbView(Parent).MaxHeight))
else
Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
Point(Width, Height));
Bmp.Width := Size.X;
Bmp.Height := Size.Y;
Bmp.handletype := bmDIB;
Bmp.pixelformat := pf24bit;
Bmp.Canvas.StretchDraw(rect(0, 0, Bmp.Width, Bmp.Height),
Photo.Picture.Graphic);
//Photo.Picture.Graphic.Free; // (rom) not needed
//Photo.Picture.Graphic := nil;
Photo.Picture.Assign(Bmp);
Bmp.Free;
end;
end;
procedure TJvThumbnail.SetClientWidth(AWidth: Word);
begin
FClientWidth := (Width - (BorderWidth * 2)) - 8;
end;
procedure TJvThumbnail.SetClientHeight(AHeight: Word);
begin
if Assigned(FTitlePanel) then
FClientHeight := Height - (FTitlePanel.Height + 8)
else
FClientHeight := Height - 8;
end;
// dummy property functions to allow the object inspector to
// show the properties and their values
procedure TJvThumbnail.SetDummyStr(AStr: string);
begin
end;
procedure TJvThumbnail.SetDummyCard(AInt: Longint);
begin
end;
(********** NOT CONVERTED ***
procedure TJvThumbnail.PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
FImageReady := (Stage = psEnding);
end;
***************************)
procedure TJvThumbnail.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if AsButton then
if Button = mbLeft then
begin
FMousePressed := True;
BevelOuter := bvLowered;
FTitlePanel.BevelOuter := bvRaised;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TJvThumbnail.SetShowShadow(AShow: Boolean);
begin
FShadowObj.Visible := AShow;
FShowShadow := AShow;
end;
{procedure TJvThumbnail.SetShadowColor(aColor: TColor);
begin
FShadowObj.Brush.Color := aColor;
FShadowColor := aColor;
end;}
procedure TJvThumbnail.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if AsButton then
if FMousePressed then
begin
if (X < 0) or (X > Width) or (Y < 0) or (Y > Height) then
begin
BevelOuter := bvRaised;
FTitlePanel.BevelOuter := bvLowered
end
else
begin
BevelOuter := bvLowered;
FTitlePanel.BevelOuter := bvRaised;
end;
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TJvThumbnail.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if AsButton then
if Button = mbLeft then
begin
FMousePressed := False;
BevelOuter := bvRaised;
FTitlePanel.BevelOuter := bvLowered;
end;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TJvThumbnail.GetFileInfo(AName: String);
var
FileInfo: TSearchRec;
begin
if FileExists(AName) then begin
FDFilesize := FileUtil.FileSize(AName);
// Other fields not supported
end;
end;
{ wp ----------- partly replaced by above
procedure TJvThumbnail.GetFileInfo(AName: string);
var
FileInfo: TWin32FindData;
H: THandle;
Dft: DWORD;
Lft: TFileTime;
begin
H := Windows.FindFirstFile(PChar(AName), FileInfo);
if H <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(H);
FileTimeToLocalFileTime(FileInfo.ftLastAccessTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
try
FDFileAccessed := DateTimeToStr(FileDateToDateTime(Dft));
except
FDFileAccessed := RsUnknown;
end;
FileTimeToLocalFileTime(FileInfo.ftLastwriteTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
try
FDFileChanged := DateTimeToStr(FileDateToDateTime(Dft));
except
FDFileChanged := RsUnknown;
end;
FileTimeToLocalFileTime(FileInfo.ftCreationTime, Lft);
FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
try
FDFileCreated := DateTimeToStr(FileDateToDateTime(Dft));
except
FDFileCreated := RsUnknown;
end;
FDFileSize := (FileInfo.nFileSizeHigh * MAXDWORD) + FileInfo.nFileSizeLow;
end;
end;
---------------- }
function TJvThumbnail.GetFileName: string;
begin
Result := FPhotoName.FileName;
end;
function TJvThumbnail.LoadFile(AFile: string): string;
var
FName: string;
begin
try
FName := AFile;
Photo.LoadFromFile(AFile);
FImageWidth := Photo.Picture.Width;
FImageHeight := Photo.Picture.Height;
FUpdated := False;
CalculateImageSize;
Photo.Visible := True;
except
// (rom) ShowMessage removed
FName := '';
end;
if MinimizeMemory and (FPhotoName.FileName <> '') then
begin
if Owner is TJvThumbView then
Photo.ScaleDown(TJvThumbView(Owner).MaxWidth, TJvThumbView(Owner).MaxHeight)
else
Photo.ScaleDown(Width, Height);
end;
Result := FName;
end;
procedure TJvThumbnail.SetFileName(const AFile: string);
var
FName: string;
// Pos: Longint;
// tmp: TJvThumbImage;
// D1, D2: TdateTime;
begin
if AFile <> '' then
begin
GetFileInfo(AFile);
if FAutoLoad then
FName := LoadFile(AFile);
end
else
FName := ''; {}
if FName = AFile then
if (Title = ExtractFileName(FPhotoName.FileName)) or (Title = '') then
Title := ExtractFileName(FName);
FPhotoName.FileName := FName;
end;
procedure TJvThumbnail.CalculateImageSize;
var
Percent: Byte;
TempX, TempY: Single;
begin
if (Photo = nil) or (Photo.Picture = nil) then
exit;
SetClientHeight(15);
SetClientWidth(15);
if (Photo.Picture.Width > ClientWidth) or (Photo.Picture.Height > ClientHeight) then
begin
TempX := ((ClientWidth) / Photo.Picture.Width) * 100;
TempY := ((ClientHeight) / Photo.Picture.Height) * 100;
end
else
begin
TempX := 100;
TempY := 100;
end;
if TempX <= TempY then
Percent := Trunc(TempX)
else
Percent := Trunc(TempY);
Photo.Width := Trunc((Photo.Picture.Width / 100) * Percent);
Photo.Height := Trunc((Photo.Picture.Height / 100) * Percent);
Photo.Left := Trunc(Width / 2 - Photo.Width / 2);
Photo.Top := (Height div 2) - (Photo.Height div 2);
case FTitlePlacement of
tpUp:
Photo.Top := Photo.Top + (FTitlePanel.Height div 2);
tpDown:
Photo.Top := Photo.Top - (FTitlePanel.Height div 2);
end;
FShadowObj.SetBounds(Photo.Left + FHShadowOffset, Photo.Top + FVShadowOffset,
Photo.Width, Photo.Height);
end;
procedure TJvThumbnail.THSizeChanged(var Msg: TLMessage);
begin
CalculateImageSize;
end;
procedure TJvThumbnail.SetTitle(const Value: string);
begin
if Value <> FTitle then
begin
FTitle := Value;
FTitlePanel.Caption := Value;
end;
end;
procedure TJvThumbnail.WMPaint(var Msg: TLMPaint);
var
ThumbnailTitle: string;
begin
if not FUpdated then
begin
ThumbnailTitle := Title;
if Assigned(FOnGetTitle) then
begin
FOnGetTitle(Self, FileName, ThumbnailTitle);
SetTitle(ThumbnailTitle);
end
else
begin
if ThumbnailTitle = '' then
SetTitle(ExtractFileName(FileName))
else
SetTitle(ThumbnailTitle);
end;
FUpdated := True;
end;
inherited;
end;
procedure TJvThumbnail.SetTitleColor(const Value: TColor);
begin
if Value <> FTitleColor then
begin
FTitleColor := Value;
FTitlePanel.Color := Value;
end;
end;
procedure TJvThumbnail.SetTitleFont(const Value: TFont);
begin
FTitleFont.Assign(Value);
end;
procedure TJvThumbnail.RefreshFont(Sender: TObject);
begin
FTitlePanel.Font.Assign(FTitleFont);
end;
procedure TJvThumbnail.SetTitlePanel(ATitle: string; AFont: TFont;
AColor: TColor);
begin
SetTitleFont(AFont);
SetTitleColor(AColor);
SetTitle(ATitle);
FUpdated := True;
end;
procedure TJvThumbnail.SetTitlePlacement(const AState: TTitlePos);
begin
if AState <> FTitlePlacement then
case AState of
tpUp:
FTitlePanel.Align := alTop;
tpDown:
FTitlePanel.Align := alBottom;
tpNone:
FTitlePanel.Visible := False;
end;
if FTitlePlacement = tpNone then
FTitlePanel.Visible := True;
FTitlePlacement := AState;
CalculateImageSize;
end;
procedure TJvThumbnail.SetMinimizeMemory(Min: Boolean);
begin
if Assigned(Photo.Picture.Graphic) then
begin
if FMinimizeMemory <> Min then
begin
if Min then
begin
if Owner is TJvThumbView then
Photo.ScaleDown(TJvThumbView(Owner).MaxWidth, TJvThumbView(Owner).MaxHeight)
else
Photo.ScaleDown(Width, Height);
end
else
if FMinimizeMemory then
Photo.Picture.LoadFromFile(FileName);
FMinimizeMemory := Min;
end;
end
else
FMinimizeMemory := Min;
end;
procedure TJvThumbnail.Refresh;
begin
CalculateImageSize;
inherited Refresh;
end;
end.