jvwindialogs.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: JvWinDialogs.PAS, released on 2002-05-13.

The Initial Developer of the Original Code is Serhiy Perevoznyk.
All Rights Reserved.

Contributor(s):
Michael Beck

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: JvWinDialogs.pas,v 1.32 2005/02/17 10:21:17 marquardt Exp $

unit JvWinDialogs;

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

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF VisualCLX}
  Qt, QWindows,
  {$ENDIF VisualCLX}
  Windows, ShellAPI, ShlObj, ComObj, ActiveX, CommDlg, UrlMon,
  SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  JvBaseDlg, JvTypes, JvComponent, JvJCLUtils; // For OSCheck

{$HPPEMIT '#include "dbt.h"'}

type
  {$IFDEF VisualCLX}
  HWND = Windows.HWND;
  {$ENDIF VisualCLX}
  EShellOleError = class(Exception);
  EWinDialogError = class(Exception);

  TShellLinkInfo = record
    PathName: string;
    Arguments: string;
    Description: string;
    WorkingDirectory: string;
    IconLocation: string;
    IconIndex: Integer;
    ShowCmd: Integer;
    HotKey: Word;
  end;

  TSpecialFolderInfo = record
    Name: string;
    ID: Integer;
  end;

const
  OFN_EX_NOPLACESBAR = 1; // for new style of standard Windows dialogs
  {$EXTERNALSYM OFN_EX_NOPLACESBAR}

  SpecialFolders: array [0..29] of TSpecialFolderInfo = (
    (Name: 'Alt Startup'; ID: CSIDL_ALTSTARTUP),
    (Name: 'Application Data'; ID: CSIDL_APPDATA),
    (Name: 'Recycle Bin'; ID: CSIDL_BITBUCKET),
    (Name: 'Common Alt Startup'; ID: CSIDL_COMMON_ALTSTARTUP),
    (Name: 'Common Desktop'; ID: CSIDL_COMMON_DESKTOPDIRECTORY),
    (Name: 'Common Favorites'; ID: CSIDL_COMMON_FAVORITES),
    (Name: 'Common Programs'; ID: CSIDL_COMMON_PROGRAMS),
    (Name: 'Common Start Menu'; ID: CSIDL_COMMON_STARTMENU),
    (Name: 'Common Startup'; ID: CSIDL_COMMON_STARTUP),
    (Name: 'Controls'; ID: CSIDL_CONTROLS),
    (Name: 'Cookies'; ID: CSIDL_COOKIES),
    (Name: 'Desktop'; ID: CSIDL_DESKTOP),
    (Name: 'Desktop Directory'; ID: CSIDL_DESKTOPDIRECTORY),
    (Name: 'Drives'; ID: CSIDL_DRIVES),
    (Name: 'Favorites'; ID: CSIDL_FAVORITES),
    (Name: 'Fonts'; ID: CSIDL_FONTS),
    (Name: 'History'; ID: CSIDL_HISTORY),
    (Name: 'Internet'; ID: CSIDL_INTERNET),
    (Name: 'Internet Cache'; ID: CSIDL_INTERNET_CACHE),
    (Name: 'Network Neighborhood'; ID: CSIDL_NETHOOD),
    (Name: 'Network Top'; ID: CSIDL_NETWORK),
    (Name: 'Personal'; ID: CSIDL_PERSONAL),
    (Name: 'Printers'; ID: CSIDL_PRINTERS),
    (Name: 'Printer Links'; ID: CSIDL_PRINTHOOD),
    (Name: 'Programs'; ID: CSIDL_PROGRAMS),
    (Name: 'Recent Documents'; ID: CSIDL_RECENT),
    (Name: 'Send To'; ID: CSIDL_SENDTO),
    (Name: 'Start Menu'; ID: CSIDL_STARTMENU),
    (Name: 'Startup'; ID: CSIDL_STARTUP),
    (Name: 'Templates'; ID: CSIDL_TEMPLATES));

  {SHObjectProperties Flags}
  OPF_PRINTERNAME = $01;
  OPF_PATHNAME = $02;

