tntdialogs.pas

Delphi知道现在也没有提供Unicode支持

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntDialogs;

{$INCLUDE TntCompilers.inc}

interface

{ TODO: TFindDialog and TReplaceDialog. }
{ TODO: Property editor for TTntOpenDialog.Filter }

uses
  Classes, Messages, CommDlg, Windows, Dialogs,
  TntClasses, TntForms, TntSysUtils;

type
{TNT-WARN TIncludeItemEvent}
  TIncludeItemEventW = procedure (const OFN: TOFNotifyExW; var Include: Boolean) of object;

{TNT-WARN TOpenDialog}
  TTntOpenDialog = class(TOpenDialog{TNT-ALLOW TOpenDialog})
  private
    FDefaultExt: WideString;
    FFileName: TWideFileName;
    FFilter: WideString;
    FInitialDir: WideString;
    FTitle: WideString;
    FFiles: TTntStrings;
    FOnIncludeItem: TIncludeItemEventW;
    function GetDefaultExt: WideString;
    procedure SetInheritedDefaultExt(const Value: AnsiString);
    procedure SetDefaultExt(const Value: WideString);
    function GetFileName: TWideFileName;
    procedure SetFileName(const Value: TWideFileName);
    function GetFilter: WideString;
    procedure SetInheritedFilter(const Value: AnsiString);
    procedure SetFilter(const Value: WideString);
    function GetInitialDir: WideString;
    procedure SetInheritedInitialDir(const Value: AnsiString);
    procedure SetInitialDir(const Value: WideString);
    function GetTitle: WideString;
    procedure SetInheritedTitle(const Value: AnsiString);
    procedure SetTitle(const Value: WideString);
    function GetFiles: TTntStrings;
  private
    FProxiedOpenFilenameA: TOpenFilenameA;
  protected
    FAllowDoCanClose: Boolean;
    procedure DefineProperties(Filer: TFiler); override;
    function CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
    function DoCanClose: Boolean; override;
    procedure GetFileNamesW(var OpenFileName: TOpenFileNameW);
    procedure DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean); override;
    procedure WndProc(var Message: TMessage); override;
    function DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool; overload;
    function DoExecuteW(Func: Pointer): Bool; overload;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;
    {$IFDEF COMPILER_9_UP}
    function Execute(ParentWnd: HWND): Boolean; override;
    {$ENDIF}
    property Files: TTntStrings read GetFiles;
  published
    property DefaultExt: WideString read GetDefaultExt write SetDefaultExt;
    property FileName: TWideFileName read GetFileName write SetFileName;
    property Filter: WideString read GetFilter write SetFilter;
    property InitialDir: WideString read GetInitialDir write SetInitialDir;
    property Title: WideString read GetTitle write SetTitle;
    property OnIncludeItem: TIncludeItemEventW read FOnIncludeItem write FOnIncludeItem;
  end;

{TNT-WARN TSaveDialog}
  TTntSaveDialog = class(TTntOpenDialog)
  public
    function Execute: Boolean; override;
    {$IFDEF COMPILER_9_UP}
    function Execute(ParentWnd: HWND): Boolean; override;
    {$ENDIF}
  end;

{ Message dialog }

{TNT-WARN CreateMessageDialog}
function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): TTntForm;overload;
function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm; overload;

{TNT-WARN MessageDlg}
function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;

{TNT-WARN MessageDlgPos}
function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload;
function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer; overload;

{TNT-WARN MessageDlgPosHelp}
function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: WideString): Integer; overload;
function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer; overload;

{TNT-WARN ShowMessage}
procedure WideShowMessage(const Msg: WideString);
{TNT-WARN ShowMessageFmt}
procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
{TNT-WARN ShowMessagePos}
procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);

{ Input dialog }

{TNT-WARN InputQuery}
function WideInputQuery(const ACaption, APrompt: WideString;
   var Value: WideString): Boolean;
{TNT-WARN InputBox}
function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;

{TNT-WARN PromptForFileName}
function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
  const ADefaultExt: WideString = ''; const ATitle: WideString = '';
  const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;

function GetModalParentWnd: HWND;

implementation

