tntdialogs.pas

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

  end;
  if Win32PlatformIsUnicode
  and (Message.Msg = WM_NOTIFY) then begin
    case (POFNotify(Message.LParam)^.hdr.code) of
      CDN_FILEOK:
        if not CanCloseW(POFNotifyW(Message.LParam)^.lpOFN^) then
        begin
          Message.Result := 1;
          SetWindowLong(Handle, DWL_MSGRESULT, Message.Result);
          Exit;
        end;
    end;
  end;
  inherited WndProc(Message);
end;

function TTntOpenDialog.DoExecuteW(Func: Pointer): Bool;
begin
  Result := DoExecuteW(Func, GetModalParentWnd);
end;

function TTntOpenDialog.DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool;
var
  OpenFilename: TOpenFilenameW;

  function GetResNamePtr(var ScopedStringStorage: WideString; lpszName: PAnsiChar): PWideChar;
  // duplicated from TntTrxResourceUtils.pas
  begin
    if Tnt_Is_IntResource(PWideChar(lpszName)) then
      Result := PWideChar(lpszName)
    else begin
      ScopedStringStorage := lpszName;
      Result := PWideChar(ScopedStringStorage);
    end;
  end;

  function AllocFilterStr(const S: WideString): WideString;
  var
    P: PWideChar;
  begin
    Result := '';
    if S <> '' then
    begin
      Result := S + #0#0;  // double null terminators (an additional zero added in case Description/Filter pair not even.)
      P := WStrScan(PWideChar(Result), '|');
      while P <> nil do
      begin
        P^ := #0;
        Inc(P);
        P := WStrScan(P, '|');
      end;
    end;
  end;

var
  TempTemplate, TempFilter, TempFilename, TempExt: WideString;
begin
  FFiles.Clear;

  // 1. Init inherited dialog defaults.
  // 2. Populate OpenFileName record with ansi defaults
  ProxyExecuteDialog := Self;
  try
    DoExecute(@ProxyGetOpenFileNameA);
  finally
    ProxyExecuteDialog := nil;
  end;
  OpenFileName := TOpenFilenameW(FProxiedOpenFilenameA);

  with OpenFilename do
  begin
    if not IsWindow(hWndOwner) then begin
      hWndOwner := ParentWnd;
    end;
    // Filter (PChar -> PWideChar)
    TempFilter := AllocFilterStr(Filter);
    lpstrFilter := PWideChar(TempFilter);
    // FileName (PChar -> PWideChar)
    SetLength(TempFilename, nMaxFile + 2);
    lpstrFile := PWideChar(TempFilename);
    FillChar(lpstrFile^, (nMaxFile + 2) * SizeOf(WideChar), 0);
    WStrLCopy(lpstrFile, PWideChar(FileName), nMaxFile);
    // InitialDir (PChar -> PWideChar)
    if (InitialDir = '') and ForceCurrentDirectory then
      lpstrInitialDir := '.'
    else
      lpstrInitialDir := PWideChar(InitialDir);
    // Title (PChar -> PWideChar)
    lpstrTitle := PWideChar(Title);
    // DefaultExt (PChar -> PWideChar)
    TempExt := DefaultExt;
    if (TempExt = '') and (Flags and OFN_EXPLORER = 0) then
    begin
      TempExt := WideExtractFileExt(Filename);
      Delete(TempExt, 1, 1);
    end;
    if TempExt <> '' then
      lpstrDefExt := PWideChar(TempExt);
    // resource template (PChar -> PWideChar)
    lpTemplateName := GetResNamePtr(TempTemplate, Template);
    // start modal dialog
    Result := TaskModalDialog(Func, OpenFileName);
    if Result then
    begin
      GetFileNamesW(OpenFilename);
      if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
        Options := Options + [ofExtensionDifferent]
      else
        Options := Options - [ofExtensionDifferent];
      if (Flags and OFN_READONLY) <> 0 then
        Options := Options + [ofReadOnly]
      else
        Options := Options - [ofReadOnly];
      FilterIndex := nFilterIndex;
    end;
  end;
end;

procedure TTntOpenDialog.GetFileNamesW(var OpenFileName: TOpenFileNameW);
var
  Separator: WideChar;

  procedure ExtractFileNamesW(P: PWideChar);
  var
    DirName, FileName: TWideFileName;
    FileList: TWideStringDynArray;
    i: integer;
  begin
    FileList := ExtractStringsFromStringArray(P, Separator);
    if Length(FileList) = 0 then 
      FFiles.Add('')
    else begin
      DirName := FileList[0];
      if Length(FileList) = 1 then
        FFiles.Add(DirName)
      else begin
        // prepare DirName
        if WideLastChar(DirName) <> WideString(PathDelim) then
          DirName := DirName + PathDelim;
        // add files
        for i := 1 {second item} to High(FileList) do begin
          FileName := FileList[i];
          // prepare FileName
          if (FileName[1] <> PathDelim)
          and ((Length(FileName) <= 3) or (FileName[2] <> DriveDelim) or (FileName[3] <> PathDelim))
          then
            FileName := DirName + FileName;
          // add to list
          FFiles.Add(FileName);
        end;
      end;
    end;
  end;

