jvqthumbviews.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: 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.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQThumbViews.pas,v 1.1 2004/05/16 00:41:48 asnepvangers Exp $

{$I jvcl.inc}
{$I windowsonly.inc}

unit JvQThumbViews;

interface

uses
  Windows, Classes, QControls, QForms, QExtCtrls,
  QFileCtrls, QStdCtrls, SysUtils, Messages, QGraphics,
  JvQThumbNails, JvQBaseThumbnail, JvQExControls;

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: TWMPaint); message WM_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 DoGetDlgCode(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);
    procedure AddFromFile(AFile: string);
    procedure AddFromStream(AStream: TStream; AType: TGRFKind);
    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
  JvQConsts;
  
{const
  FGraphicExtensions  : array[1..9] of string = ('*.BMP','*.JPG','*.WMF','*.EMF',
                                             '*.ICO','*.GIF','*.PCX',
                                             '*.TGA','*.PNG'); {}
constructor TJvThumbView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := True;
  FPainted := False;
  Width := 600;
  Height := 480;
  FMaxSize.X := 200;
  FMaxSize.Y := 200;
  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
  if Assigned(FFileListSorted) then
    FreeAndNil(FFileListSorted);
  if Assigned(FFileList) then
    FreeAndNil(FFileList);
  if Assigned(FThumbList) then
    FreeAndNil(FThumbList);
  //If Assigned(FFilter) then FreeAndNil(FFilter);
  inherited Destroy;
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)] <> '\' then
    ADirectory := ADirectory + '\';
  for NumExtensions := 0 to FGraphicExtensions.Count - 1 do
  begin
    if (FindFirstGraphic(FGraphicExtensions[NumExtensions]) = 0) and
      (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;
      FindClose(SearchRec);
    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);
begin
// if AutoScrolling then if (number>-1) then
  if (number < 0) or (number > FThumbList.count - 1) then exit;
  case scrollmode of
    smvertical:
      begin
        if TJvThumbnail(FThumbList.objects[number]).top < 0 then
          vertscrollbar.position := vertscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).top -
            (TJvThumbnail(FThumbList.objects[number]).width div 2));
        if TJvThumbnail(FThumbList.objects[number]).top +
          TJvThumbnail(FThumbList.objects[number]).height > height then
          vertscrollbar.position := vertscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).top -
            (height - TJvThumbnail(FThumbList.objects[number]).height -
            (TJvThumbnail(FThumbList.objects[number]).height div 2)));
      end;
    smhorizontal:
      begin
        if TJvThumbnail(FThumbList.objects[number]).left < 0 then
          horzscrollbar.position := Horzscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).left -
            (TJvThumbnail(FThumbList.objects[number]).width div 2));
        if TJvThumbnail(FThumbList.objects[number]).left +
          TJvThumbnail(FThumbList.objects[number]).width > width then
          Horzscrollbar.position := Horzscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).left -
            (width - TJvThumbnail(FThumbList.objects[number]).width -
            (TJvThumbnail(FThumbList.objects[number]).width div 2)));
      end;
    smBoth:
      begin
        if TJvThumbnail(FThumbList.objects[number]).top < 0 then
          vertscrollbar.position := vertscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).top -
            (TJvThumbnail(FThumbList.objects[number]).width div 2));
        if TJvThumbnail(FThumbList.objects[number]).top +
          TJvThumbnail(FThumbList.objects[number]).height > height then
          vertscrollbar.position := vertscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).top -
            (TJvThumbnail(FThumbList.objects[number]).height -
            (TJvThumbnail(FThumbList.objects[number]).height div 2)));
        if TJvThumbnail(FThumbList.objects[number]).left < 0 then
          horzscrollbar.position := Horzscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).left -
            (TJvThumbnail(FThumbList.objects[number]).width div 2));
        if TJvThumbnail(FThumbList.objects[number]).left +
          TJvThumbnail(FThumbList.objects[number]).width > width then
          Horzscrollbar.position := Horzscrollbar.position +
            (TJvThumbnail(FThumbList.objects[number]).left -