jvqimagesviewer.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{  WARNING:  JEDI preprocessor generated unit.  Do not edit.                                       }
{**************************************************************************************************}

{-----------------------------------------------------------------------------
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: JvImagesViewer.PAS, released on 2003-12-01.

The Initial Developer of the Original Code is: Peter Th鰎nqvist
All Rights Reserved.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQImagesViewer.pas,v 1.6 2004/05/16 10:05:33 asnepvangers Exp $

unit JvQImagesViewer;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  
  
  Types, QWindows, QControls, QGraphics, QStdCtrls, QComCtrls,
  
  JvQCustomItemViewer;

type
  TJvImageItem = class(TJvViewerItem)
  private
    FFileName: string;
    FPicture: TPicture;
    FCaption: TCaption;
    procedure SetFileName(const Value: string);
    procedure SetCaption(const Value: TCaption);
    procedure SetPicture(const Value: TPicture);
    function GetPicture: TPicture;
    procedure CreatePicture;
  protected
    procedure DoPictureChange(Sender: TObject); virtual;
    procedure DoLoadProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte;
      RedrawNow: Boolean; const R: TRect; const Msg: string); virtual;
    procedure ReduceMemoryUsage; override;
  public
    destructor Destroy; override;
  public
    property FileName: string read FFileName write SetFileName;
    property Picture: TPicture read GetPicture write SetPicture;
    property Caption: TCaption read FCaption write SetCaption;
  end;

  TJvImageViewerOptions = class(TJvCustomItemViewerOptions)
  private
    FImagePadding: Integer;
    FFrameColor: TColor;
    FHotFrameSize: Integer;
    FHotColor: TColor;
    FTransparent: Boolean;
    procedure SetImagePadding(const Value: Integer);
    procedure SetFrameColor(const Value: TColor);
    procedure SetHotColor(const Value: TColor);
    procedure SetHotFrameSize(const Value: Integer);
    procedure SetTransparent(const Value: Boolean);
  public
    constructor Create(AOwner: TJvCustomItemViewer); override;
  published
    property AutoCenter;
    property Alignment;
    property BrushPattern;
    property DragAutoScroll;
    property FrameColor: TColor read FFrameColor write SetFrameColor default clGray;
    property Height;
    property HorzSpacing;
    property HotColor: TColor read FHotColor write SetHotColor default clHighlight;
    property HotFrameSize: Integer read FHotFrameSize write SetHotFrameSize default 2;
    property HotTrack;
    property ImagePadding: Integer read FImagePadding write SetImagePadding default 8;
    property Layout;
    property LazyRead;
    property MultiSelect;
    property ReduceMemoryUsage;
    property RightClickSelect;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property ScrollBar;
    property ShowCaptions default True;
    property Tracking;
    property VertSpacing;
    property Width;
  end;

  TJvImageLoadEvent = procedure(Sender: TObject; Item: TJvImageItem) of object;
  TJvImageLoadErrorEvent = procedure(Sender: TObject; E: Exception;
    const FileName: string; var Handled: Boolean) of object;
  TJvImageViewerLoadProgress = procedure(Sender: TObject; Item: TJvImageItem; Stage: TProgressStage;
    PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object;

  TJvImagesViewer = class(TJvCustomItemViewer)
  private
    FFileMask: string;
    FDirectory: string;
    FOnLoadError: TJvImageLoadErrorEvent;
    FOnLoadProgress: TJvImageViewerLoadProgress;
    FOnLoadBegin: TNotifyEvent;
    FOnLoadEnd: TNotifyEvent;
    procedure SetDirectory(const Value: string);
    procedure SetFileMask(const Value: string);
    function GetItems(Index: Integer): TJvImageItem;
    procedure ExpandFileMask(const Mask: string; Strings: TStrings);
    function ScaleRect(ARect, RefRect: TRect): TRect;
    function GetOptions: TJvImageViewerOptions;
    procedure SetOptions(const Value: TJvImageViewerOptions);
  protected
    function GetItemClass: TJvViewerItemClass; override;
    function GetOptionsClass: TJvItemViewerOptionsClass; override;
    function LoadErrorHandled(E: Exception; const FileName: string): Boolean;
    procedure DoLoadBegin; virtual;
    procedure DoLoadProgress(Item: TJvImageItem; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R:
      TRect; const Msg: string);
    procedure DoLoadEnd; virtual;
    procedure DrawItem(Index: Integer; State: TCustomDrawState; Canvas: TCanvas; ItemRect, TextRect: TRect); override;
  public
    constructor Create(AOwner: TComponent); override;
    function LoadImages: Boolean;
    property Items[Index: Integer]: TJvImageItem read GetItems;
    property Count;
  published
    property Directory: string read FDirectory write SetDirectory;
    property FileMask: string read FFileMask write SetFileMask;
    property Options: TJvImageViewerOptions read GetOptions write SetOptions;
    property SelectedIndex;
    property OnScroll;
    property OnLoadBegin: TNotifyEvent read FOnLoadBegin write FOnLoadBegin;
    property OnLoadEnd: TNotifyEvent read FOnLoadEnd write FOnLoadEnd;
    property OnLoadError: TJvImageLoadErrorEvent read FOnLoadError write FOnLoadError;
    property OnLoadProgress: TJvImageViewerLoadProgress read FOnLoadProgress write FOnLoadProgress;
    property OnDrawItem;
    property OnOptionsChanged;
    property OnItemChanging;
    property OnItemChanged;
    property OnItemHint;
    property OnInsertion;
    property OnDeletion;

    property Align;
    property Anchors;
    //    property BiDiMode;
    property Color;
    property Constraints;
    
    property DragMode;
    property Enabled;
    property Font;
    //    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
    property OnStartDrag;
  end;

implementation

uses
  JvQJCLUtils;
  
//=== TJvImageViewerOptions ==================================================

constructor TJvImageViewerOptions.Create(AOwner: TJvCustomItemViewer);
begin
  inherited Create(AOwner);
  FImagePadding := 20;
  FFrameColor := clGray;
  FHotColor := clHighlight;
  FHotFrameSize := 2;
  ShowCaptions := True;
end;

procedure TJvImageViewerOptions.SetFrameColor(const Value: TCOlor);
begin
  if FFrameColor <> Value then
  begin
    FFrameColor := Value;
    Change;
  end;
end;

procedure TJvImageViewerOptions.SetHotColor(const Value: TColor);
begin
  FHotColor := Value;
end;

procedure TJvImageViewerOptions.SetHotFrameSize(const Value: Integer);
begin
  FHotFrameSize := Value;
end;

procedure TJvImageViewerOptions.SetImagePadding(const Value: Integer);
begin
  if (FImagePadding <> Value) then
  begin
    FImagePadding := Value;
    Change;
  end;
end;

procedure TJvImageViewerOptions.SetTransparent(const Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Change;
  end;
end;

//=== TJvImageItem ===========================================================

destructor TJvImageItem.Destroy;
begin
  FreeAndNil(FPicture);
  inherited Destroy;
end;

procedure TJvImageItem.CreatePicture;
var
  S: string;
begin
  if FPicture = nil then
  begin
    FPicture := TPicture.Create;
    FPicture.OnChange := DoPictureChange;
    FPicture.OnProgress := DoLoadProgress;
    S := ExpandUNCFilename(FileName);
    if (S <> '') and FileExists(S) then
    try
      FPicture.LoadFromFile(S);
      if FPicture.Graphic <> nil then
        FPicture.Graphic.Transparent := TJvImagesViewer(Owner).Options.Transparent;
    except
      on E: Exception do
        if not TJvImagesViewer(Owner).LoadErrorHandled(E, FileName) then
          Delete
        else
        begin
          FreeAndNil(FPicture);
          raise;
        end;
    end;
  end;
end;

procedure TJvImageItem.DoPictureChange(Sender: TObject);
begin
  Changed;
end;

procedure TJvImageItem.DoLoadProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  if Owner is TJvImagesViewer then
    TJvImagesViewer(Owner).DoLoadProgress(Self, Stage, PercentDone, RedrawNow, R, Msg);
end;

function TJvImageItem.GetPicture: TPicture;
begin
  CreatePicture;
  Result := FPicture;
end;

procedure TJvImageItem.SetFileName(const Value: string);
begin
  if (AnsiCompareFilename(FFileName, Value) <> 0) and Changing then
  begin
    FFileName := Value;
    // don't load image unless necessary
    FreeAndNil(FPicture);
  end;
end;

procedure TJvImageItem.SetPicture(const Value: TPicture);
begin
  if Value <> nil then
    GetPicture.Assign(Value)
  else
    FreeAndNil(FPicture);
  Changed;
end;

procedure TJvImageItem.SetCaption(const Value: TCaption);
begin
  if (FCaption <> Value) and Changing then
  begin
    FCaption := Value;
    Changed;
  end;
end;