1{ 2 ***************************************************************************** 3 * WSDialogs.pp * 4 * ------------ * 5 * * 6 * * 7 ***************************************************************************** 8 9 ***************************************************************************** 10 This file is part of the Lazarus Component Library (LCL) 11 12 See the file COPYING.modifiedLGPL.txt, included in this distribution, 13 for details about the license. 14 ***************************************************************************** 15} 16unit WSDialogs; 17 18{$mode objfpc}{$H+} 19{$I lcl_defines.inc} 20 21interface 22//////////////////////////////////////////////////// 23// I M P O R T A N T 24//////////////////////////////////////////////////// 25// 1) Only class methods allowed 26// 2) Class methods have to be published and virtual 27// 3) To get as little as posible circles, the uses 28// clause should contain only those LCL units 29// needed for registration. WSxxx units are OK 30// 4) To improve speed, register only classes in the 31// initialization section which actually 32// implement something 33// 5) To enable your XXX widgetset units, look at 34// the uses clause of the XXXintf.pp 35//////////////////////////////////////////////////// 36uses 37//////////////////////////////////////////////////// 38// To get as little as posible circles, 39// uncomment only when needed for registration 40//////////////////////////////////////////////////// 41 LCLType, Dialogs, 42//////////////////////////////////////////////////// 43 WSLCLClasses, WSControls, WSFactory; 44 45type 46 { TWSCommonDialog } 47 48 TWSCommonDialogClass = class of TWSCommonDialog; 49 TWSCommonDialog = class(TWSLCLComponent) 50 public class var 51 WSCommonDialog_WSClass: TWSCommonDialogClass; 52 published 53 class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; virtual; 54 class procedure ShowModal(const ACommonDialog: TCommonDialog); virtual; 55 class procedure DestroyHandle(const ACommonDialog: TCommonDialog); virtual; 56 class function QueryWSEventCapabilities(const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; virtual; 57 end; 58 59 { TWSFileDialog } 60 61 TWSFileDialog = class(TWSCommonDialog) 62 published 63 end; 64 65 { TWSOpenDialog } 66 67 TWSOpenDialog = class(TWSFileDialog) 68 published 69 end; 70 71 { TWSSaveDialog } 72 73 TWSSaveDialog = class(TWSOpenDialog) 74 published 75 end; 76 77 { TWSSelectDirectoryDialog } 78 79 TWSSelectDirectoryDialog = class(TWSOpenDialog) 80 published 81 end; 82 83 { TWSColorDialog } 84 85 TWSColorDialog = class(TWSCommonDialog) 86 published 87 end; 88 89 { TWSColorButton } 90 91 TWSColorButton = class(TWSGraphicControl) 92 published 93 end; 94 95 { TWSFontDialog } 96 97 TWSFontDialog = class(TWSCommonDialog) 98 published 99 class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; 100 class procedure ShowModal(const ACommonDialog: TCommonDialog); override; 101 class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override; 102 class function QueryWSEventCapabilities(const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; 103 end; 104 105 { WidgetSetRegistration } 106 107 procedure RegisterCommonDialog; 108 procedure RegisterFileDialog; 109 procedure RegisterOpenDialog; 110 procedure RegisterSaveDialog; 111 procedure RegisterSelectDirectoryDialog; 112 procedure RegisterColorDialog; 113 procedure RegisterColorButton; 114 procedure RegisterFontDialog; 115 116implementation 117 118uses 119 LResources; 120 121class function TWSCommonDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; 122begin 123 Result := 0; 124end; 125 126class procedure TWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog); 127begin 128end; 129 130class function TWSCommonDialog.QueryWSEventCapabilities( 131 const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; 132begin 133 Result := []; 134end; 135 136class procedure TWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog); 137begin 138end; 139 140{ TWSFontDialog } 141 142class function TWSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; 143begin 144 if WSCommonDialog_WSClass = nil then 145 WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog)); 146 if WSCommonDialog_WSClass <> nil then 147 begin 148 Result := WSCommonDialog_WSClass.CreateHandle(ACommonDialog); 149 Exit; 150 end; 151 Result:=inherited CreateHandle(ACommonDialog) 152end; 153 154class procedure TWSFontDialog.ShowModal(const ACommonDialog: TCommonDialog); 155begin 156 if WSCommonDialog_WSClass = nil then 157 WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog)); 158 if WSCommonDialog_WSClass <> nil then 159 begin 160 WSCommonDialog_WSClass.ShowModal(ACommonDialog); 161 Exit; 162 end; 163 inherited ShowModal(ACommonDialog); 164end; 165 166class procedure TWSFontDialog.DestroyHandle(const ACommonDialog: TCommonDialog); 167begin 168 if WSCommonDialog_WSClass = nil then 169 WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog)); 170 if WSCommonDialog_WSClass <> nil then 171 begin 172 WSCommonDialog_WSClass.DestroyHandle(ACommonDialog); 173 Exit; 174 end; 175 inherited DestroyHandle(ACommonDialog); 176end; 177 178class function TWSFontDialog.QueryWSEventCapabilities( 179 const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; 180begin 181 if WSCommonDialog_WSClass = nil then 182 WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog)); 183 if WSCommonDialog_WSClass <> nil then 184 begin 185 Result := WSCommonDialog_WSClass.QueryWSEventCapabilities(ACommonDialog); 186 Exit; 187 end; 188 Result:=inherited QueryWSEventCapabilities(ACommonDialog); 189end; 190 191{ WidgetSetRegistration } 192 193procedure RegisterCommonDialog; 194const 195 Done: Boolean = False; 196begin 197 if Done then exit; 198 if not WSRegisterCommonDialog then 199 RegisterWSComponent(TCommonDialog, TWSCommonDialog); 200 RegisterPropertyToSkip(TCommonDialog, 'Ctl3D', 'VCL compatibility property', ''); 201 Done := True; 202end; 203 204procedure RegisterFileDialog; 205const 206 Done: Boolean = False; 207begin 208 if Done then exit; 209 WSRegisterFileDialog; 210// if not WSRegisterFileDialog then 211// RegisterWSComponent(TFileDialog, TWSFileDialog); 212 Done := True; 213end; 214 215procedure RegisterOpenDialog; 216const 217 Done: Boolean = False; 218begin 219 if Done then exit; 220 WSRegisterOpenDialog; 221// if not WSRegisterOpenDialog then 222// RegisterWSComponent(TOpenDialog, TWSOpenDialog); 223 Done := True; 224end; 225 226procedure RegisterSaveDialog; 227const 228 Done: Boolean = False; 229begin 230 if Done then exit; 231 WSRegisterSaveDialog; 232// if not WSRegisterSaveDialog then 233// RegisterWSComponent(TSaveDialog, TWSSaveDialog); 234 Done := True; 235end; 236 237procedure RegisterSelectDirectoryDialog; 238const 239 Done: Boolean = False; 240begin 241 if Done then exit; 242 WSRegisterSelectDirectoryDialog; 243// if not WSRegisterSelectDirectoryDialog then 244// RegisterWSComponent(TSelectDirectoryDialog, TWSSelectDirectoryDialog); 245 Done := True; 246end; 247 248procedure RegisterColorDialog; 249const 250 Done: Boolean = False; 251begin 252 if Done then exit; 253 WSRegisterColorDialog; 254// if not WSRegisterColorDialog then 255// RegisterWSComponent(TColorDialog, TWSColorDialog); 256 Done := True; 257end; 258 259procedure RegisterColorButton; 260const 261 Done: Boolean = False; 262begin 263 if Done then exit; 264 WSRegisterColorButton; 265// if not WSRegisterColorButton then 266// RegisterWSComponent(TColorButton, TWSColorButton); 267 Done := True; 268end; 269 270procedure RegisterFontDialog; 271const 272 Done: Boolean = False; 273begin 274 if Done then exit; 275 WSRegisterFontDialog; 276// if not WSRegisterFontDialog then 277// RegisterWSComponent(TFontDialog, TWSFontDialog); 278 Done := True; 279end; 280 281end. 282