diff --git a/components/jvcllaz/design/JvCore/JvDsgnConsts.pas b/components/jvcllaz/design/JvCore/JvDsgnConsts.pas index 9d8119b6b..90c81e700 100644 --- a/components/jvcllaz/design/JvCore/JvDsgnConsts.pas +++ b/components/jvcllaz/design/JvCore/JvDsgnConsts.pas @@ -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 diff --git a/components/jvcllaz/design/JvCustomControls/images/images.txt b/components/jvcllaz/design/JvCustomControls/images/images.txt index 2c09e016e..69b1cfde2 100644 --- a/components/jvcllaz/design/JvCustomControls/images/images.txt +++ b/components/jvcllaz/design/JvCustomControls/images/images.txt @@ -4,3 +4,6 @@ Tjvtabbarxppainter.bmp tjvoutlookbar.bmp tjvtimeline.bmp tjvtmtimeline.bmp +tjvthumbnail.bmp +tjvthumbimage.bmp +tjvthumbview.bmp diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvthumbimage.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvthumbimage.bmp new file mode 100644 index 000000000..86c920958 Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvthumbimage.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvthumbnail.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvthumbnail.bmp new file mode 100644 index 000000000..36a9c1f3c Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvthumbnail.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvthumbview.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvthumbview.bmp new file mode 100644 index 000000000..ed1fd1aef Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvthumbview.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas b/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas index f63001392..34f2ba5c0 100644 --- a/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas +++ b/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas @@ -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 ]); diff --git a/components/jvcllaz/design/JvCustomControls/jvoutlookbareditors.pas b/components/jvcllaz/design/JvCustomControls/jvoutlookbareditors.pas index 802016f9c..01d3869d4 100644 --- a/components/jvcllaz/design/JvCustomControls/jvoutlookbareditors.pas +++ b/components/jvcllaz/design/JvCustomControls/jvoutlookbareditors.pas @@ -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; diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.lfm b/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.lfm new file mode 100644 index 000000000..947bfef75 --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.lfm @@ -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 diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.pas b/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.pas new file mode 100644 index 000000000..45bdbc791 --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailChildFormU.pas @@ -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. diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpi b/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpi new file mode 100644 index 000000000..ad3882fe6 --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpi @@ -0,0 +1,91 @@ + + + + + + + + + + <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> diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpr b/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpr new file mode 100644 index 000000000..54bdde546 --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailDemo.lpr @@ -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. diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.lfm b/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.lfm new file mode 100644 index 000000000..4f696eef0 --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.lfm @@ -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 diff --git a/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.pas b/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.pas new file mode 100644 index 000000000..df302065a --- /dev/null +++ b/components/jvcllaz/examples/JvThumbnail/JvThumbnailMainFormU.pas @@ -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. diff --git a/components/jvcllaz/packages/JvCoreLazR.lpk b/components/jvcllaz/packages/JvCoreLazR.lpk index 037ded4b4..881facc5c 100644 --- a/components/jvcllaz/packages/JvCoreLazR.lpk +++ b/components/jvcllaz/packages/JvCoreLazR.lpk @@ -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> diff --git a/components/jvcllaz/packages/jvcustomlazr.lpk b/components/jvcllaz/packages/jvcustomlazr.lpk index 553fe09ac..e131d5467 100644 --- a/components/jvcllaz/packages/jvcustomlazr.lpk +++ b/components/jvcllaz/packages/jvcustomlazr.lpk @@ -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> diff --git a/components/jvcllaz/resource/jvcustomreg.res b/components/jvcllaz/resource/jvcustomreg.res index 7b8f170c6..892313faf 100644 Binary files a/components/jvcllaz/resource/jvcustomreg.res and b/components/jvcllaz/resource/jvcustomreg.res differ diff --git a/components/jvcllaz/run/JvCore/JvThemes.pas b/components/jvcllaz/run/JvCore/JvThemes.pas new file mode 100644 index 000000000..97c6f6f00 --- /dev/null +++ b/components/jvcllaz/run/JvCore/JvThemes.pas @@ -0,0 +1,1042 @@ +{----------------------------------------------------------------------------- +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: JvThemes.PAS, released on 2003-09-25 + +The Initial Developers of the Original Code are: Andreas Hausladen <Andreas dott Hausladen att gmx dott de> +All Rights Reserved. + +Contributors: + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvThemes; + +{$mode objfpc}{$H+} +{$DEFINE JVCLThemesEnabled} + +{$DEFINE COMPILER7_UP} + +(* +{$I jvcl.inc} +{$IFDEF JVCLThemesEnabled} +{$I windowsonly.inc} +{$ENDIF JVCLThemesEnabled} +*) + +interface + +uses +{ + Windows, Messages, CommCtrl, + } + Types, SysUtils, Classes, Contnrs, + {$IFDEF JVCLThemesEnabled} + Themes, UxTheme, + {$ENDIF JVCLThemesEnabled} + Controls, Forms, Graphics, Buttons; + +(************************************** NOT CONVERTED *** +const + // Add a message handler to a component that is themed by the ThemeManager but + // should not be themed. + CM_DENYSUBCLASSING = CM_BASE + 2000; // from ThemeMgr.pas + +type + TCMDenySubClassing = TMessage; + +{$IFDEF JVCLThemesEnabled} + +{$IFNDEF COMPILER16_UP} +type + TElementSize = (esMinimum, esActual, esStretch); +{$ELSE} + esMinimum = TElementSize.esStretch; + esActual = TElementSize.esActual; + esStretch = TElementSize.esStretch; +{$ENDIF ~COMPILER16_UP} +************) +type + TThemeServicesEx = class(TThemeServices) + (*************** NOT CONVERTED *** + {$IFNDEF COMPILER16_UP} + private + function DoGetElementSize(DC: HDC; Details: TThemedElementDetails; Rect: PRect; + ElementSize: TElementSize; out Size: TSize): Boolean; + {$ENDIF ~COMPILER16_UP} + public + {$IFNDEF COMPILER7_UP} + procedure ApplyThemeChange; + {$ENDIF ~COMPILER7_UP} + {$IFNDEF COMPILER16_UP} + function GetElementContentRect(DC: HDC; Details: TThemedElementDetails; + const BoundingRect: TRect; out AContentRect: TRect): Boolean; + function GetElementSize(DC: HDC; Details: TThemedElementDetails; ElementSize: TElementSize; + out Size: TSize): Boolean; overload; + function GetElementSize(DC: HDC; Details: TThemedElementDetails; const Rect: TRect; + ElementSize: TElementSize; out Size: TSize): Boolean; overload; + function IsSystemStyle: Boolean; + function Enabled: Boolean; + function Available: Boolean; + function GetSystemColor(Color: TColor): TColor; + {$ENDIF ~COMPILER16_UP} + ****************) + end; + +function ThemeServices: TThemeServicesEx; +function StyleServices: TThemeServicesEx; + +(******************* NOT CONVERTED +{ PaintControlBorder paints the themed border for WinControls only when they + have the WS_EX_CLIENTEDGE. } +procedure PaintControlBorder(Control: TWinControl); + +{ DrawThemedBorder draws a teEditTextNormal element (border) to the DC. It uses + the Control's BoundsRect. DrawThemedBorder forces border painting. } +procedure DrawThemedBorder(Control: TControl); + +{$ENDIF JVCLThemesEnabled} +**********************) + +type + TJvThemeStyle = TControlStyle; +{ + Instead of the ControlStyle property you should use the following functions: + + ControlStyle := ControlStyle + [csXxx]; -> IncludeThemeStyle(Self, [csXxx]); + ControlStyle := ControlStyle - [csXxx]; -> ExcludeThemeStyle(Self, [csXxx]); + if csXxx in ControlStyle then -> if csXxx in GetThemeStyle(Self) then + +} +procedure IncludeThemeStyle(Control: TControl; Style: TJvThemeStyle); +procedure ExcludeThemeStyle(Control: TControl; Style: TJvThemeStyle); +function GetThemeStyle(Control: TControl): TJvThemeStyle; + +(***************************** NOT CONVERTED *** +{ DrawThemedBackground fills R with Canvas.Brush.Color/Color. If the control uses + csParentBackground and the color is that of it's parent the Rect is not filled + because then it is done by the JvThemes/VCL7. } +procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas; + const R: TRect; NeedsParentBackground: Boolean = True); overload; +procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas; + const R: TRect; Color: TColor; NeedsParentBackground: Boolean = True); overload; +procedure DrawThemedBackground(Control: TControl; DC: HDC; const R: TRect; + Brush: HBRUSH; NeedsParentBackground: Boolean = True); overload; + +{ DrawThemesFrameControl draws a themed frame control when theming is enabled. } +function DrawThemedFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL; + + +{ PerformEraseBackground sends a WM_ERASEBKGND message to the Control's parent. } +procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint); overload; +procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint; const R: TRect); overload; +procedure PerformEraseBackground(Control: TControl; DC: HDC); overload; +procedure PerformEraseBackground(Control: TControl; DC: HDC; const R: TRect); overload; + + +{ DrawThemedButtonFace draws a themed button when theming is enabled. } +function DrawThemedButtonFace(Control: TControl; Canvas: TCanvas; const Client: TRect; + BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, + IsFocused, IsHot: Boolean): TRect; + +{ IsMouseOver returns True if the mouse is over the control. } +function IsMouseOver(Control: TControl): Boolean; + +// ~COMPILER7_UP: These functions are helpers for Delphi 6 that doesn't have the csParentPackground flag. +{ GetParentBackground returns True if the Control has the csParentPackground + ControlStyle } +function GetParentBackground(Control: TWinControl): Boolean; +{ SetParentBackground sets the Control's csParentPackground ControlStyle } +procedure SetParentBackground(Control: TWinControl; Value: Boolean); + +{ GetGlassPaintFlag returns True if csGlassPaint in ControlState } +function GetGlassPaintFlag(AControl: TControl): Boolean; +{ ControlInGlassPaint returns True if the Control is painted on a glass area } +function ControlInGlassPaint(AControl: TControl): Boolean; +{ DrawGlassableText paints text to a device context with support of PaintOnGlass } +procedure DrawGlassableText(DC: HDC; const Text: string; var TextRect: TRect; TextFlags: Cardinal; + PaintOnGlass: Boolean = False); +{ DrawGlassableImageList paint a transparent imagelist image to the canvas with + support of PaintOnGlass } +procedure DrawGlassableImageList(ImageList: HIMAGELIST; Index: Integer; Dest: HDC; X, Y: Integer; + Style: UINT; PaintOnGlass: Boolean = False); + +******************) + +implementation +(* +uses +{$IFNDEF COMPILER10_UP} + JclSysUtils, +{$ENDIF ~COMPILER10_UP} + JclSysInfo; + *) + +(************************ NOT CONVERTED *** +type + TWinControlThemeInfo = class(TWinControl) + public + property Color; + end; + +procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas; + const R: TRect; NeedsParentBackground: Boolean = True); +begin + DrawThemedBackground(Control, Canvas, R, Canvas.Brush.Color, NeedsParentBackground); +end; + +procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas; + const R: TRect; Color: TColor; NeedsParentBackground: Boolean = True); +var + Cl: TColor; +begin + {$IFDEF JVCLThemesEnabled} + if StyleServices.Enabled and + (Control.Parent <> nil) and + ((Color = TWinControlThemeInfo(Control.Parent).Color) or + (ColorToRGB(Color) = ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and + (not NeedsParentBackground or (csParentBackground in GetThemeStyle(Control))) then + begin + if Control is TWinControl then + begin + if TWinControl(Control).DoubleBuffered then + PerformEraseBackground(Control, Canvas.Handle, R) + else + StyleServices.DrawParentBackground(TWinControl(Control).Handle, Canvas.Handle, nil, + False, @R); + end + else + PerformEraseBackground(Control, Canvas.Handle, R) + end + else + {$ENDIF JVCLThemesEnabled} + begin + {$IFDEF JVCLStylesEnabled} + if StyleServices.Enabled and TStyleManager.IsCustomStyleActive then + Color := StyleServices.GetSystemColor(Color); + {$ENDIF JVCLStylesEnabled} + Cl := Canvas.Brush.Color; + if Cl <> Color then + Canvas.Brush.Color := Color; + Canvas.FillRect(R); + if Cl <> Canvas.Brush.Color then + Canvas.Brush.Color := Cl; + end; +end; + +procedure DrawThemedBackground(Control: TControl; DC: HDC; const R: TRect; + Brush: HBRUSH; NeedsParentBackground: Boolean = True); +{$IFDEF JVCLThemesEnabled} +var + LogBrush: TLogBrush; +{$ENDIF JVCLThemesEnabled} +begin + {$IFDEF JVCLThemesEnabled} + GetObject(Brush, SizeOf(LogBrush), @LogBrush); + if StyleServices.Enabled and + (Control.Parent <> nil) and + (LogBrush.lbColor = Cardinal(ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and + (not NeedsParentBackground or (csParentBackground in GetThemeStyle(Control))) then + begin + if Control is TWinControl then + begin + if TWinControl(Control).DoubleBuffered then + PerformEraseBackground(Control, DC, R) + else + StyleServices.DrawParentBackground(TWinControl(Control).Handle, DC, nil, False, @R); + end + else + PerformEraseBackground(Control, DC, R) + end + else + {$ENDIF JVCLThemesEnabled} + FillRect(DC, R, Brush); +end; + +function DrawThemedFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL; +{$IFDEF JVCLThemesEnabled} +const + Mask = $00FF; +var + Btn: TThemedButton; + ComboBox: TThemedComboBox; + ScrollBar: TThemedScrollBar; + R: TRect; + Details: TThemedElementDetails; +{$ENDIF JVCLThemesEnabled} +begin + Result := False; + {$IFDEF JVCLThemesEnabled} + if StyleServices.Enabled then + begin + R := Rect; + case uType of + DFC_BUTTON: + case uState and Mask of + DFCS_BUTTONPUSH: + begin + if uState and (DFCS_TRANSPARENT or DFCS_FLAT) = 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbPushButtonDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbPushButtonPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbPushButtonHot + else + if uState and DFCS_MONO <> 0 then + Btn := tbPushButtonDefaulted + else + Btn := tbPushButtonNormal; + + Details := StyleServices.GetElementDetails(Btn); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + end; + DFCS_BUTTONCHECK: + begin + if uState and DFCS_CHECKED <> 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbCheckBoxCheckedDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbCheckBoxCheckedPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbCheckBoxCheckedHot + else + Btn := tbCheckBoxCheckedNormal; + end + else + if uState and DFCS_MONO <> 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbCheckBoxMixedDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbCheckBoxMixedPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbCheckBoxMixedHot + else + Btn := tbCheckBoxMixedNormal; + end + else + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbCheckBoxUncheckedDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbCheckBoxUncheckedPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbCheckBoxUncheckedHot + else + Btn := tbCheckBoxUncheckedNormal; + end; + Details := StyleServices.GetElementDetails(Btn); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + DFCS_BUTTONRADIO: + begin + if uState and DFCS_CHECKED <> 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbRadioButtonCheckedDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbRadioButtonCheckedPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbRadioButtonCheckedHot + else + Btn := tbRadioButtonCheckedNormal; + end + else + begin + if uState and DFCS_INACTIVE <> 0 then + Btn := tbRadioButtonUncheckedDisabled + else + if uState and DFCS_PUSHED <> 0 then + Btn := tbRadioButtonUncheckedPressed + else + if uState and DFCS_HOT <> 0 then + Btn := tbRadioButtonUncheckedHot + else + Btn := tbRadioButtonUncheckedNormal; + end; + Details := StyleServices.GetElementDetails(Btn); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + end; + DFC_SCROLL: + begin + case uState and Mask of + DFCS_SCROLLCOMBOBOX: + begin + if uState and DFCS_INACTIVE <> 0 then + ComboBox := tcDropDownButtonDisabled + else + if uState and DFCS_PUSHED <> 0 then + ComboBox := tcDropDownButtonPressed + else + if uState and DFCS_HOT <> 0 then + ComboBox := tcDropDownButtonHot + else + ComboBox := tcDropDownButtonNormal; + + Details := StyleServices.GetElementDetails(ComboBox); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + DFCS_SCROLLUP: + if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + ScrollBar := tsArrowBtnUpDisabled + else + if uState and DFCS_PUSHED <> 0 then + ScrollBar := tsArrowBtnUpPressed + else + if uState and DFCS_HOT <> 0 then + ScrollBar := tsArrowBtnUpHot + else + ScrollBar := tsArrowBtnUpNormal; + + Details := StyleServices.GetElementDetails(ScrollBar); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + DFCS_SCROLLDOWN: + if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + ScrollBar := tsArrowBtnDownDisabled + else + if uState and DFCS_PUSHED <> 0 then + ScrollBar := tsArrowBtnDownPressed + else + if uState and DFCS_HOT <> 0 then + ScrollBar := tsArrowBtnDownHot + else + ScrollBar := tsArrowBtnDownNormal; + + Details := StyleServices.GetElementDetails(ScrollBar); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + DFCS_SCROLLLEFT: + if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + ScrollBar := tsArrowBtnLeftDisabled + else + if uState and DFCS_PUSHED <> 0 then + ScrollBar := tsArrowBtnLeftPressed + else + if uState and DFCS_HOT <> 0 then + ScrollBar := tsArrowBtnLeftHot + else + ScrollBar := tsArrowBtnLeftNormal; + + Details := StyleServices.GetElementDetails(ScrollBar); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + DFCS_SCROLLRIGHT: + if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then + begin + if uState and DFCS_INACTIVE <> 0 then + ScrollBar := tsArrowBtnRightDisabled + else + if uState and DFCS_PUSHED <> 0 then + ScrollBar := tsArrowBtnRightPressed + else + if uState and DFCS_HOT <> 0 then + ScrollBar := tsArrowBtnRightHot + else + ScrollBar := tsArrowBtnRightNormal; + + Details := StyleServices.GetElementDetails(ScrollBar); + StyleServices.DrawElement(DC, Details, R); + Result := True; + end; + end; + end; + end; + end; + {$ENDIF JVCLThemesEnabled} + + if not Result then + Result := DrawFrameControl(DC, Rect, uType, uState); +end; + +function IsInvalidRect(const R: TRect): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := (R.Left = MaxInt) and (R.Top = MaxInt) and (R.Right = MaxInt) and (R.Bottom = MaxInt); +end; + +procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint); +begin + PerformEraseBackground(Control, DC, Offset, Rect(MaxInt, MaxInt, MaxInt, MaxInt)); +end; + +procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint; const R: TRect); +var + WindowOrg: TPoint; + OrgRgn, Rgn: THandle; + {$IFDEF COMPILER16_UP} + OldPen: HPEN; + OldBrush: HBRUSH; + OldFont: HFONT; + OldTextColor: TColorRef; + OldBkMode: Integer; + {$ENDIF COMPILER16_UP} +begin + if Control.Parent <> nil then + begin + if (Offset.X <> 0) and (Offset.Y <> 0) then + begin + GetWindowOrgEx(DC, WindowOrg); + if Control is TGraphicControl then + SetWindowOrgEx(DC, -Offset.X, -Offset.Y, nil) + else + SetWindowOrgEx(DC, WindowOrg.X + Offset.X, WindowOrg.Y + Offset.Y, nil); + end; + + OrgRgn := 0; + if not IsInvalidRect(R) then + begin + OrgRgn := CreateRectRgn(0, 0, 1, 1); + if GetClipRgn(DC, OrgRgn) = 0 then + begin + DeleteObject(OrgRgn); + OrgRgn := 0; + end; + Rgn := CreateRectRgnIndirect(R); + SelectClipRgn(DC, Rgn); + DeleteObject(Rgn); + end; + + try + {$IFDEF COMPILER16_UP} + // Delphi XE2's Style-Engine has a bug in the TStyleHook.WMEraseBkgnd that replaces the + // selected GDI objects with the TCanvas default objects ("System" font, ...). + // We need to repair the damage in order to have the same behavior of the native theming API. + // General rule for WM_ERASEBKGND: Return the DC in the state in that it was when the function + // was called. + OldPen := 0; + OldBrush := 0; + OldFont := 0; + OldTextColor := 0; + OldBkMode := 0; + if StyleServices.Enabled and not StyleServices.IsSystemStyle then + begin + OldPen := GetCurrentObject(DC, OBJ_PEN); + OldBrush := GetCurrentObject(DC, OBJ_BRUSH); + OldFont := GetCurrentObject(DC, OBJ_FONT); + OldTextColor := GetTextColor(DC); + OldBkMode := GetBkMode(DC); + end; + {$ENDIF COMPILER16_UP} + Control.Parent.Perform(WM_ERASEBKGND, DC, DC); // force redraw + {$IFDEF COMPILER16_UP} + if StyleServices.Enabled and not StyleServices.IsSystemStyle then + begin + if GetCurrentObject(DC, OBJ_PEN) <> OldPen then + SelectObject(DC, OldPen); + if GetCurrentObject(DC, OBJ_BRUSH) <> OldBrush then + SelectObject(DC, OldBrush); + if GetCurrentObject(DC, OBJ_FONT) <> OldFont then + SelectObject(DC, OldFont); + if GetTextColor(DC) <> OldTextColor then + SetTextColor(DC, OldTextColor); + if GetBkMode(DC) <> OldBkMode then + SetBkMode(DC, OldBkMode); + end; + {$ENDIF COMPILER16_UP} + finally + if (Offset.X <> 0) and (Offset.Y <> 0) then + SetWindowOrgEx(DC, WindowOrg.X, WindowOrg.Y, nil); + + if OrgRgn <> 0 then + begin + SelectClipRgn(DC, OrgRgn); + DeleteObject(OrgRgn); + end; + end; + end; +end; + +procedure PerformEraseBackground(Control: TControl; DC: HDC); +begin + PerformEraseBackground(Control, DC, Point(Control.Left, Control.Top)); +end; + +procedure PerformEraseBackground(Control: TControl; DC: HDC; const R: TRect); +begin + PerformEraseBackground(Control, DC, Point(Control.Left, Control.Top), R); +end; + +function DrawThemedButtonFace(Control: TControl; Canvas: TCanvas; + const Client: TRect; BevelWidth: Integer; Style: TButtonStyle; + IsRounded, IsDown, IsFocused, IsHot: Boolean): TRect; +{$IFDEF JVCLThemesEnabled} +var + Btn: TThemedButton; + Details: TThemedElementDetails; +{$ENDIF JVCLThemesEnabled} +begin + {$IFDEF JVCLThemesEnabled} + if (Style <> bsWin31) and StyleServices.Enabled then + begin + Result := Client; + + if IsDown then + Btn := tbPushButtonPressed + else + if IsFocused then + Btn := tbPushButtonDefaulted + else + if IsHot then + Btn := tbPushButtonHot + else + Btn := tbPushButtonNormal; + + Details := StyleServices.GetElementDetails(Btn); + StyleServices.DrawElement(Canvas.Handle, Details, Result); + StyleServices.GetElementContentRect(Canvas.Handle, Details, Client, Result); + + if IsFocused then + DrawFocusRect(Canvas.Handle, Result); + + InflateRect(Result, -BevelWidth, -BevelWidth); + end + else + {$ENDIF JVCLThemesEnabled} + Result := DrawButtonFace(Canvas, Client, BevelWidth, Style, IsRounded, IsDown, IsFocused); +end; + +function IsMouseOver(Control: TControl): Boolean; +var + Pt: TPoint; +begin + Pt := Control.ScreenToClient(Mouse.CursorPos); + Result := PtInRect(Control.ClientRect, Pt); +end; + +function GetParentBackground(Control: TWinControl): Boolean; +begin + Result := csParentBackground in GetThemeStyle(Control); +end; + +procedure SetParentBackground(Control: TWinControl; Value: Boolean); +begin + if Value <> GetParentBackground(Control) then + begin + if Value then + IncludeThemeStyle(Control, [csParentBackground]) + else + ExcludeThemeStyle(Control, [csParentBackground]); + Control.Invalidate; + end; +end; + +function GetGlassPaintFlag(AControl: TControl): Boolean; +{$IFDEF COMPILER11} +var + Form: TCustomForm; +{$ENDIF COMPILER11} +begin + {$IFDEF COMPILER12_UP} + Result := csGlassPaint in AControl.ControlState; + {$ELSE} + Result := False; + {$IFDEF COMPILER11} + Form := GetParentForm(AControl); + if (Form <> nil) and Form.GlassFrame.Enabled then + Result := Form.GlassFrame.IntersectsControl(AControl); + {$ENDIF COMPILER11} + {$ENDIF COMPILER12_UP} +end; + +function ControlInGlassPaint(AControl: TControl): Boolean; +{$IFDEF COMPILER11_UP} +var + Parent: TWinControl; +{$ENDIF COMPILER11_UP} +begin + {$IFDEF COMPILER11_UP} + Result := GetGlassPaintFlag(AControl); + if Result then + begin + Parent := AControl.Parent; + while (Parent <> nil) and not Parent.DoubleBuffered and not (Parent is TCustomForm) do + Parent := Parent.Parent; + Result := (Parent = nil) or not Parent.DoubleBuffered or (Parent is TCustomForm); + end; + {$ELSE} + Result := False; + {$ENDIF COMPILER11_UP} +end; + +procedure DrawGlassableText(DC: HDC; const Text: string; var TextRect: TRect; TextFlags: Cardinal; + PaintOnGlass: Boolean = False); +{$IFDEF COMPILER11_UP} +var + Options: TDTTOpts; + {$IFDEF COMPILER11} + S: WideString; + {$ENDIF COMPILER11} +{$ENDIF COMPILER11_UP} +begin + {$IFDEF COMPILER11_UP} + if StyleServices.Enabled and JclCheckWinVersion(6, 0) then + begin + FillChar(Options, SizeOf(Options), 0); + Options.dwSize := SizeOf(Options); + if TextFlags and DT_CALCRECT <> 0 then + Options.dwFlags := Options.dwFlags or DTT_CALCRECT; + if PaintOnGlass then + Options.dwFlags := Options.dwFlags or DTT_COMPOSITED; + Options.dwFlags := Options.dwFlags or DTT_TEXTCOLOR; + Options.crText := GetTextColor(DC); + + {$IFDEF COMPILER16_UP} + if not StyleServices.IsSystemStyle then + begin + // The Style engine doesn't have DrawThemeTextEx support + {$WARNINGS OFF} // ignore "deprecated" warning + StyleServices.DrawText(DC, StyleServices.GetElementDetails(tbPushButtonNormal), Text, TextRect, TextFlags, 0); + {$WARNINGS ON} + Exit; + end + else + {$ENDIF} + begin + {$IFDEF COMPILER12_UP} + with ThemeServices do + if DrawThemeTextEx(Theme[teToolBar], DC, TP_BUTTON, TS_NORMAL, PWideChar(Text), Length(Text), + TextFlags, TextRect, Options) <> E_NOTIMPL then + Exit; + {$ELSE} + S := Text; + with ThemeServices do + if DrawThemeTextEx(Theme[teToolBar], DC, TP_BUTTON, TS_NORMAL, PWideChar(S), Length(S), + TextFlags, @TextRect, Options) <> E_NOTIMPL then + Exit; + {$ENDIF COMPILER12_UP} + end; + end; + {$ENDIF COMPILER11_UP} + Windows.DrawText(DC, PChar(Text), Length(Text), TextRect, TextFlags); +end; + +procedure DrawGlassableImageList(ImageList: HIMAGELIST; Index: Integer; Dest: HDC; X, Y: Integer; + Style: UINT; PaintOnGlass: Boolean = False); +{$IFDEF COMPILER11_UP} +var + PaintBuffer: HPAINTBUFFER; + R: TRect; + MemDC, MaskDC: HDC; + CX, CY, XX, YY: Integer; + MaskBmp: TBitmap; +{$ENDIF COMPILER11_UP} +begin + {$IFDEF COMPILER11_UP} + if PaintOnGlass and JclCheckWinVersion(6, 0) then + begin + { TODO : Not working correctly on a JvSpeedButton. But it works if used direcly on + a sheet of glass. Some optimizations could be done. } + + ImageList_GetIconSize(ImageList, CX, CY); + R := Rect(X, Y, X + CX, Y + CY); + + PaintBuffer := BeginBufferedPaint(Dest, R, BPBF_TOPDOWNDIB, nil, MemDC); + try + ImageList_Draw(ImageList, Index, MemDC, X, Y, Style); + BufferedPaintMakeOpaque(PaintBuffer, @R); + + MaskBmp := TBitmap.Create; + try + MaskBmp.Width := CX; + MaskBmp.Height := CY; + MaskDC := MaskBmp.Canvas.Handle; + ImageList_Draw(ImageList, Index, MaskDC, 0, 0, ILD_MASK); + for YY := 0 to CY - 1 do + for XX := 0 to CX - 1 do + if GetPixel(MaskDC, XX, YY) <> 0 then + begin + R := Rect(X + XX, Y + YY, X + XX + 1, Y + YY + 1); + BufferedPaintSetAlpha(PaintBuffer, @R, 0); + //SetPixel(MemDC, X + XX, Y + YY, GetPixel(MemDC, X + XX, Y + YY) and $00FFFFFF); + end; + finally + MaskBmp.Free; + end; + finally + EndBufferedPaint(PaintBuffer, True); + end; + end + else + {$ENDIF COMPILER11_UP} + ImageList_Draw(ImageList, Index, Dest, X, Y, Style); +end; +*******************) + +(************************ NOT CONVERTED *** +{$IFDEF JVCLThemesEnabled} + +{$IFNDEF COMPILER7_UP} +procedure TThemeServicesEx.ApplyThemeChange; +begin + StyleServices.UpdateThemes; + StyleServices.DoOnThemeChange; +end; +{$ENDIF ~COMPILER7_UP} + +{$IFNDEF COMPILER16_UP} +function TThemeServicesEx.GetElementContentRect(DC: HDC; Details: TThemedElementDetails; + const BoundingRect: TRect; out AContentRect: TRect): Boolean; +begin + AContentRect := ContentRect(DC, Details, BoundingRect); + Result := True; +end; + +function TThemeServicesEx.DoGetElementSize(DC: HDC; Details: TThemedElementDetails; Rect: PRect; + ElementSize: TElementSize; out Size: TSize): Boolean; +const + ElementSizes: array[TElementSize] of TThemeSize = (TS_MIN, TS_TRUE, TS_DRAW); +begin + Result := GetThemePartSize(Theme[Details.Element], DC, Details.Part, Details.State, Rect, + ElementSizes[ElementSize], Size) = S_OK; +end; + +function TThemeServicesEx.GetElementSize(DC: HDC; Details: TThemedElementDetails; ElementSize: TElementSize; + out Size: TSize): Boolean; +begin + Result := DoGetElementSize(DC, Details, nil, ElementSize, Size); +end; + +function TThemeServicesEx.GetElementSize(DC: HDC; Details: TThemedElementDetails; const Rect: TRect; + ElementSize: TElementSize; out Size: TSize): Boolean; +begin + Result := DoGetElementSize(DC, Details, @Rect, ElementSize, Size); +end; + +function TThemeServicesEx.GetSystemColor(Color: TColor): TColor; +begin + Result := Color; +end; + +function TThemeServicesEx.IsSystemStyle: Boolean; +begin + Result := True; +end; + +function TThemeServicesEx.Enabled: Boolean; +begin + Result := ThemesEnabled; +end; + +function TThemeServicesEx.Available: Boolean; +begin + Result := ThemesAvailable; +end; +{$ENDIF ~COMPILER16_UP} +*******************) + +function ThemeServices: TThemeServicesEx; +begin + Result := TThemeServicesEx( + {$IFDEF COMPILER7_UP}Themes{$ELSE}ThemeSrv{$ENDIF}.{$IFDEF RTL230_UP}StyleServices{$ELSE}ThemeServices{$ENDIF RTL230_UP}); +end; + +function StyleServices: TThemeServicesEx; +begin + Result := TThemeServicesEx( + {$IFDEF COMPILER7_UP}Themes{$ELSE}ThemeSrv{$ENDIF}.{$IFDEF RTL230_UP}StyleServices{$ELSE}ThemeServices{$ENDIF RTL230_UP}); +end; + +(************************ NOT CONVERTED *** +procedure PaintControlBorder(Control: TWinControl); +begin + StyleServices.PaintBorder(Control, False) +end; + +procedure DrawThemedBorder(Control: TControl); +var + Details: TThemedElementDetails; + DrawRect: TRect; + DC: HDC; + Handle: THandle; +begin + if Control is TWinControl then + begin + Handle := TWinControl(Control).Handle; + DC := GetWindowDC(Handle); + GetWindowRect(Handle, DrawRect); + OffsetRect(DrawRect, -DrawRect.Left, -DrawRect.Top); + end + else + begin + if Control.Parent = nil then + Exit; + Handle := Control.Parent.Handle; + DC := GetDC(Handle); + DrawRect := Control.BoundsRect; + end; + + ExcludeClipRect(DC, DrawRect.Left + 2, DrawRect.Top + 2, DrawRect.Right - 2, DrawRect.Bottom - 2); + Details := StyleServices.GetElementDetails(teEditTextNormal); + StyleServices.DrawElement(DC, Details, DrawRect); + + ReleaseDC(Handle, DC); +end; +***************************) + +type + TControlAccessProtected = class(TControl); + +procedure IncludeThemeStyle(Control: TControl; Style: TJvThemeStyle); +begin + with TControlAccessProtected(Control) do + ControlStyle := ControlStyle + (Style * [csNeedsBorderPaint, csParentBackground]); +end; + +procedure ExcludeThemeStyle(Control: TControl; Style: TJvThemeStyle); +begin + with TControlAccessProtected(Control) do + ControlStyle := ControlStyle - (Style * [csNeedsBorderPaint, csParentBackground]); +end; + +function GetThemeStyle(Control: TControl): TJvThemeStyle; +begin + with TControlAccessProtected(Control) do + Result := ControlStyle * [csNeedsBorderPaint, csParentBackground]; +end; + +(********************* NOT CONVERTED *** +{$IFDEF JVCLThemesEnabled} + +{$IFNDEF COMPILER10_UP} +type + PPointer = ^Pointer; + +var + OrgWinControlWMPrintClient: procedure(Instance: TObject; var Msg: TMessage); + +procedure FixedWMPrintClient(Instance: TObject; var Msg: TMessage); +var + IdSave: Integer; +begin + if Msg.Msg = WM_PRINTCLIENT then + begin + IdSave := SaveDC(HDC(Msg.WParam)); + try + OrgWinControlWMPrintClient(Instance, Msg); + finally + RestoreDC(HDC(Msg.WParam), IdSave); + end; + end + else + OrgWinControlWMPrintClient(Instance, Msg); +end; + +function FindWMPrintClient: PPointer; +var + IdxList: PDynamicIndexList; + I: Integer; +begin + IdxList := GetDynamicIndexList(TWinControl); + for I := 0 to GetDynamicMethodCount(TWinControl) - 1 do + if IdxList[I] = WM_PRINTCLIENT then + begin + Result := @(GetDynamicAddressList(TWinControl)[I]); + Exit; + end; + Result := nil; +end; + +procedure InitializeWMPrintClientFix; +var + NewProc: Pointer; + Proc: PPointer; + OldProtect, Dummy: Cardinal; +begin + Proc := FindWMPrintClient(); + if Proc <> nil then + begin + OrgWinControlWMPrintClient := Proc^; + NewProc := @FixedWMPrintClient; + + if VirtualProtect(Proc, SizeOf(NewProc), PAGE_EXECUTE_READWRITE, OldProtect) then + try + Proc^ := NewProc; + finally + VirtualProtect(Proc, SizeOf(NewProc), OldProtect, Dummy); + end; + end; +end; + +procedure FinalizeWMPrintClientFix; +var + NewProc: Pointer; + Proc: PPointer; + OldProtect, Dummy: Cardinal; +begin + Proc := FindWMPrintClient; + if Proc <> nil then + begin + NewProc := @OrgWinControlWMPrintClient; + + if VirtualProtect(Proc, SizeOf(NewProc), PAGE_EXECUTE_READWRITE, OldProtect) then + try + Proc^ := NewProc; + finally + VirtualProtect(Proc, SizeOf(NewProc), OldProtect, Dummy); + end; + end; +end; +{$ENDIF ~COMPILER10_UP} + +{$ENDIF JVCLThemesEnabled} +************) + +initialization + (************** NOT CONVERTED *** + {$IFDEF JVCLThemesEnabled} + {$IFNDEF COMPILER10_UP} + InitializeWMPrintClientFix; + {$ENDIF ~COMPILER10_UP} + {$ENDIF JVCLThemesEnabled} + **********) + +finalization + (*************** NOT CONVERTED *** + {$IFDEF JVCLThemesEnabled} + {$IFNDEF COMPILER10_UP} + FinalizeWMPrintClientFix; + {$ENDIF ~COMPILER10_UP} + {$ENDIF JVCLThemesEnabled} + *************) + +end. diff --git a/components/jvcllaz/run/JvCustomControls/JvBaseThumbnail.pas b/components/jvcllaz/run/JvCustomControls/JvBaseThumbnail.pas new file mode 100644 index 000000000..9c2ea55aa --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvBaseThumbnail.pas @@ -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. diff --git a/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas b/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas index 8650353cc..e5506a2ba 100644 --- a/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas +++ b/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas @@ -22,6 +22,8 @@ Known Issues: -----------------------------------------------------------------------------} // $Id$ +{$MODE objfpc}{$H+} + unit JvTabBarXPPainter; diff --git a/components/jvcllaz/run/JvCustomControls/JvThumbImage.pas b/components/jvcllaz/run/JvCustomControls/JvThumbImage.pas new file mode 100644 index 000000000..75a0aeb20 --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvThumbImage.pas @@ -0,0 +1,1146 @@ +{----------------------------------------------------------------------------- +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: JvThumbImage.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 + +Known Issues: + +Changes form the previous Version: + +Converted the rotation Functions to use scanlines for faster results + I have converted the movement from an array of TRGBTriple to an + an array of bytes. Right now it must rotate the following formats + without big speed differences and problems pf8bit,pf24bit,pf32bit + the pf4bit,pf1bit is converted to pf8bit. + The Pfdevice,pfcustom is converted into pf24bit. + all the Color conversions do not revert to the primary state after the + rotation + +Added the Mirror routines +Removed the 180 degree rotation and replaced by the mirror(mtBoth) call. + this let the GDI engine to make the rotation and it is faster than any + rotation I have tested until now I have tested this routine with + and image of 2300x3500x24bit without any problems on Win2K. + I must test it on Win98 before release. +-----------------------------------------------------------------------------} +// $Id$ + +{$MODE objfpc}{$H+} + +unit JvThumbImage; + +interface + +uses + LCLIntf, LCLType, + Classes, Controls, ExtCtrls, SysUtils, Graphics, Forms, Dialogs, + JvBaseThumbnail; + +type + TAngle = (AT0, AT90, AT180, AT270); + + // (rom) renamed elements + TMirror = (mtHorizontal, mtVertical, mtBoth); + + TCurveArray = array [0..255] of Byte; + TRotateNotify = procedure(Sender: TObject; Percent: Byte; var Cancel: Boolean) of object; + TFilterEmpty = function: Byte; + TFilterArray = array [1..9] of Byte; + + TJvThumbImage = class(TJvBaseThumbImage) + private + FAngle: TAngle; + FModified: Boolean; + FOnRotate: TRotateNotify; + FZoom: Word; + FOnLoad: TNotifyEvent; + FFileName: string; + FClass: TGraphicClass; + FOnInvalidImage: TInvalidImageEvent; + procedure Rotate90; + //procedure Rotate180; + procedure Rotate270; + procedure SetAngle(AAngle: TAngle); + function GetModify: Boolean; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Mirror(MirrorType: TMirror); + procedure ChangeRGB(R, G, B: Longint); + procedure ChangeRGBCurves(R, G, B: TCurveArray); + procedure ScaleDown(MaxW, MaxH: Longint); + procedure LoadFromFile(AFile: string); //virtual; + procedure LoadFromStream(AStream: TStream; AType: TGRFKind); // needs more tests + procedure SaveToStream(AStream: TStream; AType: TGRFKind); // testing it + procedure SaveToFile(AFile: string); + procedure Save; + procedure BitmapNeeded; + // Procedure FilterFactory(Filter: TFilterArray; Divider: Byte); + procedure Invert; + procedure Contrast(const Percent: TPercent); + procedure Lightness(const Percent: TPercent); + procedure Grayscale; + procedure Rotate(AAngle: TAngle); + function GetFilter: string; + //property JpegScale: TJPegScale read vJPegScale write vJpegScale; + published + property Angle: TAngle read FAngle write SetAngle; + property Modified: Boolean read FModified; + //Property OnRelease : TdestroyNotify read EVonrelease write Evonrelease; + property CanModify: Boolean read GetModify; + property Zoom: Word read FZoom write FZoom; + // (rom) should be called in the implementation more often + property OnRotate: TRotateNotify read FOnRotate write FOnRotate; + property OnLoaded: TNotifyEvent read FOnLoad write FOnLoad; + property OnInvalidImage: TInvalidImageEvent read FOnInvalidImage write FOnInvalidImage; + end; + + +implementation + +uses + FPImage, IntfGraphics, + JvThumbnails, JvTypes, JvResources; + +constructor TJvThumbImage.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FAngle := AT0; +// FClass := Graphics.TBitmap; + FModified := False; +end; + +destructor TJvThumbImage.Destroy; +begin + inherited Destroy; +end; + +procedure TJvThumbImage.Lightness(const Percent: TPercent); +var + Amount: Integer; + RCurve: TCurveArray; + I: Integer; +begin + Amount := Round((255 / 100) * Percent); + if Amount > 0 then + for I := 0 to 255 do + RCurve[I] := BoundByte(0, 255, I + ((Amount * (I xor 255)) shr 8)) + else + for I := 0 to 255 do + RCurve[I] := BoundByte(0, 255, I - ((Abs(Amount) * I) shr 8)); + ChangeRGBCurves(RCurve, RCurve, RCurve); +end; + +procedure TJvThumbImage.Rotate(AAngle: TAngle); +begin + case AAngle of + AT90: + Rotate90; + AT180: + Mirror(mtBoth); + AT270: + Rotate270; + end; +end; + +function TJvThumbImage.GetFilter: string; +var + // a: string; + P: Longint; +begin + Result := Graphics.GraphicFilter(TGraphic); + // (rom) better clean that up + P := Pos('(', Result); + InsertStr(Result, RsPcxTga, P); + P := Pos('|', Result); + InsertStr(Result, RsPcxTga, P); + Result := Result + RsFileFilters; + //Graphics.GraphicFilter(TGraphic)+'|PCX File|*.PCX|Targa File|*.TGA'; + { TODO : Add in the filter the rest of the images we support but are not registered to the Graphics unit } +end; + +procedure TJvThumbImage.Contrast(const Percent: TPercent); +var + Amount: Integer; + Counter: Integer; + Colors: TCurveArray; +begin + Amount := Round((256 / 100) * Percent); + for Counter := 0 to 127 do + Colors[Counter] := BoundByte(0, 255, Counter - ((Abs(128 - Counter) * Amount) div 256)); + for Counter := 127 to 255 do + Colors[Counter] := BoundByte(0, 255, Counter + ((Abs(128 - Counter) * Amount) div 256)); + ChangeRGBCurves(Colors, Colors, Colors); +end; + +procedure TJvThumbImage.LoadFromStream(AStream: TStream; AType: TGRFKind); +var + Bmp: Graphics.TBitmap; + Jpg: TJpegImage; + Ico: TIcon; + (*********** NOT CONVERTED *** + Wmf: TMetafile; + ****************************) +begin + //testing the stream load capabilities; + // (rom) deactivated because LoadFromStream is not defined that way + //AStream.Seek(0, soFromBeginning); //most of the stream error are generated because this is not at the proper position + case AType of + grBMP: + begin + Bmp := Graphics.TBitmap.Create; + try + Bmp.LoadFromStream(AStream); + Bmp.PixelFormat := pf24bit; + Picture.Assign(Bmp); + finally + FreeAndNil(Bmp); + end; + end; + grJPG: + begin + Jpg := TJpegImage.Create; + try + Jpg.LoadFromStream(AStream); + Picture.Assign(Jpg); + finally + FreeAndNil(Jpg); + end; + end; + (**************** NOT CONVERTED *** + grWMF, grEMF: + begin + Wmf := Graphics.TMetafile.Create; + try + Wmf.LoadFromStream(AStream); + Picture.Assign(Wmf); + finally + FreeAndNil(Wmf); + end; + end; + ******************************) + grICO: + begin + Ico := Graphics.TIcon.Create; + try + Ico.LoadFromStream(AStream); + Picture.Assign(Ico); + finally + FreeAndNil(Ico); + end; + end; + end; +end; + +procedure TJvThumbImage.SaveToStream(AStream: TStream; AType: TGRFKind); +var + Bmp: Graphics.TBitmap; + Jpg: TJpegImage; + Ico: TIcon; + (******************** NOT CONVERTED *** + Wmf: TMetafile; + **************************************) +begin + //testing the stream Save capabilities; + // (rom) deactivated because SaveToStream is not defined that way + //AStream.Seek(0, soFromBeginning); //most of the stream error are generated because this is not at the proper position + case AType of + grBMP: + begin + Bmp := Graphics.TBitmap.Create; + // (rom) secured + try + Bmp.Assign(Picture.Graphic); + Bmp.PixelFormat := pf24bit; + Bmp.SaveToStream(AStream); + finally + FreeAndNil(Bmp); + end; + end; + grJPG: + begin + Jpg := TJpegImage.Create; + try + Jpg.Assign(Picture.Graphic); + Jpg.SaveToStream(AStream); + finally + FreeAndNil(Jpg); + end; + end; + (******************************* NOT CONVERTED *** + grWMF, grEMF: + begin + Wmf := Graphics.TMetafile.Create; + try + Wmf.Assign(Picture.Graphic); + Wmf.SaveToStream(AStream); + finally + FreeAndNil(Wmf); + end; + end; + **********************************************) + grICO: + begin + Ico := Graphics.TIcon.Create; + try + Ico.Assign(Picture.Graphic); + Ico.SaveToStream(AStream); + finally + FreeAndNil(Ico); + end; + end; + end; +end; + +procedure TJvThumbImage.LoadFromFile(AFile: string); +var + JpegImage: TJpegImage; + Fl: TFileStream; +begin + try + if UpperCase(ExtractFileExt(AFile)) = '.JPG' then + begin + JpegImage := TJpegImage.Create; + + {************************ NOT CONVERTED ************* + if Parent is TJvThumbnail then + begin + Fl := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite); + // (rom) this is idiotic + try + case Fl.Size of + 0..1000000: + JpegImage.Scale := jsFullSize; + 1000001..4000000: + JpegImage.Scale := jsHalf; + 4000001..7000000: + JpegImage.Scale := jsQuarter; + else + JpegImage.Scale := jsEighth; + end; + finally + Fl.Free; + end; + end + else + JpegImage.Scale := jsFullSize; + *********************************************************} + JpegImage.LoadFromFile(AFile); + // Picture.Bitmap := Graphics.TBitmap.Create; + with Picture.Bitmap do + begin + Width := JpegImage.Width; + Height := JpegImage.Height; + Picture.Bitmap.Canvas.Draw(0, 0, JpegImage); + Self.FClass := TJpegImage; + end; + FreeAndNil(JpegImage); + end + else + begin + try + Picture.LoadFromFile(AFile); + except + if Assigned(FOnInvalidImage) then + begin + FOnInvalidImage(Self, AFile); + Exit; + end + else + raise; + end; + Self.FClass := TGraphicClass(Picture.Graphic.ClassType); + end; + FFileName := AFile; + FAngle := AT0; + if Assigned(FOnLoad) then + FOnLoad(Self); + except + on E: Exception do + begin + FFileName := ''; + Self.FClass := nil; + raise; + end; + end; +end; + +procedure TJvThumbImage.SaveToFile(AFile: string); +var + Ext: string; + Jpg: TJpegImage; + Bmp: TBitmap; + {*************** NOT CONVERTED *** + Wmf: TMetafile; + ********************************} +begin + // (rom) enforcing a file extension is bad style + Ext := UpperCase(ExtractFileExt(AFile)); + if (Ext = '.JPG') or (Ext = '.JPEG') then + try + Jpg := TJpegImage.Create; + Jpg.Assign(Picture.Graphic); + Jpg.CompressionQuality := 75; + { *************** NOT CONVERTED *** + Jpg.Compress; + **********************************} + Jpg.SaveToFile(AFile); + finally + FreeAndNil(Jpg); + end + else + if Ext = '.BMP' then + try + Bmp := Graphics.TBitmap.Create; + Bmp.Assign(Picture.Graphic); + Bmp.Canvas.Draw(0, 0, Picture.Graphic); + Bmp.SaveToFile(AFile); + finally + FreeAndNil(Bmp); + end + { ********************** NOT CONVERTED *** + else + if Ext = '.WMF' then + try + Wmf := TMetafile.Create; + Wmf.Assign(Picture.Graphic); + Wmf.Enhanced := False; + Wmf.SaveToFile(AFile); + finally + FreeAndNil(Wmf); + end + else + if Ext = '.EMF' then + try + Wmf := Graphics.TMetafile.Create; + Wmf.Assign(Picture.Graphic); + Wmf.Enhanced := True; + Wmf.SaveToFile(AFile); + finally + FreeAndNil(Wmf); + end + ***************************************} + else + raise EJVCLException.CreateResFmt(@RsEUnknownFileExtension, [Ext]); +end; + +procedure TJvThumbImage.Save; +var + Temp: TGraphic; +begin + if FClass <> nil then + begin + Temp := FClass.Create; + Temp.Assign(Self.Picture.Graphic); + Temp.SaveToFile(FFileName); + FreeAndNil(Temp); + end + else + SaveToFile(FFileName); +end; + +procedure TJvThumbImage.BitmapNeeded; +var + Bmp: Graphics.TBitmap; +begin + Bmp := Graphics.TBitmap.Create; + try + Bmp.HandleType := bmDIB; + // Bmp.PixelFormat := pf24Bit; + // Bmp.Width := Picture.Graphic.Width; + // Bmp.Height := Picture.Graphic.Height; + // Bmp.Canvas.Draw(0,0,Picture.Graphic); + Bmp.Assign(Picture.Graphic); + Picture.Graphic.Assign(Bmp); + finally + Bmp.Free; + end; +end; + +procedure TJvThumbImage.ScaleDown(MaxW, MaxH: Longint); +var + NewSize: TPoint; + Bmp: Graphics.TBitmap; +begin + NewSize := ProportionalSize(Point(Picture.Width, Picture.Height), Point(MaxW, MaxH)); + if (NewSize.X > Picture.Width) and (NewSize.Y > Picture.Height) then + Exit; + // SomeTimes when the resize is bigger than 1600% then the strechDraw + // doesn't produce any results at all so do it more than once to make + // absolutly sure the will have an image in any case. + if ((Picture.Width div NewSize.X) > 16) or ((Picture.Height div NewSize.Y) > 16) then + ScaleDown(2 * MaxW, 2 * MaxH); + Bmp := Graphics.TBitmap.Create; + try + Bmp.Width := NewSize.X; + Bmp.Height := NewSize.Y; + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf24bit; + Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Picture.Graphic); + Picture.Assign(Bmp); + { wp + Picture.Bitmap.Dormant; + Picture.Bitmap.FreeImage; + } + finally + FreeAndNil(Bmp); + end; + FModified := True; +end; + +function TJvThumbImage.GetModify: Boolean; +begin + Result := False; + if not Assigned(Picture) or not Assigned(Picture.Graphic) then + Exit; + if Picture.Graphic.Empty then + Result := False + { ********************* NOT CONVERTED ************* + else + if Picture.Graphic is Graphics.TMetafile then + Result := False + *************************************************} + else + Result := not (Picture.Graphic is Graphics.TIcon); +end; + +procedure TJvThumbImage.GrayScale; +{At this point I would like to thanks The author of the EFG's computer lab + (I don't Recall His name Right now) for the fantastic job he has + done gathering all this info} +var + MemBmp: TBitmap; + Row, Col: Word; + Intens: Byte; + IntfImg: TLazIntfImage; + clr: TColor; + ImgHandle, ImgMaskHandle: HBitmap; +begin + if CanModify then + begin + IntfImg := TLazIntfImage.Create(0, 0); + MemBmp := TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.SetSize(Picture.Width, Picture.Height); + MemBmp.Canvas.Brush.Color := clWhite; + MemBmp.Canvas.FillRect(0, 0, MemBmp.Width, MemBmp.Height);; + MemBmp.Assign(Picture); + IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + for Row := 0 to IntfImg.Height-1 do + for Col := 0 to IntfImg.Width - 1 do begin + clr := IntfImg.TColors[Col, Row]; + intens := (GetRValue(clr) + GetGValue(clr) + GetBValue(clr)) div 3; + clr := RGBToColor(intens, intens, intens); + IntfImg.TColors[Col, Row] := clr; + end; + IntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle); + MemBmp.Handle := ImgHandle; + MemBmp.MaskHandle := ImgMaskHandle; + if Picture.Graphic is TJpegImage then + TJpegImage(Picture.Graphic).Assign(MemBmp) + else if Picture.Graphic is Graphics.TBitmap then + Picture.Bitmap.Assign(MemBmp); + Invalidate; + finally + MemBmp.Free; + IntfImg.Free; + end; + end; +end; + +procedure TJvThumbImage.Invert; +var + R: TCurveArray; + I: Byte; +begin + for I := 0 to 255 do + R[I] := 255 - I; + ChangeRGBCurves(R, R, R); +end; + +procedure TJvThumbImage.ChangeRGBCurves(R, G, B: TCurveArray); +var + MemBmp: TBitmap; + Row, Col: Word; + IntfImg: TLazIntfImage; + clr: TColor; + cr, cg, cb: Byte; + ImgHandle, ImgMaskHandle: HBitmap; +begin + { + This procedure substitutes the values of R,G,B acordinally to the arrays the + user passes in it. This is the simplest way to change the curve of a Color + depending on an algorithm created by the user. + The substitute value of a red 0 is the value which lies in the R[0] position. + for a simple example have a look at the invert procedure above + } + if CanModify then + begin + IntfImg := TLazIntfImage.Create(0, 0); + MemBmp := TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.SetSize(Picture.Width, Picture.Height); + MemBmp.Canvas.Brush.Color := clWhite; + MemBmp.Canvas.FillRect(0, 0, MemBmp.Width, MemBmp.Height);; + MemBmp.Assign(Picture); + IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + for Row := 0 to IntfImg.Height-1 do + for Col := 0 to IntfImg.Width - 1 do begin + clr := IntfImg.TColors[Col, Row]; + cr := R[GetRValue(clr)]; + cg := G[GetGValue(clr)]; + cb := B[GetBValue(clr)]; + IntfImg.TColors[Col, Row] := RGBToColor(cr, cg, cb); + end; + IntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle); + MemBmp.Handle := ImgHandle; + MemBmp.MaskHandle := ImgMaskHandle; + if Picture.Graphic is TJpegImage then + TJpegImage(Picture.Graphic).Assign(MemBmp) + else if Picture.Graphic is Graphics.TBitmap then + Picture.Bitmap.Assign(MemBmp); + Invalidate; + finally + MemBmp.Free; + IntfImg.Free; + end; + end; +end; + +procedure TJvThumbImage.Mirror(MirrorType: TMirror); +var + MemBmp: Graphics.TBitmap; + Dest: TRect; +begin + if Assigned(Picture.Graphic) then + if CanModify then + begin + MemBmp := Graphics.TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.HandleType := bmDIB; + MemBmp.Width := Self.Picture.Graphic.Width; + MemBmp.Height := Self.Picture.Height; + MemBmp.Canvas.Draw(0, 0, Picture.Graphic); + case MirrorType of + mtHorizontal: + begin + Dest.Left := MemBmp.Width; + Dest.Top := 0; + Dest.Right := -MemBmp.Width; + Dest.Bottom := MemBmp.Height; + end; + mtVertical: + begin + Dest.Left := 0; + Dest.Top := MemBmp.Height; + Dest.Right := MemBmp.Width; + Dest.Bottom := -MemBmp.Height; + end; + mtBoth: + begin + Dest.Left := MemBmp.Width; + Dest.Top := MemBmp.Height; + Dest.Right := -MemBmp.Width; + Dest.Bottom := -MemBmp.Height; + end; + end; + StretchBlt(MemBmp.Canvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, + MemBmp.Canvas.Handle, 0, 0, MemBmp.Width, MemBmp.Height, SRCCOPY); + Picture.Graphic.Assign(MemBmp); + Invalidate; + finally + FreeAndNil(MemBmp); + end; + end; +end; + +{ Just a simple procedure to increase or decrease the values of the each channel + in the image idependendly from each other. E.G. + lets say the R,G,B vars have the values of 5,-3,7 this means that the red + channel should be increased buy 5 points in all the image the green value will + be decreased by 3 points and the blue value will be increased by 7 points. + This will happen to all the image by the same value no Color limunocity is + been preserved or values calculations depenting on the current channel values. } +procedure TJvThumbImage.ChangeRGB(R, G, B: Longint); +var + Row, Col: Integer; + MemBmp: TBitmap; + IntfImg: TLazIntfImage; + ImgHandle, ImgMaskHandle: HBitmap; + cr, cg, cb: byte; + clr: TColor; +begin + if not CanModify then + Exit; + + IntfImg := TLazIntfImage.Create(0, 0); + MemBmp := TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.SetSize(Picture.Width, Picture.Height); + MemBmp.Canvas.Brush.Color := clWhite; + MemBmp.Canvas.FillRect(0, 0, MemBmp.Width, MemBmp.Height);; + MemBmp.Assign(Picture); + IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + for Row := 0 to IntfImg.Height-1 do + for Col := 0 to IntfImg.Width - 1 do begin + clr := IntfImg.TColors[Col, Row]; + cr := BoundByte(0, 255, GetBValue(clr) + R); + cg := BoundByte(0, 255, GetGValue(clr) + G); + cb := BoundByte(0, 255, GetBValue(clr) + B); + IntfImg.TColors[Col, Row] := RGBToColor(cr, cg, cb); + end; + IntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle); + MemBmp.Handle := ImgHandle; + MemBmp.MaskHandle := ImgMaskHandle; + if Picture.Graphic is TJpegImage then + TJpegImage(Picture.Graphic).Assign(MemBmp) + else if Picture.Graphic is Graphics.TBitmap then + Picture.Bitmap.Assign(MemBmp); + Invalidate; + finally + MemBmp.Free; + IntfImg.Free; + end; +end; + +{ Procedure to actually decide what should be the rotation in conjuction with the + image's physical Angle} +procedure TJvThumbImage.SetAngle(AAngle: TAngle); + + procedure RotateByDelta(ADiff: integer); + begin + if ADiff < 0 then inc(ADiff, 4); + case TAngle(ADiff mod 4) of + AT90: + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + AT180: + Mirror(mtBoth); + AT270: + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + end; + +begin + if not Assigned(Picture.Graphic) then + exit; + if not CanModify then + exit; + if AAngle = FAngle then + exit; + + RotateByDelta(ord(AAngle) - ord(FAngle)); + (* + case FAngle of + AT0: + case AAngle of + AT90: + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + AT180: + Mirror(mtBoth); + AT270: + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + AT90: + case AAngle of + AT180: + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + AT270: + Mirror(mtBoth); + AT0: + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + AT180: + case AAngle of + AT270: + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + AT0: + Mirror(mtBoth); + AT90: + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + AT270: + case AAngle of + AT0: + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + AT90: + Mirror(mtBoth); + AT180: + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + end; + *) + FAngle := AAngle; + FModified := FAngle <> AT0; +end; + +(* + if Assigned(Picture.Graphic) then + if CanModify then + if AAngle <> FAngle then + begin + if FAngle = AT0 then + begin + if AAngle = AT90 then + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + if AAngle = AT180 then + begin + //rotate180; + Mirror(mtBoth); + end; + if AAngle = AT270 then + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + if FAngle = AT90 then + begin + if AAngle = AT180 then + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + if AAngle = AT270 then + begin + //rotate180; + Mirror(mtBoth); + end; + if AAngle = AT0 then + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + if FAngle = AT180 then + begin + if AAngle = AT90 then + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + if AAngle = AT0 then + begin + //rotate180; + Mirror(mtBoth); + end; + if AAngle = AT270 then + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + if FAngle = AT270 then + begin + if AAngle = AT90 then + begin + //rotate180; + Mirror(mtBoth); + end; + if AAngle = AT0 then + begin + Rotate90; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + if AAngle = AT180 then + begin + Rotate270; + if Parent is TJvThumbnail then + SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0); + end; + end; + FAngle := AAngle; + FModified := FAngle <> AT0; + end; +end; + *) + +procedure TJvThumbImage.Rotate270; +var + Row, Col: Integer; + MemBmp: TBitmap; + IntfImg: TLazIntfImage; + RotIntfImg: TLazIntfImage; + ImgHandle, ImgMaskHandle: HBitmap; + clr: TColor; + w, h: Integer; +begin + if Assigned(Picture.Graphic) then + if CanModify then + begin + w := Picture.Width; + h := Picture.Height; + IntfImg := TLazIntfImage.Create(0, 0); + RotIntfImg := TLazIntfImage.Create(0, 0); + MemBmp := TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.SetSize(w, h); + MemBmp.Canvas.Brush.Color := clWhite; + MemBmp.Canvas.FillRect(0, 0, w, h); + MemBmp.Assign(Picture); + IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + RotIntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + RotIntfImg.SetSize(h, w); + + for Row := 0 to h - 1 do + for Col := 0 to w - 1 do begin + clr := IntfImg.TColors[Col, Row]; + RotIntfImg.TColors[h - 1 - Row , w - 1 - Col] := clr; + end; + RotIntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle); + MemBmp.Handle := ImgHandle; + MemBmp.MaskHandle := ImgMaskHandle; + if Picture.Graphic is TJpegImage then + TJpegImage(Picture.Graphic).Assign(MemBmp) + else if Picture.Graphic is Graphics.TBitmap then + Picture.Bitmap.Assign(MemBmp); + Invalidate; + finally + MemBmp.Free; + IntfImg.Free; + end; + end; +end; + +(* +procedure TJvThumbImage.Rotate180; +var + MemBmp: Graphics.TBitmap; + RotateBmp: Graphics.TBitmap; + I, J: Longint; + Brake: Boolean; + R: TRect; +begin + //Procedure to rotate the image at 180d cw or ccw is the same + + { TODO : Removed the 180 degree rotation and replaced by the mirror(mtBoth) call. + this let the GDI engine to make the rotation and it is faster than any + rotation I have tested until now I have tested this routine with + and image of 2300x3500x24bit with out any problems on Win2K. + I must test it on Win98 before release. } + if Assigned(Picture.Graphic) then + if CanModify then + begin + if not Assigned(FOnRotate) then + Screen.Cursor := crHourGlass; + MemBmp := Graphics.TBitmap.Create; + MemBmp.Width := Picture.Width; + MemBmp.Height := Picture.Height; + MemBmp.canvas.Draw(0, 0, Picture.Graphic); + MemBmp.Palette := Picture.Graphic.Palette; + RotateBmp := Graphics.TBitmap.Create; + RotateBmp.Assign(MemBmp); + R := MemBmp.Canvas.ClipRect; + for I := Left to R.Right do + for J := Top to R.Bottom do + begin + RotateBmp.Canvas.Pixels[R.Right - I - 1, R.Bottom - J - 1] := + MemBmp.Canvas.Pixels[I, J]; + if Assigned(FOnRotate) then + begin + Brake := False; + FOnRotate(Self, Trunc(((I * J) / (R.Right * R.Bottom)) * 100), Brake); + if Brake then + begin + RotateBmp.Free; + MemBmp.Free; + Exit; + end; + end; + end; + Picture.Bitmap.Assign(RotateBmp); + Invalidate; + RotateBmp.Free; + MemBmp.Free; + if not Assigned(FOnRotate) then + Screen.Cursor := crArrow; + end; +end; +*) + +procedure TJvThumbImage.Rotate90; +var + Row, Col: Integer; + MemBmp: TBitmap; + IntfImg: TLazIntfImage; + RotIntfImg: TLazIntfImage; + ImgHandle, ImgMaskHandle: HBitmap; + clr: TColor; + w, h: Integer; +begin + if Assigned(Picture.Graphic) then + if CanModify then + begin + w := Picture.Width; + h := Picture.Height; + IntfImg := TLazIntfImage.Create(0, 0); + RotIntfImg := TLazIntfImage.Create(0, 0); + MemBmp := TBitmap.Create; + try + MemBmp.PixelFormat := pf32bit; + MemBmp.SetSize(w, h); + MemBmp.Canvas.Brush.Color := clWhite; + MemBmp.Canvas.FillRect(0, 0, w, h); + MemBmp.Assign(Picture); + IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + RotIntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle); + RotIntfImg.SetSize(h, w); + + for Row := 0 to h - 1 do + for Col := 0 to w - 1 do begin + clr := IntfImg.TColors[Col, Row]; + RotIntfImg.TColors[Row, Col] := clr; + end; + RotIntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle); + MemBmp.Handle := ImgHandle; + MemBmp.MaskHandle := ImgMaskHandle; + if Picture.Graphic is TJpegImage then + TJpegImage(Picture.Graphic).Assign(MemBmp) + else if Picture.Graphic is Graphics.TBitmap then + Picture.Bitmap.Assign(MemBmp); + Invalidate; + finally + MemBmp.Free; + IntfImg.Free; + end; + end; +end; + +(* +procedure TJvThumbImage.Rotate90; +var + MemBmp: Graphics.TBitmap; + { + PByte1: PJvRGBArray; + PByte2: PJvRGBArray; + } + // Stp: Byte; + RotateBmp: Graphics.TBitmap; + I, J {, C}: Longint; +begin + { ************************** FIX ME: Convert using LazIntfImage *** + //Procedure to rotate an image at 90D clockwise or 270D ccw + if Assigned(Picture.Graphic) then + if CanModify then + begin + RotateBmp := nil; + MemBmp := Graphics.TBitmap.Create; + RotateBmp := Graphics.TBitmap.Create; + try + MemBmp.Assign(Picture.Graphic); + MemBmp.HandleType := bmDIB; + //MemBmp.PixelFormat := pf24bit; + { Case MemBmp.PixelFormat of + pf4bit,pf1bit : begin MemBmp.PixelFormat := pf8bit; Stp := 1; end; + pf8bit : Stp := 1; + pf16bit,PF15Bit : Stp := 2; + pf24bit : Stp := 3; + pf32bit : Stp := 4; + pfDevice, + pfCustom : begin + MemBmp.PixelFormat := pf24bit; + Stp:=3; + end; + else Exit; + end;} + MemBmp.PixelFormat := pf24bit; + // Stp := 3; + RotateBmp.FreeImage; + RotateBmp.PixelFormat := MemBmp.PixelFormat; + RotateBmp.HandleType := MemBmp.HandleType; + RotateBmp.Width := MemBmp.Height; + RotateBmp.Height := MemBmp.Width; + I := RotateBmp.Height - 1; + while I >= 0 do + begin + PByte1 := RotateBmp.ScanLine[I]; + J := 0; + while J < MemBmp.Height do + begin + PByte2 := MemBmp.ScanLine[MemBmp.Height - 1 - J]; + PByte1[J] := PByte2[I]; + Inc(J); + end; + Dec(I); + end; + Picture.Bitmap.Assign(RotateBmp); + finally + FreeAndNil(RotateBmp); + FreeAndNil(MemBmp); + end; + end; + **********************************************************} +end; +*) + +end. diff --git a/components/jvcllaz/run/JvCustomControls/JvThumbViews.pas b/components/jvcllaz/run/JvCustomControls/JvThumbViews.pas new file mode 100644 index 000000000..ec2f828d0 --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvThumbViews.pas @@ -0,0 +1,1219 @@ +{----------------------------------------------------------------------------- +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: JvThumbView.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 + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvThumbViews; + +{$MODE objfpc}{$H+} +//{$I windowsonly.inc} + +interface + +uses + LCLType, LMessages, + Classes, Controls, Forms, ExtCtrls, + SysUtils, Graphics, + JvThumbnails, JvBaseThumbnail, JvExControls; + +type + // (rom) already in JvBaseThumbnail + //TPercent = 0..100; + TScrollMode = (smHorizontal, smVertical, smBoth); + TViewType = (vtNormal, vtCenter, vtFitToScreen); + // (rom) obviously unused + //TBufferAction = (bfCancel, bfCreate, bfOpen, bfInsert, bfReplace, bfDelete); + TTitleNotify = procedure(Sender: TObject; FileName: string; + var ThumbnailTitle: string; var ThumbnailFont: TFont; + var ThumbnailColor: TColor) of object; + TProgressStartNotify = procedure(Sender: TObject; Max: Integer) of object; + + TJvThumbList = class(TStringList) // declare A new type of Thumblist and try not to Break the old code; + protected + function GetThumbnail(Index: Longint): TJvThumbnail; + public + property Thumbnail[Index: Longint]: TJvThumbnail read GetThumbnail; default; + end; + + TJvThumbView = class(TJvBaseThumbView) + private + FMaxSize: TPoint; + FThumbSize: TPoint; +// Dummy: string; + FPercent: TPercent; + FDirectory: string; + FScrollMode: TScrollMode; + FAutoScrolling: Boolean; + FSelected: Longint; + FAlignView: TViewType; + FThumbGap: Byte; + FMaxX: Word; + FMinMemory: Boolean; + FOnGetTitle: TTitleNotify; + FOnChanging: TNotifyEvent; + FOnChange: TNotifyEvent; + FOnStartScanning: TProgressStartNotify; + FOnStopScanning: TNotifyEvent; + FOnScanProgress: TProgressNotify; + FWaitUntilFull: Boolean; + FPainted: Boolean; + FFileList: TStringList; + FFileListSorted: TStringList; + FSorted: Boolean; + FFilling: Boolean; + FFilter: string; +// FBufferFile: string; + FThumbColor: TColor; + FAsButtons: Boolean; + FTitlePlacement: TTitlePos; + FOnKeyDown: TKeyEvent; + FOnKeyUp: TKeyEvent; + FOnKeyPress: TKeyPressEvent; + FAutoHandleKeyb: Boolean; + FGraphicExtensions: TStringList; + FShowShadow: Boolean; + FShadowColor: TColor; + FThumbList: TJvThumbList; + FOnInvalidImage: TInvalidImageEvent; + FDiskSize: DWORD; + procedure WMPaint(var Msg: TLMPaint); message LM_PAINT; + procedure GetFiles(ADirectory: string); + procedure SetSorted(const Value: Boolean); + procedure CalculateMaxX; + procedure CalculateSize; + function CalculateXPos(Num: Word): Longint; + function CalculateYPos(Num: Word): Longint; + procedure ScrollTo(const Number: Longint); + procedure SetAlignView(AType: TViewType); + procedure Reposition(Start: Integer); + procedure GoLeft; + procedure GoRight; + procedure GoDown; + procedure GoUp; + procedure SetAsButton(const NewVal: Boolean); + procedure SetTitlePos(const NewVal: TTitlePos); + function CreateFilter: string; + procedure SetFilters; + //function GetBufferName(AName: string): string; + function GetMaxHeight: Longint; + function GetMaxWidth: Longint; + procedure DoInvalidImage(Sender: TObject; const FileName: string); + // procedure WMLoadWhenReady(var Msg: TMessage); message WM_LOADWHENREADY; + protected + procedure CreateHandle; override; + (*********** NOT CONVERTED ** + procedure GetDlgCode(var Code: TDlgCodes); override; + *****) + procedure SetScrollMode(AMode: TScrollMode); + procedure SetSelected(Number: Longint); + // procedure SetBufferFile(NewName: string); + procedure Resize; override; + procedure SetMaxWidth(W: Longint); + procedure SetDirectory(Value: string); + procedure SetMaxHeight(H: Longint); + procedure KeyPress(var Key: Char); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyUp(var Key: Word; Shift: TShiftState); override; + procedure SetThumbGap(Sp: Byte); + procedure SetPercent(P: TPercent); + procedure SetSelectedFile(AFile: string); + function GetSelectedFile: string; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + // function GetBufferFile: string; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddThumb(ATitle: string; Redraw: Boolean); + function AddFromFile(AFile: string) : Integer; + procedure AddFromStream(AStream: TStream; AType: TGRFKind); overload; + function AddFromStream(AStream: TStream; AType: TGRFKind; const aTitle: string): Integer; overload; + + procedure Delete(No: Longint); + procedure EmptyList; + procedure SortList; + procedure Refresh; + function GetCount: Word; + property ThumbList: TJvThumbList read FThumbList write FThumbList; + published + property SelectedFile: string read GetSelectedFile write SetSelectedFile; + property AlignView: TViewType read FAlignView write SetAlignView; + property AutoScrolling: Boolean read FAutoScrolling write FAutoScrolling; + property ThumbGap: Byte read FThumbGap write SetThumbGap; + property AutoHandleKeyb: Boolean read FAutoHandleKeyb write FAutoHandleKeyb; + property MinMemory: Boolean read FMinMemory write FMinMemory; + property Count: Word read GetCount default 0; + property MaxWidth: Longint read GetMaxWidth write SetMaxWidth; + property MaxHeight: Longint read GetMaxHeight write SetMaxHeight; + property Size: TPercent read FPercent write SetPercent; + property ScrollMode: TScrollMode read FScrollMode write SetScrollMode; + property Directory: string read FDirectory write SetDirectory; + property Sorted: Boolean read FSorted write SetSorted; + property Selected: Longint read FSelected write SetSelected default -1; + property OnStartScanning: TProgressStartNotify read FOnStartScanning write FOnStartScanning; + property OnStopScanning: TNotifyEvent read FOnStopScanning write FOnStopScanning; + property OnScanProgress: TProgressNotify read FOnScanProgress write FOnScanProgress; + property OnGetTitle: TTitleNotify read FOnGetTitle write FOnGetTitle; + property OnInvalidImage: TInvalidImageEvent read FOnInvalidImage write FOnInvalidImage; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; + property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; + property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress; + property AsButtons: Boolean read FAsButtons write SetAsButton; + property TitlePlacement: TTitlePos read FTitlePlacement write SetTitlePos default tpUp; + property Filter: string read FFilter write FFilter; + // Property BufferFile : String Read FBufferFile write SetBufferFile; + property ThumbColor: TColor read FThumbColor write FThumbColor; + property ShowShadow: Boolean read FShowShadow write FShowShadow; + property ShadowColor: TColor read FShadowColor write FShadowColor; + property AutoScroll; + property PopupMenu; + property BorderStyle; + property Align; + property Color; + property Cursor; + property DragCursor; + property DragMode; + property Enabled; + end; + + +implementation + +uses + JvConsts; + +{const + FGraphicExtensions : array[1..9] of string = ('*.BMP','*.JPG','*.WMF','*.EMF', + '*.ICO','*.GIF','*.PCX', + '*.TGA','*.PNG'); } + +constructor TJvThumbView.Create(AOwner: TComponent); +begin + FMaxSize.X := 200; + FMaxSize.Y := 200; + + inherited Create(AOwner); + + TabStop := True; + FPainted := False; + Width := 600; + Height := 480; + FPercent := 100; + FThumbGap := 4; + VertScrollBar.Tracking := True; + HorzScrollBar.Tracking := True; + FScrollMode := smHorizontal; + Caption := ''; + CalculateSize; + FWaitUntilFull := False; + FFilling := False; + FSorted := True; + FMinMemory := True; + FSelected := -1; + AutoScrolling := True; + FDiskSize := 0; + FAutoHandleKeyb := True; + FFilter := CreateFilter; + FThumbList := TJvThumbList.Create; + FThumbList.Sorted := Sorted; + FFileList := TStringList.Create; + FFileList.Clear; + FFileListSorted := TStringList.Create; + FFileListSorted.Clear; + FThumbColor := clNone; +end; + +destructor TJvThumbView.Destroy; +begin + FreeAndNil(FFileListSorted); + FreeAndNil(FFileList); + FreeAndNil(FThumbList); + //FreeAndNil(FFilter); + inherited Destroy; +end; + +procedure TJvThumbView.CreateHandle; +begin + inherited; + CalculateSize; +end; + +procedure TJvThumbView.DoInvalidImage(Sender: TObject; const FileName: string); +begin + if Assigned(FOnInvalidImage) then + FOnInvalidImage(Sender, FileName); +end; + +procedure TJvThumbView.AddThumb(ATitle: string; Redraw: Boolean); +var + Thb: TJvThumbnail; +begin + Thb := TJvThumbnail.Create(Self); + Thb.Left := CalculateXPos(Count + 1); + Thb.Top := CalculateYPos(Count + 1); + Thb.Width := FThumbSize.X; + Thb.Height := FThumbSize.Y; + Thb.AsButton := FAsButtons; + Thb.TitlePlacement := FTitlePlacement; + Thb.ShadowColor := FShadowColor; + Thb.ShowShadow := FShowShadow; + Thb.OnClick := OnClick; + Thb.Photo.OnClick := OnClick; + Thb.Photo.OnInvalidImage := @DoInvalidImage; + Thb.OnDblClick := OnDblClick; + Thb.Photo.OnDblClick := OnDblClick; + Thb.MinimizeMemory := MinMemory; + Thb.Color := Self.Color; + Thb.Title := ATitle; + if FThumbColor = clNone then + begin + Thb.Color := Self.Color; + Thb.ParentColor := True; + Thb.TitleColor := Self.Color; + end + else + Thb.Color := FThumbColor; + FThumbList.AddObject(Thb.Title, Thb); + Thb.Parent := Self; + if Redraw then + begin + CalculateSize; + Reposition(0); + end; +end; + +procedure TJvThumbView.GetFiles(ADirectory: string); +var + SearchRec: TSearchRec; + FResult: Integer; + NumExtensions: Integer; + + function FindFirstGraphic(AExtension: string): Integer; + begin + // (rom) strange flag faArchive + FindFirstGraphic := + FindFirst(ADirectory + AExtension, faArchive, SearchRec); + end; + +begin + FFileList.Clear; + FFileListSorted.Clear; + SetFilters; + if not DirectoryExists(ADirectory) then + Exit; + if ADirectory[Length(ADirectory)] <> PathDelim then + ADirectory := ADirectory + PathDelim; + for NumExtensions := 0 to FGraphicExtensions.Count - 1 do + begin + if (FindFirstGraphic(FGraphicExtensions[NumExtensions]) = 0) then + begin + try + if (FFileList.IndexOf(ADirectory + SearchRec.Name) < 0) then + begin + FFileList.Add(ADirectory + SearchRec.Name); + FFileListSorted.Add(ADirectory + SearchRec.Name); + repeat + FResult := FindNext(SearchRec); + if (FResult = 0) and (FFileList.IndexOf(ADirectory + SearchRec.Name) < 0) then + begin + FFileList.Add(ADirectory + SearchRec.Name); + FFileListSorted.Add(ADirectory + SearchRec.Name); + end; + until FResult <> 0; + end; + finally + FindClose(SearchRec); + end; + end; + end; + FFileListSorted.Sort; + if Assigned(FGraphicExtensions) then + FreeAndNil(FGraphicExtensions); +end; + +procedure TJvThumbView.SetAlignView(AType: TViewType); +begin + if AType <> FAlignView then + begin + FAlignView := AType; + Reposition(0); + end; +end; + +procedure TJvThumbView.ScrollTo(const Number: Longint); +var + TN: TJvThumbnail; +begin +// if AutoScrolling then + if (Number < 0) or (Number >= FThumbList.Count) then + Exit; + TN := TJvThumbnail(FThumbList.Objects[Number]); + case ScrollMode of + smVertical: + begin + if TN.Top < 0 then + VertScrollBar.Position := VertScrollBar.Position + + (TN.Top - (TN.Width div 2)); + if TN.Top + TN.Height > Height then + VertScrollBar.Position := VertScrollBar.Position + + (TN.Top - (Height - TN.Height - (TN.Height div 2))); + end; + smHorizontal: + begin + if TN.Left < 0 then + HorzScrollBar.Position := HorzScrollBar.Position + + (TN.Left - (TN.Width div 2)); + if TN.Left + TN.Width > Width then + HorzScrollBar.Position := HorzScrollBar.Position + + (TN.Left - (Width - TN.Width - (TN.Width div 2))); + end; + smBoth: + begin + if TN.Top < 0 then + VertScrollBar.Position := VertScrollBar.Position + + (TN.Top - (TN.Width div 2)); + if TN.Top + TN.Height > Height then + VertScrollBar.Position := VertScrollBar.Position + + (TN.Top - (TN.Height - (TN.Height div 2))); + if TN.Left < 0 then + HorzScrollBar.Position := HorzScrollBar.Position + + (TN.Left - (TN.Width div 2)); + if TN.Left + TN.Width > Width then + HorzScrollBar.Position := HorzScrollBar.Position + + (TN.Left - (Width - TN.Width - (TN.Width div 2))); + end; + end; + if FSelected <> Number then + begin + FSelected := Number; + if Assigned(OnClick) then + OnClick(Self); + end; +end; + +(* +function TJvThumbView.GetBufferName(AName: string): string; +var + tst: string; + FN: string; + Res: string; +begin + tst := completepath(extractFiledir(AName)); + if tst = AName then + begin // No FileName included only A Directory; + // the user wants us to Create A seperate file for each + // Directory it opens in A pre-specified path + FN := ReplaceChar(FDirectory, '\', '_', 0, False); //Create the FileName from the path + FN := ReplaceChar(FN, ':', '_', 0, False); //Create the FileName from the path + Res := AName + fn; + end + else + begin // the user has specified either A full path and A name or just A name + if tst = '' then + // the user has specified only A name to use + // in each Directory that is opened by the component there will be created + // A file with name <ANAME> where the thumbs are been saved; + Res := CompletePath(FDirectory) + AName + else + // the user has specified A full path and A file name weach is the same + // for all the directories he/she opens. + Res := AName; + end; + Result := Res; +end; +*) + +//Procedure TJvThumbView.SetBufferFile(NewName: string); +//var +// tst: string; +//begin +// If NewName <> FBufferFile then +// tst := GetBufferName(NewName); +// End; +//end; + +procedure TJvThumbView.SetSelected(Number: Longint); +var + TN: TJvThumbnail; +begin + if (Number < 0) or (Number >= FThumbList.Count) then + Number := -1; + + if FThumbList.Count > 0 then + begin + if FSelected <> -1 then + begin + TN := TJvThumbnail(FThumbList.Objects[FSelected]); + TN.TitleColor := TN.Color; + TN.TitleFont.Color := TN.Font.Color; + end; + if Number <> -1 then + begin + TN := TJvThumbnail(FThumbList.Objects[Number]); + TN.TitleColor := clHighlight; + TN.TitleFont.Color := clHighlightText; + if AutoScrolling then + begin + if (TN.Top + TN.Height > Height) or (TN.Top < 0) then + ScrollTo(Number); + if (TN.Left + TN.Width > Width) or (TN.Left < 0) then + ScrollTo(Number); + end + end; + if FSelected <> Number then + begin + if Assigned(FOnChanging) then + FOnChanging(Self); + + FSelected := Number; + + if Assigned(FOnChange) then + FOnChange(Self); + end; + end + else + FSelected := -1; +end; + +function TJvThumbView.GetSelectedFile: String; +begin + if Selected <> -1 then + Result := TJvThumbnail(FThumbList.Objects[Selected]).FileName; +end; + +procedure TJvThumbView.SetSelectedFile(AFile: string); +var + I: Longint; + Dir: string; +begin + Dir := ExtractFileDir(AFile); + if Dir[Length(Dir)] = PathDelim then + Dir := Copy(Dir, 0, Length(Dir) - 1); + Directory := Dir; + for I := 0 to FThumbList.Count - 1 do + if TJvThumbnail(FThumbList.Objects[I]).FileName = AFile then + begin + Selected := I; + if not FAutoScrolling then + ScrollTo(I); + Exit; + end; +end; + +procedure TJvThumbView.SetDirectory(Value: string); +var + Counter1, FStartTime: DWORD; + Cancel: Boolean; + ReadFileList: TStringList; + OldCursor: TCursor; +// Pic: TPicture; +begin + FSelected := -1; + // if not FPainted then + // begin + // postMessage(Self.Handle, WM_LOADWHENREADY, 0, 0); + // Exit; + // end; + FDiskSize := 0; + if FFilling then + Exit; + if Value <> '' then + begin + ReadFileList := TStringList.Create; + OldCursor := Cursor; + try + FFilling := True; + // if Assigned(ReadFileList) then FreeAndNil(ReadFileList); + FStartTime := GetTickCount; + GetFiles(Value); + if FSorted then + ReadFileList.Assign(FFileListSorted) + else + ReadFileList.Assign(FFileList); + EmptyList; + FDirectory := Value; + if Assigned(FOnStartScanning) then + FOnStartScanning(Self, ReadFileList.Count - 1); + if ReadFileList.Count > 0 then + begin + Cancel := False; + for Counter1 := 0 to ReadFileList.Count - 1 do + begin + if Assigned(FOnScanProgress) then + FOnScanProgress(Self, Counter1 + 1, Cancel); + if Cancel then + Break; + AddThumb(ExtractFilename(ReadFileList.Strings[Counter1]), True); + TJvThumbnail(FThumbList.Objects[Counter1]).FileName := ReadFileList.Strings[Counter1]; + Inc(FDiskSize, TJvThumbnail(FThumbList.Objects[Counter1]).FileSize); + if (Cursor <> crHourGlass) and (GetTickCount - FStartTime > 1000) then + Cursor := crHourGlass; + end; + end; + if Assigned(FOnStopScanning) then + FOnStopScanning(Self); + finally + FreeAndNil(ReadFileList); + FFilling := False; + Cursor := OldCursor; + end + end + else + EmptyList; + FDirectory := Value; + if (FThumbList.Count > 0) and (Selected < 0) then + SetSelected(0); + Invalidate; +end; + +procedure TJvThumbView.Reposition(Start: Integer); +var + I: Integer; + Tmp1: Longint; + Tmp2: Longint; + TN: TJvThumbnail; +begin + if FThumbList = nil then + exit; + + Tmp2 := HorzScrollBar.Position; + HorzScrollBar.Position := 0; + Tmp1 := VertScrollBar.Position; + VertScrollBar.Position := 0; + for I := Start to FThumbList.Count - 1 do + begin + TN := TJvThumbnail(FThumbList.Objects[I]); + if TN <> nil then + begin + TN.Left := CalculateXPos(I + 1); + TN.Top := CalculateYPos(I + 1); + TN.Width := FThumbSize.X; + TN.Height := FThumbSize.Y; + end; + end; + HorzScrollBar.Position := Tmp2; + VertScrollBar.Position := Tmp1; +end; + +procedure TJvThumbView.CalculateMaxX; +var + A: Longint; +begin + if not HandleAllocated then + exit; + + case FScrollMode of + smVertical: + A := (Width - 20) div (FThumbSize.X + FThumbGap); + smHorizontal: + A := (Height - 20) div (FThumbSize.Y + FThumbGap); + smBoth: + A := JkCeil(Sqrt(FThumbList.Count)); + else + A := 1; + end; + if A < 1 then + A := 1; + if A <> FMaxX then + FMaxX := A; +end; + +procedure TJvThumbView.CalculateSize; +begin + FThumbSize.X := Trunc((MaxWidth / 100.0) * Size); + FThumbSize.Y := Trunc((MaxHeight / 100.0) * Size); + CalculateMaxX; +end; + +function TJvThumbView.CalculateXPos(Num: Word): Longint; +var + VPos, HPos: Longint; + Temp: Longint; + Tmp: Longint; + Spact: Longint; +begin + if Num > 0 then + begin + Spact := FThumbGap; + case FScrollMode of + smVertical, smBoth: + begin + if (FAlignView = vtFitToScreen) and (FScrollMode = smVertical) then + Spact := ((Width - 20) - (FThumbSize.X * FMaxX)) div (FMaxX + 1); + VPos := JkCeil(Num / FMaxX); + HPos := (Num - (VPos * FMaxX)) + FMaxX; + Temp := (FThumbSize.X * (HPos - 1)) + (HPos * Spact); + if (FAlignView = vtCenter) and (FScrollMode = smVertical) then + begin + Tmp := ((Width - 20) div 2) - (((FThumbSize.X + FThumbGap) * FMaxX) div 2); + Temp := Temp + Tmp; + end; + end; + smHorizontal: + begin + VPos := JkCeil(Num / FMaxX); + Temp := (FThumbSize.Y * (VPos - 1)) + (VPos * Spact); + end + else + Temp := 0 + end; + end + else + Temp := 0; + Result := Temp; +end; + +function TJvThumbView.CalculateYPos(Num: Word): Longint; +var + VPos, HPos: Longint; + Temp: Longint; + Tmp: Longint; + Spact: Longint; +begin + if Num > 0 then + begin + Spact := FThumbGap; + case FScrollMode of + smVertical, smBoth: + begin + VPos := JkCeil(Num / FMaxX); + Temp := (FThumbSize.Y * (VPos - 1)) + (VPos * Spact); + end; + smHorizontal: + begin + if FAlignView = vtFitToScreen then + Spact := ((Height - 20) - ((FThumbSize.Y + FThumbGap) * FMaxX)) div (FMaxX + 1); + HPos := JkCeil(Num / FMaxX); + VPos := (Num - (HPos * FMaxX)) + FMaxX; + Temp := (FThumbSize.X * (VPos - 1)) + (VPos * Spact); + if FAlignView = vtCenter then + begin + Tmp := ((Height - 20) div 2) - ((FThumbSize.Y * FMaxX) div 2); + Temp := Temp + Tmp; + end; + end; + else + Temp := 0; + end; + end + else + Temp := 0; + Result := Temp; +end; + +procedure TJvThumbView.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + No: Word; + TempX, TempY: Longint; +begin + // Check to see if there are any problems removing the following + // For sure it solves A focus problem I'm having in an application + // setfocus; + if Count > 0 then + case ScrollMode of + smVertical, smBoth: + begin + TempX := JkCeil((X + HorzScrollBar.Position) / (FThumbSize.X + FThumbGap)); + TempY := JkCeil((Y + VertScrollBar.Position) / (FThumbSize.Y + FThumbGap)); + if TempX > FMaxX then + TempX := FMaxX; + if TempY < 1 then + TempY := 1; + No := ((TempY - 1) * FMaxX + TempX) - 1; + if No < Count then + if TJvThumbnail(FThumbList.Objects[No]) <> nil then + if (X > TJvThumbnail(FThumbList.Objects[No]).Left) and + (X < TJvThumbnail(FThumbList.Objects[No]).Left + + TJvThumbnail(FThumbList.Objects[No]).Width) and + (Y > TJvThumbnail(FThumbList.Objects[No]).Top) and + (Y < TJvThumbnail(FThumbList.Objects[No]).Top + + TJvThumbnail(FThumbList.Objects[No]).Height) then + SetSelected(No) + else + SetSelected(-1) + else + SetSelected(-1) + else + SetSelected(-1); + end; + smHorizontal: + begin + TempX := JkCeil((X + HorzScrollBar.Position) / (FThumbSize.X + FThumbGap)); + TempY := JkCeil((Y + VertScrollBar.Position) / (FThumbSize.Y + FThumbGap)); + if TempY > FMaxX then + TempY := FMaxX; + if TempX < 1 then + TempX := 1; + No := ((TempX - 1) * FMaxX + TempY) - 1; + if No < Count then + if TJvThumbnail(FThumbList.Objects[No]) <> nil then + if (X > TJvThumbnail(FThumbList.Objects[No]).Left) and + (X < TJvThumbnail(FThumbList.Objects[No]).Left + + TJvThumbnail(FThumbList.Objects[No]).Width) and + (Y > TJvThumbnail(FThumbList.Objects[No]).Top) and + (Y < TJvThumbnail(FThumbList.Objects[No]).Top + + TJvThumbnail(FThumbList.Objects[No]).Height) then + SetSelected(No) + else + SetSelected(-1) + else + SetSelected(-1) + else + SetSelected(-1); + end; + else + SetSelected(-1); + end; + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TJvThumbView.AddFromStream(AStream: TStream; AType: TGRFKind); +begin + AddFromStream(AStream, AType, ''); +end; + +function TJvThumbView.AddFromStream(AStream: TStream; AType: TGRFKind; const aTitle: string): Integer; +var + Thb: TJvThumbnail; +begin + Thb := TJvThumbnail.Create(Self); + Thb.StreamFileType := AType; + Thb.Left := CalculateXPos(Count + 1); + Thb.Top := CalculateYPos(Count + 1); + Thb.Width := FThumbSize.X; + Thb.Height := FThumbSize.Y; + Thb.OnClick := OnClick; + Thb.Photo.OnClick := OnClick; + Thb.OnDblClick := OnDblClick; + Thb.Title := aTitle; + Thb.Photo.OnDblClick := OnDblClick; + // Thb.Buffer := Vbuffer; + Thb.Photo.LoadFromStream(AStream, Thb.StreamFileType); + Result := FThumbList.AddObject(Thb.Title, Thb); + InsertControl(Thb); + CalculateSize; + Reposition(Result); +end; + +function TJvThumbView.AddFromFile(AFile: string) : Integer; +var + ThumbnailTitle: string; + FFont: TFont; + FColor: TColor; + Thb: TJvThumbnail; +begin + Thb := TJvThumbnail.Create(Self); + if Assigned(FOnGetTitle) then + begin + ThumbnailTitle := ExtractFilename(AFile); + FFont := TFont.Create; + FColor := clBtnFace; + if Assigned(FOnGetTitle) then + FOnGetTitle(Self, AFile, ThumbnailTitle, FFont, FColor); + Thb.SetTitlePanel(ThumbnailTitle, FFont, FColor); + FreeAndNil(FFont); + end; + Thb.OnClick := OnClick; + Thb.Photo.OnClick := OnClick; + Thb.OnDblClick := OnDblClick; + Thb.Photo.OnDblClick := OnDblClick; + Thb.MinimizeMemory := MinMemory; + // Thb.Buffer := VBuffer; + FThumbList.AddObject(AFile, Thb); + InsertControl(Thb); + CalculateSize; + Reposition(0); + TJvThumbnail(FThumbList.Objects[FThumbList.IndexOf(AFile)]).FileName := AFile; + result := FThumbList.IndexOf(AFile); +end; + +procedure TJvThumbView.Delete(No: Longint); +var + Dummy: Longint; +begin + if No >= FThumbList.Count then + begin + end //Raise an exception + else + begin + Dummy := FFileList.IndexOf(SelectedFile); + if Dummy >= 0 then + FFileList.Delete(Dummy); + Dummy := FFileListSorted.IndexOf(SelectedFile); + if Dummy >= 0 then + FFileListSorted.Delete(Dummy); + TJvThumbnail(FThumbList.Objects[No]).Free; + FThumbList.Delete(No); + FSelected := -1; + //CalculateSize; + Dec(No, 1); + if No < 0 then + No := 0; + Reposition(No); + Refresh; + Repaint; + end +end; + +procedure TJvThumbView.SetThumbGap(Sp: Byte); +begin + case FAlignView of + vtNormal, vtCenter: + begin + FThumbGap := Sp; + CalculateMaxX; + Reposition(0); + end; + vtFitToScreen: + FThumbGap := Sp; + end; +end; + +function TJvThumbView.GetCount: Word; +begin + Result := FThumbList.Count; +end; + +procedure TJvThumbView.SortList; +begin + // add code to resort the list + FThumbList.Sort; + CalculateSize; + Reposition(0); +end; + +procedure TJvThumbView.Refresh; +var + I: Longint; +begin + CalculateSize; + Reposition(0); + for I := 0 to FThumbList.Count - 1 do + FThumbList.Thumbnail[I].Refresh; + inherited Refresh; +end; + +procedure TJvThumbView.EmptyList; +var + Metr: Integer; +begin + for Metr := Count - 1 downto 0 do + if FThumbList.Objects[Metr] <> nil then + begin + TJvThumbnail(FThumbList.Objects[Metr]).Parent := nil; + TJvThumbnail(FThumbList.Objects[Metr]).Free; + FThumbList.Delete(Metr); + end; + FSelected := -1; // Mantis #5140 +end; + +procedure TJvThumbView.SetMaxWidth(W: Longint); +begin + FMaxSize.X := W; + CalculateSize; + Reposition(0); +end; + +procedure TJvThumbView.SetMaxHeight(H: Longint); +begin + // if FMaxSize.Y<H then + FMaxSize.Y := H; + CalculateSize; + Reposition(0); +end; + +procedure TJvThumbView.Resize; +begin + CalculateMaxX; + Reposition(0); + inherited Resize; +end; + +procedure TJvThumbView.SetPercent(P: TPercent); +begin + FPercent := P; + CalculateSize; + Reposition(0); +end; + +procedure TJvThumbView.WMPaint(var Msg: TLMPaint); +begin + inherited; + if not FPainted then + begin + FPainted := True; + SetDirectory(FDirectory); + end; +end; + +procedure TJvThumbView.SetScrollMode(AMode: TScrollMode); +begin + if FScrollMode <> AMode then + begin + FScrollMode := AMode; + CalculateSize; + Reposition(0); + if Selected > -1 then + ScrollTo(Selected); + end +end; + +procedure TJvThumbView.KeyUp(var Key: Word; Shift: TShiftState); +begin + if Assigned(FOnKeyUp) then + FOnKeyUp(Self, Key, Shift); + inherited KeyUp(Key, Shift); +end; + +procedure TJvThumbView.KeyDown(var Key: Word; Shift: TShiftState); +begin + if AutoHandleKeyb and (FThumbList.Count > 0) then + case Key of + VK_RIGHT: + begin + GoRight; + ScrollTo(Selected); + end; + VK_DOWN: + begin + GoDown; + ScrollTo(Selected); + end; + VK_LEFT: + begin + GoLeft; + ScrollTo(Selected); + end; + VK_UP: + begin + GoUp; + ScrollTo(Selected); + end; + VK_DELETE: + begin + end; + VK_PRIOR: + begin + end; + VK_NEXT: + begin + end; + VK_END: + begin + Selected := Count - 1; + ScrollTo(Selected); + end; + VK_HOME: + begin + Selected := 0; + ScrollTo(Selected); + end; + end; + inherited KeyDown(Key, Shift); +end; + +procedure TJvThumbView.KeyPress(var Key: Char); +begin + if Assigned(FOnKeyPress) then + FOnKeyPress(Self, Key); + inherited KeyPress(Key); +end; + +procedure TJvThumbView.SetSorted(const Value: Boolean); +begin + if Value <> FSorted then + begin + FSorted := Value; + if not FPainted then + Exit; + FThumbList.Sorted := FSorted; + SetDirectory(FDirectory); // force reread + Invalidate; + end; +end; + +(************* NOT CONVERTED +procedure TJvThumbView.GetDlgCode(var Code: TDlgCodes); +begin + Code := [dcWantArrows, dcWantAllKeys]; +end; +************) + +procedure TJvThumbView.GoRight; +var + Actual: Longint; +begin + Actual := 0; + if ScrollMode = smHorizontal then + Actual := Selected + FMaxX; + if (ScrollMode = smVertical) or (ScrollMode = smBoth) then + Actual := Selected + 1; + if (Actual > Count - 1) or (Actual < 0) then + Actual := Selected; + Selected := Actual; +end; + +procedure TJvThumbView.GoLeft; +var + Actual: Longint; +begin + Actual := 0; + if ScrollMode = smHorizontal then + Actual := Selected - FMaxX; + if (ScrollMode = smVertical) or (ScrollMode = smBoth) then + Actual := Selected - 1; + if (Actual > Count - 1) or (Actual < 0) then + Actual := Selected; + Selected := Actual; +end; + +procedure TJvThumbView.GoDown; +var + Actual: Longint; +begin + Actual := 0; + if ScrollMode = smHorizontal then + Actual := Selected + 1; + if (ScrollMode = smVertical) or (ScrollMode = smBoth) then + Actual := Selected + FMaxX; + if (Actual > Count - 1) or (Actual < 0) then + Actual := Selected; + Selected := Actual; +end; + +procedure TJvThumbView.GoUp; +var + Actual: Longint; +begin + Actual := 0; + if ScrollMode = smHorizontal then + Actual := Selected - 1; + if (ScrollMode = smVertical) or (ScrollMode = smBoth) then + Actual := Selected - FMaxX; + if (Actual > Count - 1) or (Actual < 0) then + Actual := Selected; + Selected := Actual; +end; + +procedure TJvThumbView.SetAsButton(const NewVal: Boolean); +var + I: Longint; +begin + if NewVal <> FAsButtons then + begin + for I := 0 to FThumbList.Count - 1 do + FThumbList.Thumbnail[I].AsButton := NewVal; + FAsButtons := NewVal; + end; +end; + +procedure TJvThumbView.SetTitlePos(const NewVal: TTitlePos); +var + I: Longint; +begin + if NewVal <> FTitlePlacement then + begin + for I := 0 to FThumbList.Count - 1 do + FThumbList.Thumbnail[I].TitlePlacement := NewVal; + FTitlePlacement := NewVal; + end; +end; + +function TJvThumbView.CreateFilter: string; +//var +// Res: string; +// Pos: Longint; +begin + Result := GraphicFilter(TGraphic); +end; + +procedure TJvThumbView.SetFilters; +var + Cp1 {, CP2}: Integer; // CurrentPosition; +// Md: Byte; // Mode + Res: string; +// Sub: string; + Final: string; +begin + if not Assigned(FGraphicExtensions) then + FGraphicExtensions := TStringList.Create; +// Cp1 := 0; +// CP2 := 0; + Res := FFilter; + Final := ''; + repeat + Cp1 := Pos('|', Res); + if Cp1 > 0 then + begin + System.Delete(Res, 1, Cp1); + Cp1 := Pos('|', Res); + if Cp1 > 0 then + begin + Final := Final + ';' + Copy(Res, 1, Cp1 - 1); + System.Delete(Res, 1, Cp1); + end + else + Final := Final + ';' + Res; + end + else + Final := Final + ';' + Res; + until Cp1 = 0; + Final := ReplaceAllstr(Final, ';', sLineBreak, False); + FGraphicExtensions.Text := Final; + + Cp1 := 0; + repeat + if FGraphicExtensions[Cp1] = '' then + FGraphicExtensions.Delete(Cp1) + else + Inc(Cp1); + until Cp1 = FGraphicExtensions.Count; +end; + +function TJvThumbList.GetThumbnail(Index: Longint): TJvThumbnail; +begin + Result := TJvThumbnail(Objects[Index]); +end; + +function TJvThumbView.GetMaxHeight: Longint; +begin + Result := FMaxSize.Y; +end; + +function TJvThumbView.GetMaxWidth: Longint; +begin + Result := FMaxSize.X; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/components/jvcllaz/run/JvCustomControls/JvThumbnails.pas b/components/jvcllaz/run/JvCustomControls/JvThumbnails.pas new file mode 100644 index 000000000..b4dd9cd86 --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvThumbnails.pas @@ -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.