var
  P: PWideChar;
begin
  Separator := #0;
  if (ofAllowMultiSelect in Options) and
    ((ofOldStyleDialog in Options) or not NewStyleControls) then
    Separator := ' ';
  with OpenFileName do
  begin
    if ofAllowMultiSelect in Options then
    begin
      ExtractFileNamesW(lpstrFile);
      FileName := FFiles[0];
    end else
    begin
      P := lpstrFile;
      FileName := ExtractStringFromStringArray(P, Separator);
      FFiles.Add(FileName);
    end;
  end;

  // Sync inherited Files
  inherited Files.Assign(FFiles);
end;

function TTntOpenDialog.Execute: Boolean;
begin
  if (not Win32PlatformIsUnicode) then
    Result := DoExecute(@GetOpenFileNameA)
  else
    Result := DoExecuteW(@GetOpenFileNameW);
end;

{$IFDEF COMPILER_9_UP}
function TTntOpenDialog.Execute(ParentWnd: HWND): Boolean;
begin
  if (not Win32PlatformIsUnicode) then
    Result := DoExecute(@GetOpenFileNameA, ParentWnd)
  else
    Result := DoExecuteW(@GetOpenFileNameW, ParentWnd);
end;
{$ENDIF}

{ TTntSaveDialog }

function TTntSaveDialog.Execute: Boolean;
begin
  if (not Win32PlatformIsUnicode) then
    Result := DoExecute(@GetSaveFileNameA)
  else
    Result := DoExecuteW(@GetSaveFileNameW);
end;

{$IFDEF COMPILER_9_UP}
function TTntSaveDialog.Execute(ParentWnd: HWND): Boolean;
begin
  if (not Win32PlatformIsUnicode) then
    Result := DoExecute(@GetSaveFileNameA, ParentWnd)
  else
    Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
end;
{$ENDIF}

{ Message dialog }

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of WideChar;
  tm: TTextMetric;
begin
  for I := 0 to 25 do Buffer[I] := WideChar(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := WideChar(I + Ord('a'));
  GetTextMetrics(Canvas.Handle, tm);
  GetTextExtentPointW(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := (Result.X div 26 + 1) div 2;
  Result.Y := tm.tmHeight;
end;

type
  TTntMessageForm = class(TTntForm)
  private
    Message: TTntLabel;
    procedure HelpButtonClick(Sender: TObject);
  protected
    procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    function GetFormText: WideString;
  public
    constructor CreateNew(AOwner: TComponent); reintroduce;
  end;

constructor TTntMessageForm.CreateNew(AOwner: TComponent);
var
  NonClientMetrics: TNonClientMetrics;
begin
  inherited CreateNew(AOwner);
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
end;

procedure TTntMessageForm.HelpButtonClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

procedure TTntMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = Word('C')) then
  begin
    Beep;
    TntClipboard.AsWideText := GetFormText;
  end;
end;

function TTntMessageForm.GetFormText: WideString;
var
  DividerLine, ButtonCaptions: WideString;
  I: integer;
begin
  DividerLine := StringOfChar('-', 27) + sLineBreak;
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TTntButton then
      ButtonCaptions := ButtonCaptions + TTntButton(Components[I]).Caption +
        StringOfChar(' ', 3);
  ButtonCaptions := Tnt_WideStringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
  Result := DividerLine + Caption + sLineBreak + DividerLine + Message.Caption + sLineBreak
          + DividerLine + ButtonCaptions + sLineBreak + DividerLine;
end;

function GetMessageCaption(MsgType: TMsgDlgType): WideString;
begin
  case MsgType of
    mtWarning:      Result := SMsgDlgWarning;
    mtError:        Result := SMsgDlgError;
    mtInformation:  Result := SMsgDlgInformation;
    mtConfirmation: Result := SMsgDlgConfirm;
    mtCustom:       Result := '';
    else
      raise ETntInternalError.Create('Unexpected MsgType in GetMessageCaption.');
  end;
end;

function GetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
begin
  case MsgDlgBtn of
    mbYes:         Result := SMsgDlgYes;
    mbNo:          Result := SMsgDlgNo;
    mbOK:          Result := SMsgDlgOK;
    mbCancel:      Result := SMsgDlgCancel;
    mbAbort:       Result := SMsgDlgAbort;
    mbRetry:       Result := SMsgDlgRetry;
    mbIgnore:      Result := SMsgDlgIgnore;
    mbAll:         Result := SMsgDlgAll;
    mbNoToAll:     Result := SMsgDlgNoToAll;
    mbYesToAll:    Result := SMsgDlgYesToAll;
    mbHelp:        Result := SMsgDlgHelp;
    else
      raise ETntInternalError.Create('Unexpected MsgDlgBtn in GetButtonCaption.');
  end;
end;

var
  IconIDs: array[TMsgDlgType] of PAnsiChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
  ButtonNames: array[TMsgDlgBtn] of WideString = (
    'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
    'YesToAll', 'Help');
  ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);

function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm;