{%MainUnit ../stdctrls.pp} {****************************************************************************** TCustomCheckbox ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.LCL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** current design flaws: - To always get the real state of the component we should have a callback in this class. Since the OnClick callback is already assigned in TControl, we can't use it here. (s.a. Bugs section below!) Delphi compatibility: - GTK does not support the cbGrayed state so it's not handled - alignment property is missing - lots of unknown issues TODO: - check for Delphi compatibility - test if fState / Checked is always set right Bugs: } {------------------------------------------------------------------------------ Method: TCustomCheckBox.SetState Params: value: new state of the object Returns: Nothing Set new state of the checkbox. ------------------------------------------------------------------------------} procedure TCustomCheckBox.SetState(Value: TCheckBoxState); begin if FState <> Value then begin FState := Value; ApplyChanges; end; end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.GetState Params: none Returns: current state of the object Get current state of the checkbox. To get the real state a call to the interface is made here. ------------------------------------------------------------------------------} function TCustomCheckBox.GetState: TCheckBoxState; begin fState:=RetrieveState; Result := fState; end; procedure TCustomCheckBox.DoChange(var Msg); var NewState: TCheckBoxState; begin NewState:=RetrieveState; if FState=NewState then exit; FState:=RetrieveState; DoOnChange; end; function TCustomCheckBox.RetrieveState: TCheckBoxState; begin Result:=FState; // get the actual state of the component if HandleAllocated then Result := TWSCustomCheckBoxClass(WidgetSetClass).RetrieveState(Self); end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.Create Params: TheOwner: the owner of the class Returns: Nothing Constructor for custom checkbox. ------------------------------------------------------------------------------} constructor TCustomCheckBox.Create(TheOwner : TComponent); begin Inherited Create(TheOwner); fCompStyle := csCheckbox; FState := cbUnchecked; FAllowGrayed := True; TabStop := true; SetInitialBounds(0,0,90,23); AutoSize:=true; end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.InitializeWnd Params: none Returns: Nothing Set all properties after visual component has been created. Will be called from TWinControl. ------------------------------------------------------------------------------} procedure TCustomCheckBox.InitializeWnd; begin inherited InitializeWnd; ApplyChanges; end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.GetChecked Params: none Returns: current state of the object Get current state of the checkbox and return it as boolean. ------------------------------------------------------------------------------} function TCustomCheckBox.GetChecked : Boolean; begin GetChecked := (GetState = cbChecked); end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.SetChecked Params: Value - new state of checkbox Returns: Nothing Set the new state of the checkbox as boolean. ------------------------------------------------------------------------------} procedure TCustomCheckBox.SetChecked(Value : Boolean); var OldState : TCheckBoxState; begin OldState := FState; If Value then FState := cbChecked else FState := cbUnChecked; if FState <> OldState then begin if Assigned(Action) and (Action is TCustomAction) then TCustomAction(Action).Checked := FState=cbChecked; ApplyChanges; if UseOnChange then begin DoOnChange; end else begin if not ClicksDisabled then Click; end; end; end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.Toggle Params: none Returns: Nothing Toggle the current state of the checkbox. ------------------------------------------------------------------------------} procedure TCustomCheckBox.Toggle; begin SetChecked(not GetChecked); end; {------------------------------------------------------------------------------ Method: TCustomCheckBox.ApplyChanges Params: none Returns: Nothing Sends message to update the visual apperance of the object. ------------------------------------------------------------------------------} procedure TCustomCheckBox.ApplyChanges; begin if HandleAllocated and (not (csLoading in ComponentState)) then begin CNSendMessage(LM_SetValue,Self,@fState); end; end; {------------------------------------------------------------------------------ procedure TCustomCheckBox.RealSetText(const Value: TCaption); ------------------------------------------------------------------------------} procedure TCustomCheckBox.RealSetText(const Value: TCaption); var ParseStr : String; AccelIndex : Longint; OldKey: word; begin if Value=Text then exit; Inherited RealSetText(Value); If (not HandleAllocated) or (csDesigning in ComponentState) then exit; ParseStr := Value; AccelIndex := DeleteAmpersands(ParseStr); If AccelIndex > -1 then begin OldKey := FShortCut; FShortCut := Char2VK(ParseStr[AccelIndex]); TWSCustomCheckBoxClass(WidgetSetClass).SetShortCut(Self, OldKey, FShortCut); end; DoAutoSize; end; // included by stdctrls.pp { $Log$ Revision 1.25 2004/09/18 17:07:57 micha convert LM_GETVALUE message to interface method Revision 1.24 2004/09/17 10:56:25 micha convert LM_SHORTCUT message to interface methods Revision 1.23 2004/07/16 21:49:00 mattias added RTTI controls Revision 1.22 2004/07/10 18:17:30 mattias added Delphi ToDo support, Application.WndProc, small bugfixes from Colin Revision 1.21 2004/05/30 14:02:30 mattias implemented OnChange for TRadioButton, TCheckBox, TToggleBox and some more docking stuff Revision 1.20 2004/04/18 23:55:39 marc * Applied patch from Ladislav Michl * Changed the way TControl.Text is resolved * Added setting of text to TWSWinControl Revision 1.19 2004/04/10 17:58:57 mattias implemented mainunit hints for include files Revision 1.18 2004/02/23 08:19:04 micha revert intf split Revision 1.16 2004/02/05 09:45:33 mattias implemented Actions for TSpeedButton, TMenuItem, TCheckBox Revision 1.15 2004/01/21 10:19:16 micha enable tabstops for controls; implement tabstops in win32 intf Revision 1.14 2003/09/16 11:35:14 mattias started TDBCheckBox Revision 1.13 2003/03/25 16:56:57 mattias implemented TButtonControl.UseOnChange Revision 1.12 2003/03/25 16:29:53 mattias fixed sending TButtonControl.OnClick on every change Revision 1.11 2003/03/17 20:50:30 mattias fixed TRadioGroup.ItemIndex=-1 Revision 1.10 2003/03/09 17:44:12 mattias finshed Make Resourcestring dialog and implemented TToggleBox Revision 1.9 2002/10/09 10:22:54 lazarus MG: fixed client origin coordinates Revision 1.8 2002/10/03 00:08:50 lazarus AJ: TCustomLabel Autosize, TCustomCheckbox '&' shortcuts started Revision 1.7 2002/09/10 07:33:37 lazarus MG: fixed TCheckBox.DoAutoSize on loading Revision 1.6 2002/08/27 14:33:37 lazarus MG: fixed designer component deletion Revision 1.5 2002/07/23 07:40:51 lazarus MG: fixed get widget position for inherited gdkwindows Revision 1.4 2002/05/10 06:05:51 lazarus MG: changed license to LGPL Revision 1.3 2002/04/02 16:44:41 lazarus MG: bugfixes, finddeclaration cache dependencies Revision 1.2 2002/02/08 16:45:09 lazarus MG: added codetools options Revision 1.1 2000/07/13 10:28:25 michael + Initial import Revision 1.2 2000/06/22 20:57:07 lazarus *** empty log message *** Revision 1.1 2000/04/02 20:49:56 lazarus MWE: Moved lazarus/lcl/*.inc files to lazarus/lcl/include Revision 1.6 2000/03/30 18:07:53 lazarus Added some drag and drop code Added code to change the unit name when it's saved as a different name. Not perfect yet because if you are in a comment it fails. Shane Revision 1.5 2000/03/06 00:05:05 lazarus MWE: Added changes from Peter Dyson for a new release of mwEdit (0.92) Revision 1.4 2000/01/04 19:16:09 lazarus Stoppok: - new messages LM_GETVALUE, LM_SETVALUE, LM_SETPROPERTIES - changed trackbar, progressbar, checkbox to use above messages - some more published properties for above components (all properties derived from TWinControl) - new functions SetValue, GetValue, SetProperties in gtk-interface Revision 1.3 1999/12/30 19:04:13 lazarus - Made TRadiobutton work again - Some more cleanups to checkbox code stoppok } // included by stdctrls.pp