diff --git a/lcl/dialogs.pp b/lcl/dialogs.pp index 243866d76f..78a6c40765 100644 --- a/lcl/dialogs.pp +++ b/lcl/dialogs.pp @@ -629,6 +629,7 @@ type FFooterText: TTranslateString; FMainIcon: TTaskDialogIcon; FModalResult: TModalResult; + FParentWindow: HWND; FRadioButton: TTaskDialogRadioButtonItem; FRadioButtons: TTaskDialogButtons; FText: TTranslateString; @@ -645,10 +646,11 @@ type function DoExecute(ParentWnd: HWND): Boolean; dynamic; procedure DoOnButtonClicked(AModalResult: Integer; var ACanClose: Boolean); dynamic; public - FWidth: Integer; //ToDo: make this a readonly property, so we can use it in the TaskDlgEmulation unit. + property ParentWindow: HWND read FParentWindow; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Execute: Boolean; overload; dynamic; diff --git a/lcl/include/taskdialog.inc b/lcl/include/taskdialog.inc index 4eb66d070f..81b447d1b2 100644 --- a/lcl/include/taskdialog.inc +++ b/lcl/include/taskdialog.inc @@ -228,6 +228,7 @@ const begin //Current goal of refactoring: replace all this with: //Result := TWSTaskDialogClass(WidgetSetClass).Execute(Self); + FParentWindow := ParentWnd; FillChar(TaskDlg, SizeOf(LCLTaskDialog.TTaskDialog), 0); diff --git a/lcl/taskdlgemulation.pp b/lcl/taskdlgemulation.pp index e6af368573..59a1cf8835 100644 --- a/lcl/taskdlgemulation.pp +++ b/lcl/taskdlgemulation.pp @@ -24,6 +24,11 @@ type private /// the Task Dialog structure which created the form FDlg: TTaskDialog; + FRadioRes: Integer; + FVerifyCheck: Boolean; + FVerifyChecked: Boolean; + Rad: array of TRadioButton; + protected procedure HandleEmulatedButtonClicked(Sender: TObject); procedure SetupControls; @@ -42,6 +47,9 @@ type Edit: TEdit; /// the Task Dialog optional checkbox Verif: TCheckBox; + + property VerifyChecked: Boolean read FVerifyCheck write FVerifyChecked; + property RadioRes: Integer read FRadioRes; end; @@ -84,12 +92,57 @@ end; type TLCLTaskDialogIcon = ( tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield); + TLCLTaskDialogFooterIcon = ( + tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield); const LCL_IMAGES: array[TLCLTaskDialogIcon] of Integer = ( 0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, 0, idDialogShield); + LCL_FOOTERIMAGES: array[TLCLTaskDialogFooterIcon] of Integer = ( + 0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, idDialogShield); + +const + FirstButtonIndex = 100; + FirstRadioButtonIndex = 200; + TD_BTNMOD: array[TTaskDialogCommonButton] of Integer = ( + mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort); +type + /// internal type used for Unicode string storage + WS = WideString; + +function _WS(const aString: string): WS; +begin + Result := UTF8Decode(aString); +end; + +function CR(const aText: string): string; +begin + if pos('\n', aText) = 0 then + result := aText else + result := StringReplace(aText, '\n', #10, [rfReplaceAll]); +end; + + +function TD_BTNS(button: TTaskDialogCommonButton): pointer; +begin + case button of + tcbOK: result := @rsMbOK; + tcbYes: result := @rsMbYes; + tcbNo: result := @rsMbNo; + tcbCancel: result := @rsMbCancel; + tcbRetry: result := @rsMbRetry; + tcbClose: result := @rsMbClose; + end; +end; + + + + + + +{ -------------- } function ExecuteLCLTaskDialog(const ADlg: TTaskDialog): Boolean; var DlgForm: TLCLTaskDialog; @@ -107,17 +160,55 @@ end; constructor TLCLTaskDialog.CreateNew(AOwner: TComponent; Num: Integer); begin inherited CreateNew(AOwner, Num); - + Rad := nil; KeyPreview := True; end; function TLCLTaskDialog.Execute: Boolean; var - mRes: Integer; + mRes, I: Integer; + aParent: HWND; begin SetupControls; + + aParent := FDlg.ParentWindow; + //set form parent + if (aParent <> 0) then + for I := 0 to Screen.CustomFormCount-1 do + if Screen.CustomForms[I].Handle = aParent then + begin + PopupParent := Screen.CustomForms[I]; + Break; + end; + if not Assigned(PopupParent) then + PopupParent := Screen.ActiveCustomForm; + if Assigned(PopupParent) then + PopupMode := pmExplicit; + + + mRes := ShowModal; Result := (mRes > 0); + +//ToDo implement this +(* + if Combo<>nil then begin + SelectionRes := Combo.ItemIndex; + Query := Dialog.Form.Combo.Text; + end + else + if Dialog.Form.Edit<>nil then + Query := Dialog.Form.Edit.Text; + +*) + + if Verif<>nil then + FVerifyChecked := Verif.Checked; + FRadioRes := 0; + for i := 0 to high(Rad) do + if Rad[i].Checked then + FRadioRes := i+FirstRadioButtonIndex; + end; procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject); @@ -162,6 +253,19 @@ begin end; end; +function TF_FOOTERICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogFooterIcon; +begin + case aIcon of + tdiWarning: Result := tfiWarning; + tdiError: Result := tfiError; + tdiInformation: Result := tfiInformation; + tdiShield: Result := tfiShield; + tdiQuestion: Result := tfiQuestion; + else + Result := tfiBlank; + end; +end; + function IconMessage(Icon: TLCLTaskDialogIcon): string; begin @@ -179,29 +283,130 @@ end; procedure TLCLTaskDialog.SetupControls; var //TaskDlg: LCLTaskDialog.TTaskDialog; - DefRB, aButtonDef: TModalResult; + aRadioDef, aButtonDef: TModalResult; B: TTaskDialogBaseButtonItem; ButtonID: Integer; - Buttons, TaskDlgRadios, Title, Inst, Content, - TaskDlgInfoCollapse, TaskDlgInfo, TaskDlgFooter, - TaskDlgVerify: TTranslateString; - ARadioOffset, FontHeight, aWidth, IconBorder, X, Y: integer; + Buttons, Radios, Title, Inst, Content, + TaskDlgInfoCollapse, Info, Footer, + Verify, Selection: TTranslateString; + ARadioOffset, FontHeight, aWidth, IconBorder, X, Y, i, XB: integer; aCommonButtons: TTaskDialogCommonButtons; Panel: TPanel; Par: TWinControl; aDialogIcon: TLCLTaskDialogIcon; Image: TImage; -const - FirstButtonIndex = 100; - FirstRadioButtonIndex = 200; - TD_BTNMOD: array[TTaskDialogCommonButton] of Integer = ( - mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort); + CommandLink: TBitBtn; + aHint: String; + List: TStringListUTF8Fast; + CurrTabOrder: TTabOrder; + Btn: TTaskDialogCommonButton; + + + function AddLabel(Text: string; BigFont: boolean): TLabel; + var R: TRect; + W: integer; + begin + if Text = '' then + exit(nil); + + result := TLabel.Create(Self); + result.Parent := Par; + result.WordWrap := true; + if BigFont then + begin + if (tfEmulateClassicStyle in FDlg.Flags) then + begin + result.Font.Height := FontHeight-2; + result.Font.Style := [fsBold] + end + else + begin + result.Font.Height := FontHeight-4; + result.Font.Color := clHighlight; + end; + end + else + result.Font.Height := FontHeight; + result.AutoSize := false; + R.Left := 0; + R.Top := 0; + W := aWidth-X-8; + R.Right := W; + R.Bottom := result.Height; + LCLIntf.DrawText(result.Canvas.Handle,PChar(Text),Length(Text),R,DT_CALCRECT or DT_WORDBREAK);//lazarus does not return box height on OSX (Lazarus bug), the height is stored in the rect in all cases, so we don't need to use the result + + result.SetBounds(X,Y,W,R.Bottom); + result.Caption := Text; + inc(Y,R.Bottom+16); + end; + + + function NoCR(const aText: string): string; + var i: integer; + begin + result := aText; + aHint := ''; + i := pos('\n',result); + if i>0 then begin + aHint := CR(copy(result,i+2,maxInt)); + SetLength(result,i-1); + end; + end; + + function AddButton(const s: string; ModalResult: integer): TButton; + var + WB: integer; + begin + WB := Canvas.TextWidth(s)+52; + dec(XB,WB); + if XBnil) and (Y nil then - DefRB := FDlg.RadioButtons.DefaultButton.Index + aRadioDef := FDlg.RadioButtons.DefaultButton.Index else - DefRB := 0; + aRadioDef := 0; if FDlg.Buttons.DefaultButton<>nil then aButtonDef := FDlg.Buttons.DefaultButton.ModalResult else @@ -210,17 +415,22 @@ begin Buttons := ''; for B in FDlg.Buttons do Buttons := Buttons + B.Caption + #10; - TaskDlgRadios := ''; + Radios := ''; for B in FDlg.RadioButtons do - TaskDlgRadios := TaskDlgRadios + B.Caption + #10; + Radios := Radios + B.Caption + #10; + + //ToDo + //This field/parameter is currently not used in Dialogs.TTaskDialog and not passed so we cannot initialize it properly yet + Selection := ''; Title := FDlg.Caption; Inst := FDlg.Title; Content := FDlg.Text; TaskDlgInfoCollapse := FDlg.ExpandButtonCaption; - TaskDlgInfo := FDlg.ExpandedText; - TaskDlgFooter := FDlg.FooterText; - TaskDlgVerify := FDlg.VerificationText; + Info := FDlg.ExpandedText; + Footer := FDlg.FooterText; + Verify := FDlg.VerificationText; + FVeriFyChecked := (tfVerificationFlagChecked in FDlg.Flags); aCommonButtons := FDlg.CommonButtons; @@ -319,6 +529,228 @@ begin Y := IconBorder; end; + // add main texts (Instruction, Content, Information) + Element[tdeMainInstruction] := AddLabel(Inst, true); + Element[tdeContent] := AddLabel(Content, false); + if (Info <> '') then + // no information collapse/expand yet: it's always expanded + Element[tdeExpandedInfo] := AddLabel(Info, false); + + + // add radio buttons + if Radios<>'' then + begin + {$IFDEF MSWINDOWS} + if WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_NO then + ARadioOffset := 1 + else + ARadioOffset := 0; + {$ELSE} + ARadioOffset := 1; + {$ENDIF} + with TStringList.Create do + try + Text := SysUtils.trim(Radios); + SetLength(Rad,Count); + for i := 0 to Count-1 do begin + Rad[i] := TRadioButton.Create(Self); + with Rad[i] do begin + Parent := Par; + AutoSize := False; + SetBounds(X+16,Y,aWidth-32-X, (6-FontHeight) + ARadioOffset); + Caption := NoCR(Strings[i]); + if aHint<>'' then begin + ShowHint := true; + Hint := aHint; // note shown as Hint + end; + inc(Y,Height + ARadioOffset); + if not (tfNoDefaultRadioButton in FDlg.Flags) and ((i=0) or (i=aRadioDef)) then + Checked := true; + end; + end; + inc(Y,24); + finally + Free; + end; + end; + + + + // add command links buttons + if (tfUseCommandLinks in FDlg.Flags) and (Buttons<>'') then + with TStringList.Create do + try + inc(Y,8); + Text := SysUtils.trim(Buttons); + for i := 0 to Count-1 do begin + CommandLink := TBitBtn.Create(Self); + with CommandLink do begin + Parent := Par; + Font.Height := FontHeight-3; + if (tfEmulateClassicStyle in FDlg.Flags) then + SetBounds(X,Y,aWidth-10-X,40) else + SetBounds(X,Y,aWidth-16-X,40); + Caption := NoCR(Strings[i]); + if aHint<>'' then begin + ShowHint := true; + Hint := aHint; // note shown as Hint + end; + inc(Y,Height+2); + ModalResult := i+FirstButtonIndex; + OnClick := @HandleEmulatedButtonClicked; + if ModalResult=aButtonDef then + ActiveControl := CommandLink; + if (tfEmulateClassicStyle in FDlg.Flags) then begin + Font.Height := FontHeight - 2; + Font.Style := [fsBold] + end; + if (tfEmulateClassicStyle in FDlg.Flags) then begin + Margin := 7; + Spacing := 7; + end else begin + Margin := 24; + Spacing := 10; + end; + if not (tfUseCommandLinksNoIcon in FDlg.Flags) then + begin + Images := LCLGlyphs; + ImageIndex := LCLGlyphs.GetImageIndex('btn_arrowright'); + end; + end; + end; + inc(Y,24); + finally + Free; + end; + + +(* + + This needs expanding of TTaskDialogFlags and a new field Content in TTaskDialog. + Basically this code was never excuted from Dialogs.TTaskDialog + + // add selection list or query editor + if (Selection <> '') then + begin + List := TStringListUTF8Fast.Create; + try + Combo := TComboBox.Create(self); + with Combo do begin + Parent := Par; + SetBounds(X,Y,aWidth-32-X,22); + if (tfQuery in FDlg.Flags) then + Style := csDropDown + else + Style := csDropDownList; + List.Text := trim(Selection); + Items.Assign(List); + ItemIndex := List.IndexOf(Query); + if (ItemIndex=-1) and (Style=csDropDown) then + Text := Query; + if tdfQueryFieldFocused in aFlags then + Dialog.Form.ActiveControl := Dialog.Form.Combo; + end; + inc(Y,42); + finally + List.Free; + end; + end + else + if tfQuery in aFlags then + begin + Dialog.Form.Edit := TEdit.Create(Dialog.Form); + with Dialog.Form.Edit do + begin + Parent := Par; + SetBounds(X,Y,aWidth-16-X,22); + Text := Query; + if tdfQueryMasked in aFlags then + PasswordChar := '*'; + end; + if tdfQueryFieldFocused in aFlags then + ActiveControl := Form.Edit; + inc(Y,42); + end; + +*) + + + // from now we won't add components to the white panel, but to the form + Panel.Height := Y; + Par := Self; + + + + // add buttons and verification checkbox + if (aCommonButtons=[]) or (Verify<>'') or + ((Buttons<>'') and not (tfUseCommandLinks in FDlg.Flags)) then + begin + CurrTabOrder := Panel.TabOrder; + inc(Y, 16); + XB := aWidth; + if not (tfUseCommandLinks in FDlg.Flags) then + with TStringList.Create do + try + Text := SysUtils.trim(Buttons); + for i := Count-1 downto 0 do + AddButton(Strings[i],i+FirstButtonIndex); + finally + Free; + end; + for Btn := high(TTaskDialogCommonButton) downto low(TTaskDialogCommonButton) do + if (Btn in aCommonButtons) then + AddButton(TD_Trans(LoadResString(TD_BTNS(Btn))), TD_BTNMOD[Btn]); + if Verify<>'' then + begin + Verif := TCheckBox.Create(Self); + with Verif do + begin + Parent := Par; + if X+16+Canvas.TextWidth(Verify)>XB then begin + inc(Y,32); + XB := aWidth; + end; + SetBounds(X,Y,XB-X,24); + Caption := Verify; + Checked := FVerifyChecked; + end; + end; + inc(Y,36); + end + else + XB := 0; + + + + // add footer text with optional icon + if (Footer <> '') then + begin + if XB<>0 then + AddBevel + else + inc(Y,16); + if (LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]<>0) then + begin + Image := TImage.Create(Self); + Image.Parent := Par; + Image.Images := DialogGlyphs; + Image.ImageWidth := 16; + Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]]; + Image.Stretch := True; + Image.StretchOutEnabled := False; + Image.Proportional := True; + Image.Center := True; + Image.SetBounds(24,Y,16,16); + X := 40+Image.Width; + end else + begin + X := 24; + end; + Element[tdeFooter] := AddLabel(Footer, false); + end; + + + ClientHeight := Y; end;