type
  TOpenFileNameEx = packed record
    lStructSize: DWORD; // Size of the structure in bytes.
    hWndOwner: HWND; // Handle that is the parent of the dialog.
    hInstance: HINST; // Application instance handle.
    lpstrFilter: PAnsiChar; // String containing filter information.
    lpstrCustomFilter: PAnsiChar; // Will hold the filter chosen by the user.
    nMaxCustFilter: DWORD; // Size of lpstrCustomFilter, in bytes.
    nFilterIndex: DWORD; // Index of the filter to be shown.
    lpstrFile: PAnsiChar; // File name to start with (and retrieve).
    nMaxFile: DWORD; // Size of lpstrFile, in bytes.
    lpstrFileTitle: PAnsiChar; // File name without path will be returned.
    nMaxFileTitle: DWORD; // Size of lpstrFileTitle, in bytes.
    lpstrInitialDir: PAnsiChar; // Starting directory.
    lpstrTitle: PAnsiChar; // Title of the open dialog.
    Flags: DWORD; // Controls user selection Options.
    nFileOffset: Word; // Offset of file name in filepath=lpstrFile.
    nFileExtension: Word; // Offset of extension in filepath=lpstrFile.
    lpstrDefExt: PAnsiChar; // Default extension if no extension typed.
    lCustData: LPARAM; // Custom data to be passed to hook.
    lpfnHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM;
      lParam: LPARAM): UINT stdcall; // Hook.
    lpTemplateName: PAnsiChar; // Template dialog, if applicable.
    // Extended structure starts here.
    pvReserved: Pointer; // Reserved, use nil.
    dwReserved: DWORD; // Reserved, use 0.
    FlagsEx: DWORD; // Extended Flags.
  end;

  TShellObjectType = (sdPathObject, sdPrinterObject);
  TShellObjectTypes = set of TShellObjectType;

  TJvFormatDriveKind = (ftQuick, ftStandard, ftBootable);
  TJvDriveCapacity = (dcDefault, dcSize360kB, dcSize720kB);
  TJvFormatDriveError = (errParams, errSysError, errAborted, errCannotFormat, errOther);
  TJvFormatDriveErrorEvent = procedure(Sender: TObject; Error: TJvFormatDriveError) of object;

  TJvFormatDriveDialog = class(TJvCommonDialogF)
  private
    FDrive: Char;
    FFormatType: TJvFormatDriveKind;
    FCapacity: TJvDriveCapacity;
    FHandle: HWND;
    FOnError: TJvFormatDriveErrorEvent;
    procedure SetDrive(Value: Char);
  protected
    procedure DoError(ErrValue: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  published
    property Drive: Char read FDrive write SetDrive default 'A';
    property FormatType: TJvFormatDriveKind read FFormatType write FFormatType;
    property Capacity: TJvDriveCapacity read FCapacity write FCapacity;
    property OnError: TJvFormatDriveErrorEvent read FOnError write FOnError;
  end;

  TJvOrganizeFavoritesDialog = class(TJvCommonDialog)
  public
    function Execute: Boolean; override;
  end;

  TJvCplInfo = record
    Icon: TIcon;
    Name: string;
    Info: string;
    lData: Longint;
  end;

  // the signature of procedures in CPL's that implements Control Panel functionality
  TCplApplet = function(hwndCPl: HWND; uMsg: DWORD; lParam1, lParam2: Longint): Longint; stdcall;

  {$IFDEF VCL}
  // (rom) largely reimplemented
  TJvAppletDialog = class(TJvCommonDialogF)
  private
    FAppletName: string;
    FAppletIndex: Integer;
    FModule: HMODULE;
    FCount: Integer;
    FAppletFunc: TCplApplet;
    FAppletInfo: array of TJvCplInfo;
    function GetAppletInfo(Index: Integer): TJvCplInfo;
    procedure SetAppletName(const AAppletName: string);
    procedure Unload;
    procedure Load;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ValidApplet: Boolean;
    // (p3) NOTE: if AppletName or AppletIndex is invalid, shows the control
    // panel explorer window instead and returns FALSE
    function Execute: Boolean; override;
    property Count: Integer read FCount;
    property AppletInfo[Index: Integer]: TJvCplInfo read GetAppletInfo;
  published
    property AppletName: string read FAppletName write SetAppletName;
    property AppletIndex: Integer read FAppletIndex write FAppletIndex default 0;
  end;
  {$ENDIF VCL}

  TJvComputerNameDialog = class(TJvCommonDialog)
  private
    FComputerName: string;
    FCaption: string;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
    property ComputerName: string read FComputerName;
  published
    property Caption: string read FCaption write FCaption;
  end;

  // (p3) could be removed - a more complete implementation is in JvBrowseFolder
  TJvBrowseFolderDialog = class(TJvCommonDialog)
  private
    FFolderName: string;
    FCaption: string;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
    property FolderName: string read FFolderName;
  published
    property Caption: string read FCaption write FCaption;
  end;

  TJvOutOfMemoryDialog = class(TJvCommonDialog)
  private
    FCaption: string;
  public
    function Execute: Boolean; override;
  published
    property Caption: string read FCaption write FCaption;
  end;

  // (rom) changed to new TJvCommonDialogF to get better Execute
  TJvChangeIconDialog = class(TJvCommonDialogF)
  private
    FIconIndex: Integer;
    FFileName: TFileName;
  public
    function Execute: Boolean; override;
  published
    property IconIndex: Integer read FIconIndex write FIconIndex;
    property FileName: TFileName read FFileName write FFileName;
  end;

  TJvShellAboutDialog = class(TJvCommonDialog)
  private
    FCaption: string;
    FIcon: TIcon;
    FOtherText: string;
    FProduct: string;
    procedure SetIcon(NewValue: TIcon);
    function StoreIcon: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    function Execute: Boolean; override;
  published
    property Caption: string read FCaption write FCaption;
    property Icon: TIcon read FIcon write SetIcon stored StoreIcon;
    property OtherText: string read FOtherText write FOtherText;
    property Product: string read FProduct write FProduct;
  end;

  TJvRunDialog = class(TJvCommonDialogP)
  private
    FCaption: string;
    FDescription: string;
    FIcon: TIcon;
    procedure SetIcon(const Value: TIcon);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute; override;
  published
    property Caption: string read FCaption write FCaption;
    property Description: string read FDescription write FDescription;
    property Icon: TIcon read FIcon write SetIcon;
  end;

  TJvObjectPropertiesDialog = class(TJvCommonDialogF)
  private
    FObjectName: TFileName;
    FObjectType: TShellObjectType;
    FInitialTab: string;
  public
    function Execute: Boolean; override;
  published
    property ObjectName: TFileName read FObjectName write FObjectName;
    property ObjectType: TShellObjectType read FObjectType write FObjectType;
    property InitialTab: string read FInitialTab write FInitialTab;
  end;

  TJvNewLinkDialog = class(TJvCommonDialogP)
  private
    FDestinationFolder: string;
  public
    procedure Execute; override;
  published
    property DestinationFolder: string read FDestinationFolder write FDestinationFolder;
  end;

  TJvAddHardwareDialog = class(TJvCommonDialogP)
  public
    procedure Execute; override;
  end;

  TJvOpenWithDialog = class(TJvCommonDialogP)
  private
    FFileName: TFileName;
  public
    procedure Execute; override;
  published
    property FileName: TFileName read FFileName write FFileName;
  end;

  TJvDiskFullDialog = class(TJvCommonDialogF)
  private
    FDriveChar: Char;
    procedure SetDriveChar(Value: Char);
    function GetDrive: UINT;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  published
    property DriveChar: Char read FDriveChar write SetDriveChar default 'C';
  end;

  TJvExitWindowsDialog = class(TJvCommonDialogP)
  public
    procedure Execute; override;
  end;

  {$IFDEF VCL}

  // (p3) this extension (PlacesBar) is already in TJvOpenDialog
  TJvOpenDialog2000 = class(TOpenDialog)
  public
    function Execute: Boolean; override;
  end;

  // (p3) this extension (PlacesBar) is already in TJvSaveDialog
  TJvSaveDialog2000 = class(TSaveDialog)
  public
    function Execute: Boolean; override;
  end;

  {$ENDIF VCL}

  TJvURLAssociationDialogOption = (uaDefaultName, uaRegisterAssoc);
  TJvURLAssociationDialogOptions = set of TJvURLAssociationDialogOption;

  TJvURLAssociationDialog = class(TJvCommonDialogF)
  private
    FURL: string;
    FAssociatedApp: string;
    FFileName: TFileName;
    FOptions: TJvURLAssociationDialogOptions;
    FDefaultProtocol: string;
    FReturnValue: HRESULT;
    function GetParentHandle: THandle;
  public
    // Returns false if user cancelled or if the user
    // elected not to register the association. To find out if the user made
    // a one-time choice, check the AssociatedApp property: if it is empty,
    // the user cancelled
    function Execute: Boolean; override;
    constructor Create(AOwner: TComponent); override;
    // After Execute, contains the path and filename to the associated application (if user didn't cancel)
    property AssociatedApp: string read FAssociatedApp;