1{%MainUnit ../dialogs.pp} 2 3{****************************************************************************** 4 TCommonDialog 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14{------------------------------------------------------------------------------ 15 Method: TCommonDialog.Create 16 Params: AOwner: the owner of the class 17 Returns: Nothing 18 19 Constructor for the class. 20 ------------------------------------------------------------------------------} 21constructor TCommonDialog.Create (TheOwner: TComponent); 22begin 23 inherited Create(TheOwner); 24 FTitle := DefaultTitle; 25end; 26 27function TCommonDialog.Execute: boolean; 28var 29 DisabledList: TList; 30 SavedFocusState: TFocusState; 31begin 32 SavedFocusState := SaveFocusState; 33 Application.ModalStarted; 34 try 35 DisabledList := Screen.DisableForms(Screen.ActiveForm); 36 try 37 FUserChoice := mrNone; 38 ResetShowCloseFlags; 39 FWSEventCapabilities := TWSCommonDialogClass(WidgetSetClass).QueryWSEventCapabilities(Self); 40 Handle := TWSCommonDialogClass(WidgetSetClass).CreateHandle(Self); 41 Result:= DoExecute; 42 Close; 43 finally 44 Screen.EnableForms(DisabledList); 45 RestoreFocusState(SavedFocusState); 46 if (Screen.ActiveControl<>nil) and (Screen.ActiveControl.HandleAllocated) 47 and (GetFocus<>Screen.ActiveControl.Handle) then 48 SetFocus(Screen.ActiveControl.Handle); // must restore focus after Screen.EnableForms 49 end; 50 finally 51 Application.ModalFinished; 52 end; 53end; 54 55procedure TCommonDialog.Close; 56begin 57 if HandleAllocated and not FClosing then begin 58 FClosing := true; 59 if (not FDoCloseCalled) and (not (cdecWSPerformsDoClose in FWSEventCapabilities)) then 60 DoClose; 61 TWSCommonDialogClass(WidgetSetClass).DestroyHandle(Self); 62 FHandle := 0; 63 FClosing := false; 64 end; 65end; 66 67procedure TCommonDialog.DoShow; 68begin 69 if FDoShowCalled then Exit; 70 FDoShowCalled := True; 71 if Assigned(FOnShow) then FOnShow(Self); 72end; 73 74procedure TCommonDialog.DoCanClose(var CanClose: Boolean); 75begin 76 FDoCanCloseCalled := True; 77 if Assigned(FOnCanClose) and (not (cdecWSNOCanCloseSupport in FWSEventCapabilities)) then 78 OnCanClose(Self, CanClose); 79end; 80 81procedure TCommonDialog.DoClose; 82begin 83 if FDoCloseCalled then Exit; 84 FDoCloseCalled := True; 85 if Assigned(FOnClose) then FOnClose(Self); 86end; 87 88function TCommonDialog.HandleAllocated: boolean; 89begin 90 Result:=FHandle<>0; 91end; 92 93procedure TCommonDialog.SetHandle(const AValue: THandle); 94begin 95 FHandle:=AValue; 96end; 97 98function TCommonDialog.IsTitleStored: boolean; 99begin 100 result := FTitle<>DefaultTitle; 101end; 102 103class procedure TCommonDialog.WSRegisterClass; 104begin 105 inherited WSRegisterClass; 106 RegisterCommonDialog; 107end; 108 109procedure TCommonDialog.SetHeight(const AValue: integer); 110begin 111 if FHeight=AValue then exit; 112 FHeight:=AValue; 113end; 114 115procedure TCommonDialog.SetWidth(const AValue: integer); 116begin 117 if FWidth=AValue then exit; 118 FWidth:=AValue; 119end; 120 121procedure TCommonDialog.ResetShowCloseFlags; 122begin 123 FDoShowCalled := False; 124 FDoCanCloseCalled := False; 125 FDoCloseCalled := False; 126end; 127 128function TCommonDialog.DoExecute : boolean; 129var 130 CanClose: boolean; 131begin 132 { 133 Various widgetsets may or may not call DoShow, DoCanClose or DoClose from within 134 the WS implementation. 135 If the WS calls any of these, we assume that we should NOT call them from here. 136 Checking for FDoShowCalled (etc) alone is not enough, since it may very well be that 137 the WS wants to (deiberately) call the methos at a later point in time. 138 } 139 {$ifdef DebugCommonDialogEvents} 140 debugln(['TCommonDialog.DoExecute A']); 141 {$endif} 142 if (not FDoShowCalled) and (not (cdecWSPerformsDoShow in FWSEventCapabilities)) then 143 begin 144 {$ifdef DebugCommonDialogEvents} 145 debugln(['TCommonDialog.DoExecute calling DoShow']); 146 {$endif} 147 DoShow; 148 end; 149 {$ifdef DebugCommonDialogEvents} 150 debugln(['TCommonDialog.DoExecute before WS_ShowModal']); 151 {$endif} 152 TWSCommonDialogClass(WidgetSetClass).ShowModal(Self); 153 {$ifdef DebugCommonDialogEvents} 154 debugln(['TCommonDialog.DoExecute after WS_ShowModal, FCanCloseCalled=',FDoCanCloseCalled,' FUserChoice=',ModalResultStr[FUserChoice]]); 155 {$endif} 156 // can close was called from widgetset loop 157 if (not FDoCanCloseCalled) and ((FWSEventCapabilities * [cdecWSPerformsDoCanClose,cdecWSNOCanCloseSupport]) = []) then 158 begin 159 repeat 160 {$ifdef DebugCommonDialogEvents} 161 debugln(['TCommonDialog.DoExecute, FUserChoice=',ModalResultStr[FUserChoice],' Handle=',Handle]); 162 {$endif} 163 if (FUserChoice <> mrNone) and (Handle<>0) then 164 begin 165 CanClose := True; 166 {$ifdef DebugCommonDialogEvents} 167 debugln(['TCommonDialog.DoExecute calling DoCanClose']); 168 {$endif} 169 DoCanClose(CanClose); 170 if not CanClose then 171 FUserChoice:=mrNone; 172 {$ifdef DebugCommonDialogEvents} 173 debugln(['TCommonDialog.DoExecute after calling DoCanClose: CanClose=',CanClose,' FUserChoice=',ModalResultStr[FUserChoice]]); 174 {$endif} 175 end; 176 if FUserChoice <> mrNone then 177 break; 178 { win32 widgetset dialogs use their own message loop, 179 so only FUserChoice may have been set already } 180 Application.HandleMessage; 181 until false; 182 end; 183 Result := (FUserChoice = mrOk); 184 {$ifdef DebugCommonDialogEvents} 185 debugln(['TCommonDialog.DoExecute End']); 186 {$endif} 187end; 188 189function TCommonDialog.DefaultTitle: string; 190begin 191 Result := ''; 192end; 193 194function TCommonDialog.GetHeight: Integer; 195begin 196 Result := FHeight; 197end; 198 199function TCommonDialog.GetWidth: Integer; 200begin 201 Result := FWidth; 202end; 203