uses
  Controls, Forms, Types, SysUtils, Graphics, Consts, Math,
  TntWindows, TntStdCtrls, TntClipBrd, TntExtCtrls,
  {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;

function GetModalParentWnd: HWND;
begin
  {$IFDEF COMPILER_9}
  Result := Application.ActiveFormHandle;
  {$ELSE}
  Result := 0;
  {$ENDIF}
  {$IFDEF COMPILER_10_UP}
  if Application.ModalPopupMode <> pmNone then
  begin
    Result := Application.ActiveFormHandle;
  end;
  {$ENDIF}
  if Result = 0 then begin
    Result := Application.Handle;
  end;
end;

var
  ProxyExecuteDialog: TTntOpenDialog;

function ProxyGetOpenFileNameA(var OpenFile: TOpenFilename): Bool; stdcall;
begin
  ProxyExecuteDialog.FProxiedOpenFilenameA := OpenFile;
  Result := False; { as if user hit "Cancel". }
end;

{ TTntOpenDialog }

constructor TTntOpenDialog.Create(AOwner: TComponent);
begin
  inherited;
  FFiles := TTntStringList.Create;
end;

destructor TTntOpenDialog.Destroy;
begin
  FreeAndNil(FFiles);
  inherited;
end;

procedure TTntOpenDialog.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntOpenDialog.GetDefaultExt: WideString;
begin
  Result := GetSyncedWideString(FDefaultExt, inherited DefaultExt);
end;

procedure TTntOpenDialog.SetInheritedDefaultExt(const Value: AnsiString);
begin
  inherited DefaultExt := Value;
end;

procedure TTntOpenDialog.SetDefaultExt(const Value: WideString);
begin
  SetSyncedWideString(Value, FDefaultExt, inherited DefaultExt, SetInheritedDefaultExt);
end;

function TTntOpenDialog.GetFileName: TWideFileName;
var
  Path: array[0..MAX_PATH] of WideChar;
begin
  if Win32PlatformIsUnicode and NewStyleControls and (Handle <> 0) then begin
    // get filename from handle
    SendMessageW(GetParent(Handle), CDM_GETFILEPATH, SizeOf(Path), Integer(@Path));
    Result := Path;
  end else
    Result := GetSyncedWideString(WideString(FFileName), inherited FileName);
end;

procedure TTntOpenDialog.SetFileName(const Value: TWideFileName);
begin
  FFileName := Value;
  inherited FileName := Value;
end;

function TTntOpenDialog.GetFilter: WideString;
begin
  Result := GetSyncedWideString(FFilter, inherited Filter);
end;

procedure TTntOpenDialog.SetInheritedFilter(const Value: AnsiString);
begin
  inherited Filter := Value;
end;

procedure TTntOpenDialog.SetFilter(const Value: WideString);
begin
  SetSyncedWideString(Value, FFilter, inherited Filter, SetInheritedFilter);
end;

function TTntOpenDialog.GetInitialDir: WideString;
begin
  Result := GetSyncedWideString(FInitialDir, inherited InitialDir);
end;

procedure TTntOpenDialog.SetInheritedInitialDir(const Value: AnsiString);
begin
  inherited InitialDir := Value;
end;

procedure TTntOpenDialog.SetInitialDir(const Value: WideString);

  function RemoveTrailingPathDelimiter(const Value: WideString): WideString;
  var
    L: Integer;
  begin
    // remove trailing path delimiter (except 'C:\')
    L := Length(Value);
    if (L > 1) and WideIsPathDelimiter(Value, L) and not WideIsDelimiter(':', Value, L - 1) then
      Dec(L);
    Result := Copy(Value, 1, L);
  end;

begin
  SetSyncedWideString(RemoveTrailingPathDelimiter(Value), FInitialDir,
    inherited InitialDir, SetInheritedInitialDir);
end;

function TTntOpenDialog.GetTitle: WideString;
begin
  Result := GetSyncedWideString(FTitle, inherited Title)
end;

procedure TTntOpenDialog.SetInheritedTitle(const Value: AnsiString);
begin
  inherited Title := Value;
end;

procedure TTntOpenDialog.SetTitle(const Value: WideString);
begin
  SetSyncedWideString(Value, FTitle, inherited Title, SetInheritedTitle);
end;

function TTntOpenDialog.GetFiles: TTntStrings;
begin
  if (not Win32PlatformIsUnicode) then
    FFiles.Assign(inherited Files);
  Result := FFiles;
end;

function TTntOpenDialog.DoCanClose: Boolean;
begin
  if FAllowDoCanClose then
    Result := inherited DoCanClose
  else
    Result := True;
end;

function TTntOpenDialog.CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
begin
  GetFileNamesW(OpenFileName);
  FAllowDoCanClose := True;
  try
    Result := DoCanClose;
  finally
    FAllowDoCanClose := False;
  end;
  FFiles.Clear;
  inherited Files.Clear;
end;

procedure TTntOpenDialog.DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean);
begin
  // CDN_INCLUDEITEM -> DoIncludeItem() is only be available on Windows 2000 +
  // Therefore, just cast OFN as a TOFNotifyExW, since that's what it really is.
  if Win32PlatformIsUnicode and Assigned(FOnIncludeItem) then
    FOnIncludeItem(TOFNotifyExW(OFN), Include)
end;

procedure TTntOpenDialog.WndProc(var Message: TMessage);
begin
  Message.Result := 0;
  if (Message.Msg = WM_INITDIALOG) and not (ofOldStyleDialog in Options) then begin
    { If not ofOldStyleDialog then DoShow on CDN_INITDONE, not WM_INITDIALOG }
    Exit;