1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
|
{%MainUnit ../stdctrls.pp}
{ $Id$}
{******************************************************************************
TCustomButton
******************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{------------------------------------------------------------------------------
TCustomButton Constructor
------------------------------------------------------------------------------}
constructor TCustomButton.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FRolesUpdateLocked := False;
// set the component style to csButton
fCompStyle := csButton;
ControlStyle := ControlStyle - [csClickEvents] + [csHasDefaultAction, csHasCancelAction];
Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
ParentColor := False;
TabStop := True;
// set default alignment
Align := alNone;
// setup default sizes
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, CX, CY);
end;
{------------------------------------------------------------------------------
Method: TCustomButton.CreateWnd
Params: None
Returns: Nothing
Creates the interface object.
------------------------------------------------------------------------------}
procedure TCustomButton.CreateWnd;
begin
inherited CreateWnd;
//this is done in TWinControl
//SetText(Caption);//To ensure shortcut is set
UpdateDefaultCancel;
end;
procedure TCustomButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if Default then
Params.Style := Params.Style or BS_DEFPUSHBUTTON
else
Params.Style := Params.Style or BS_PUSHBUTTON;
end;
procedure TCustomButton.ControlKeyDown(var Key: Word; Shift: TShiftState);
begin
inherited ControlKeyDown(Key, Shift);
end;
procedure TCustomButton.ControlKeyUp(var Key: Word; Shift: TShiftState);
begin
inherited ControlKeyUp(Key, Shift);
end;
procedure TCustomButton.UpdateRolesForForm;
var
AForm: TCustomForm;
NewRoles: TControlRolesForForm;
begin
if FRolesUpdateLocked then
Exit;
AForm := GetParentForm(Self);
if not Assigned(AForm) then
Exit; // not on a form => keep settings
// on a form => use settings of parent form
NewRoles := AForm.GetRolesForControl(Self);
Default := crffDefault in NewRoles;
Cancel := crffCancel in NewRoles;
end;
{------------------------------------------------------------------------------
Method: TCustomButton.SetCancel
Params: NewCancel - new cancel value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomButton.SetCancel(NewCancel: boolean);
var
Form: TCustomForm;
begin
if FCancel = NewCancel then Exit;
FCancel := NewCancel;
Form := GetParentForm(Self);
if Assigned(Form) then
begin
if NewCancel then
Form.CancelControl := Self
else
Form.CancelControl := nil;
end;
end;
{------------------------------------------------------------------------------
Method: TCustomButton.SetDefault
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomButton.SetDefault(Value : Boolean);
var
Form: TCustomForm;
begin
if FDefault = Value then Exit;
FDefault := Value;
Form := GetParentForm(Self);
if Assigned(Form) then
begin
if Value then
begin
Form.DefaultControl := Self;
end else
begin
if Form.DefaultControl = Self then
Form.DefaultControl := nil;
end;
end;
WSSetDefault;
end;
procedure TCustomButton.SetModalResult(const AValue: TModalResult);
begin
if AValue=FModalResult then exit;
FModalResult:=AValue;
end;
procedure TCustomButton.ExecuteDefaultAction;
begin
if FActive or FDefault then
Click;
end;
procedure TCustomButton.ExecuteCancelAction;
begin
if FCancel then
Click;
end;
{------------------------------------------------------------------------------
Method: TCustomButton.Click
Params: None
Returns: Nothing
Handles the event that the button is clicked
------------------------------------------------------------------------------}
procedure TCustomButton.Click;
var
Form : TCustomForm;
Begin
if ModalResult <> mrNone
then begin
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult;
end;
inherited Click;
end;
function TCustomButton.DialogChar(var Message: TLMKey): boolean;
begin
if IsAccel(Message.CharCode, Caption) and CanFocus then
begin
Click;
Result := true;
end else
Result := inherited;
end;
procedure TCustomButton.ActiveDefaultControlChanged(NewControl: TControl);
var
lPrevActive: boolean;
lForm: TCustomForm;
begin
lPrevActive := FActive;
lForm := GetParentForm(Self);
if NewControl = Self then
begin
FActive := True;
if lForm <> nil then
lForm.ActiveDefaultControl := Self;
end else
if NewControl <> nil then
FActive := False
else
begin
FActive := FDefault;
if lForm.ActiveDefaultControl = Self then
lForm.ActiveDefaultControl := nil;
end;
if lPrevActive <> FActive then
WSSetDefault;
end;
procedure TCustomButton.CMUIActivate(var Message: TLMessage);
begin
UpdateFocus(True);
end;
procedure TCustomButton.WMSetFocus(var Message: TLMSetFocus);
begin
inherited;
UpdateFocus(True);
end;
procedure TCustomButton.WMKillFocus(var Message: TLMKillFocus);
begin
inherited;
// if no change then exit
if Message.FocusedWnd <> Handle then
UpdateFocus(False);
end;
procedure TCustomButton.UpdateFocus(AFocused: Boolean);
var
lForm: TCustomForm;
begin
lForm := GetParentForm(Self);
if lForm = nil then exit;
if AFocused then
ActiveDefaultControlChanged(lForm.ActiveControl)
else
ActiveDefaultControlChanged(nil);
end;
class procedure TCustomButton.WSRegisterClass;
const
Registered : boolean = False;
begin
if Registered then
Exit;
inherited WSRegisterClass;
RegisterCustomButton;
RegisterPropertyToSkip(TCustomButton, 'ElevationRequired', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'ImageAlignment', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'ImageMargins', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'ImageIndex', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'DisabledImageIndex', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'HotImageIndex', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'PressedImageIndex', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomButton, 'SelectedImageIndex', 'VCL compatibility property', '');
Registered := True;
end;
function TCustomButton.ChildClassAllowed(ChildClass: TClass): boolean;
begin
// no children
Result:=false;
if Widgetset.GetLCLCapability(lcAllowChildControlsInNativeControls) = LCL_CAPABILITY_YES then Result := True;
end;
class function TCustomButton.GetControlClassDefaultSize: TSize;
begin
Result.CX := 75;
Result.CY := 25;
end;
function TCustomButton.UseRightToLeftAlignment: Boolean;
begin
//Button always has center alignment
Result := False;
end;
procedure TCustomButton.WSSetText(const AText: String);
var
ParseStr : String;
AccelIndex : Longint;
begin
if (not HandleAllocated) then
exit;
if not (csDesigning in ComponentState) then
begin
ParseStr := AText;
AccelIndex := DeleteAmpersands(ParseStr);
if AccelIndex > -1 then
begin
FShortCut := Menus.ShortCut(Char2VK(ParseStr[AccelIndex]), [ssCtrl]);
TWSButtonClass(WidgetSetClass).SetShortCut(Self, FShortCut, FShortCutKey2);
end;
end;
inherited WSSetText(AText);
//DebugLn(['TCustomButton.WSSetText ',dbgsName(Self),' Caption="',Caption,'"]);
end;
procedure TCustomButton.TextChanged;
begin
InvalidatePreferredSize;
if Assigned(Parent) and Parent.AutoSize then
Parent.AdjustSize;
AdjustSize;
inherited TextChanged;
end;
procedure TCustomButton.Loaded;
begin
inherited Loaded;
UpdateDefaultCancel;
end;
procedure TCustomButton.UpdateDefaultCancel;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if Assigned(Form) then
begin
FRolesUpdateLocked := True;
try
if FDefault then
Form.DefaultControl := Self;
if FCancel then
Form.CancelControl := Self;
finally
FRolesUpdateLocked := False;
end;
end;
WSSetDefault;
end;
{------------------------------------------------------------------------------
procedure TCustomButton.DoSendBtnDefault;
------------------------------------------------------------------------------}
procedure TCustomButton.WSSetDefault;
begin
// Default only tell us if button was set to Default in the design time.
// In run time Active actually shows us if this button is a default button
// (will be clicked on enter)
if HandleAllocated then
TWSButtonClass(WidgetSetClass).SetDefault(Self, FActive);
end;
|