jvcllaz: Add thumbnail components (incl demo).

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

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