jvbasethumbnail.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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.sourceforge.net

Known Issues:
  This file contains (most likely) greek comments.
-----------------------------------------------------------------------------}
// $Id: JvBaseThumbnail.pas,v 1.25 2005/02/18 14:17:22 ahuser Exp $

unit JvBaseThumbnail;

{$I jvcl.inc}
{$I crossplatform.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, // TWin32FindData
  {$IFDEF VCL}
  {$IFDEF HAS_UNIT_LIBC}
  Libc, // stat()
  {$ENDIF HAS_UNIT_LIBC}
  {$ENDIF VCL}
  Messages, Classes, Graphics, Controls, Forms, ExtCtrls,
  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, {$IFNDEF COMPILER6_UP} grGIF, {$ENDIF} grPNG); //,grPCX,grTGA);
  TPercent = -100..100;

  TFileName = class(TObject)
  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;

  { The Following classes are declared here so I can handle interaction of the mouse
    between the three components.
  }
  TJvThumbTitle = class(TJvExPanel)
  protected
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): 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;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} 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(TJvExImage)
  private
    FIgnoreMouse: Boolean;
  protected
    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(TJvExPanel)
  protected
    function DoEraseBackground(Canvas: TCanvas; Param: 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;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} 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(TJvExScrollBox)
  protected
    // function DoEraseBackground(Canvas: TCanvas; Param: Integer): 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;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvBaseThumbnail.pas,v $';
    Revision: '$Revision: 1.25 $';
    Date: '$Date: 2005/02/18 14:17:22 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils,
  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
  // 震镫镢轶禳