?? tntdialogs.pas
字號:
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -