diff --git a/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas index e35dd8015..c834ead19 100644 --- a/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas +++ b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas @@ -14,12 +14,12 @@ implementation {$R ../../resource/jvstdctrlsreg.res} uses - Classes, Controls, JvDsgnConsts, JvButton, JvBaseEdits; + Classes, Controls, JvDsgnConsts, JvButton, JvCheckbox, JvBaseEdits; procedure Register; begin //RegisterComponents(RsPaletteButton, [TJvButton]); - RegisterComponents(RsPaletteJvcl, [TJvCalcEdit]); + RegisterComponents(RsPaletteJvcl, [TJvCheckbox, TJvCalcEdit]); end; end. diff --git a/components/jvcllaz/design/JvStdCtrls/images/images.txt b/components/jvcllaz/design/JvStdCtrls/images/images.txt index a1a182a25..8ec115250 100644 --- a/components/jvcllaz/design/JvStdCtrls/images/images.txt +++ b/components/jvcllaz/design/JvStdCtrls/images/images.txt @@ -1 +1,2 @@ +tjvcheckbox.bmp tjvcalcedit.bmp diff --git a/components/jvcllaz/design/JvStdCtrls/images/tjvcheckbox.bmp b/components/jvcllaz/design/JvStdCtrls/images/tjvcheckbox.bmp new file mode 100644 index 000000000..c67faf2d9 Binary files /dev/null and b/components/jvcllaz/design/JvStdCtrls/images/tjvcheckbox.bmp differ diff --git a/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpi b/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpi new file mode 100644 index 000000000..a3fc3a971 --- /dev/null +++ b/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="JvStdCtrlsLazR"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="JvCheckBoxDemo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="jvcheckboxdemounit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="JvCheckBoxDemoUnit"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\..\bin\JvCheckBoxDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpr b/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpr new file mode 100644 index 000000000..94f81e216 --- /dev/null +++ b/components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpr @@ -0,0 +1,22 @@ +program JvCheckBoxDemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, JvCheckBoxDemoUnit + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.lfm b/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.lfm new file mode 100644 index 000000000..0dde54e3f --- /dev/null +++ b/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.lfm @@ -0,0 +1,128 @@ +object Form1: TForm1 + Left = 345 + Height = 243 + Top = 131 + Width = 482 + Caption = 'Form1' + ClientHeight = 243 + ClientWidth = 482 + LCLVersion = '2.1.0.0' + object JvCheckBox1: TJvCheckBox + Left = 24 + Height = 19 + Top = 16 + Width = 318 + Caption = 'Check/uncheck to enable/disable the controls in the box' + Checked = True + State = cbChecked + TabOrder = 0 + LinkedControls = < + item + Control = Button1 + end + item + Control = Edit1 + end + item + Control = Label1 + end + item + Control = Memo1 + end + item + Control = ListBox1 + end + item + Control = ComboBox1 + end> + end + object Button2: TButton + Left = 376 + Height = 25 + Top = 16 + Width = 75 + Caption = 'Toggle' + OnClick = Button2Click + TabOrder = 1 + end + object Panel1: TPanel + Left = 24 + Height = 162 + Top = 56 + Width = 296 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Panel1' + ClientHeight = 162 + ClientWidth = 296 + TabOrder = 2 + object Button1: TButton + Left = 208 + Height = 25 + Top = 128 + Width = 75 + Caption = 'Button1' + TabOrder = 0 + end + object Label1: TLabel + AnchorSideTop.Control = Edit1 + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 34 + Caption = 'Label1' + ParentColor = False + end + object Edit1: TEdit + Left = 56 + Height = 23 + Top = 8 + Width = 112 + TabOrder = 1 + Text = 'Edit1' + end + object Memo1: TMemo + Left = 56 + Height = 82 + Top = 40 + Width = 114 + Lines.Strings = ( + 'Memo1' + ) + TabOrder = 2 + end + object ListBox1: TListBox + Left = 184 + Height = 114 + Top = 8 + Width = 100 + Items.Strings = ( + 'Item 1' + 'Item 2' + 'Item 3' + 'Item 4' + 'Item 5' + ) + ItemHeight = 15 + TabOrder = 3 + end + object ComboBox1: TComboBox + Left = 56 + Height = 23 + Top = 130 + Width = 112 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'Item 1' + 'Item 2' + 'Item 3' + 'Item 4' + 'Item 5' + ) + TabOrder = 4 + Text = 'Item 1' + end + end +end diff --git a/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.pas b/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.pas new file mode 100644 index 000000000..03499892f --- /dev/null +++ b/components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.pas @@ -0,0 +1,47 @@ +unit JvCheckBoxDemoUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, + JvCheckBox; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Button2: TButton; + ComboBox1: TComboBox; + Edit1: TEdit; + JvCheckBox1: TJvCheckBox; + Label1: TLabel; + ListBox1: TListBox; + Memo1: TMemo; + Panel1: TPanel; + procedure Button2Click(Sender: TObject); + private + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.Button2Click(Sender: TObject); +begin + JvCheckbox1.Toggle; +end; + +end. + diff --git a/components/jvcllaz/packages/JvStdCtrlsLazR.lpk b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk index 7a64aca97..a928800a8 100644 --- a/components/jvcllaz/packages/JvStdCtrlsLazR.lpk +++ b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk @@ -17,7 +17,7 @@ "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <Version Major="1" Release="4"/> - <Files Count="2"> + <Files Count="4"> <Item1> <Filename Value="..\run\JvStdCtrls\JvButton.pas"/> <UnitName Value="JvButton"/> @@ -26,6 +26,14 @@ <Filename Value="..\run\JvStdCtrls\JvBaseEdits.pas"/> <UnitName Value="JvBaseEdits"/> </Item2> + <Item3> + <Filename Value="..\run\JvStdCtrls\jvlinkedcontrols.pas"/> + <UnitName Value="JvLinkedControls"/> + </Item3> + <Item4> + <Filename Value="..\run\JvStdCtrls\jvcheckbox.pas"/> + <UnitName Value="JvCheckBox"/> + </Item4> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/components/jvcllaz/resource/JvStdCtrlsReg.res b/components/jvcllaz/resource/JvStdCtrlsReg.res index 9e69e405b..0e716ea20 100644 Binary files a/components/jvcllaz/resource/JvStdCtrlsReg.res and b/components/jvcllaz/resource/JvStdCtrlsReg.res differ diff --git a/components/jvcllaz/run/JvStdCtrls/jvcheckbox.pas b/components/jvcllaz/run/JvStdCtrls/jvcheckbox.pas new file mode 100644 index 000000000..4000f5fb8 --- /dev/null +++ b/components/jvcllaz/run/JvStdCtrls/jvcheckbox.pas @@ -0,0 +1,634 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvCheckBox.PAS, released on 2001-02-28. + +The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com] +Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse. +All Rights Reserved. + +Contributor(s): +Michael Beck [mbeck att bigfoot dott com]. +Ain Valtin - ReadOnly, Alignment, Layout, RightButton +Robert Marquardt RightButton renamed to LeftText +Peter Thörnqvist- added LinkedControls property + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvCheckBox; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, LCLType, LMessages, + Classes, Graphics, Controls, StdCtrls, Types, + JvTypes, JvLinkedControls; +// JvTypes, JvExStdCtrls, JvLinkedControls, JvDataSourceIntf; + +const + DefaultValueChecked = '1'; + DefaultValueUnchecked = '0'; + +type + TJvCheckBox = class; + + (******************* NOT CONVERTED ***** + TJvCheckBoxDataConnector = class(TJvFieldDataConnector) + private + FCheckBox: TJvCheckBox; + FValueChecked: string; + FValueUnchecked: string; + procedure SetValueChecked(const Value: string); + procedure SetValueUnchecked(const Value: string); + function IsValueCheckedStored: Boolean; + function IsValueUncheckedStored: Boolean; + protected + procedure UpdateData; override; + procedure RecordChanged; override; + public + constructor Create(ACheckBox: TJvCheckBox); + procedure Assign(Source: TPersistent); override; + published + property ValueChecked: string read FValueChecked write SetValueChecked stored IsValueCheckedStored; + property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked stored IsValueUncheckedStored; + end; + ***********************) + + TJvCheckBox = class(TCheckbox) //TJvExCheckBox) + private + FLinkedControls: TJvLinkedControls; + FCheckingLinkedControls: Boolean; + (**************** NOT CONVERTED *** + FReadOnly:Boolean; + FHotTrack: Boolean; + FHotTrackFont: TFont; + FFontSave: TFont; + FHotTrackFontOptions: TJvTrackFontOptions; + FAutoSize: Boolean; + FCanvas: TControlCanvas; + FWordWrap: Boolean; + FAlignment: TAlignment; + FLayout: TTextLayout; + FLeftText: Boolean; + FDataConnector: TJvCheckBoxDataConnector; + function GetCanvas: TCanvas; + procedure SetHotTrackFont(const Value: TFont); + procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions); + procedure SetWordWrap(const Value: Boolean); + procedure SetAlignment(const Value: TAlignment); + procedure SetLayout(const Value: TTextLayout); + procedure SetLeftText(const Value: Boolean); + procedure SetDataConnector(const Value: TJvCheckBoxDataConnector); + function IsHotTrackFontStored: Boolean; + procedure SetClientSize(W, H: Integer); + *****************) + procedure SetLinkedControls(const Value: TJvLinkedControls); + procedure ReadAssociated(Reader: TReader); + protected + (**************** NOT CONVERTED **** + procedure SetAutoSize(Value: Boolean); override; + procedure CalcAutoSize; virtual; + function CreateDataConnector: TJvCheckBoxDataConnector; virtual; + procedure CreateParams(var Params: TCreateParams); override; + procedure DoExit; override; + procedure KeyPress(var Key: Char); override; + procedure BmSetCheck(var Msg: TLMessage); message BM_SETCHECK; + procedure TextChanged; override; + procedure UpdateProperties; + procedure FontChanged; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + ***************) + procedure CheckLinkedControls; virtual; + procedure DefineProperties(Filer: TFiler); override; + procedure DoClickOnChange; override; + procedure EnabledChanged;override; + procedure LinkedControlsChange(Sender: TObject); + procedure Loaded; override; + procedure Notification(AComponent: TComponent; Operation: TOperation);override; + procedure SetChecked(AValue: Boolean); override; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Toggle; override; + procedure SetFocus; override; + (*************** NOT CONVERTED *** + property Canvas: TCanvas read GetCanvas; + ***) + published + property LinkedControls: TJvLinkedControls read FLinkedControls write SetLinkedControls; + (************** NOT CONVERTED *** + property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; + // link the enabled state of other controls to the checked and/or enabled state of this control + property AutoSize: Boolean read FAutoSize write SetAutoSize default True; + property HotTrack: Boolean read FHotTrack write FHotTrack default False; + property HotTrackFont: TFont read FHotTrackFont write SetHotTrackFont stored IsHotTrackFontStored; + property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions + default DefaultTrackFontOptions; + property Layout: TTextLayout read FLayout write SetLayout default tlCenter; + // show text to the left of the checkbox + property LeftText: Boolean read FLeftText write SetLeftText default False; + property WordWrap: Boolean read FWordWrap write SetWordWrap default False; + property OnMouseEnter; + property OnMouseLeave; + property DataConnector: TJvCheckBoxDataConnector read FDataConnector write SetDataConnector; + property HintColor; + property ReadOnly: Boolean read FReadOnly write FReadOnly default False; + property OnParentColorChange; + ***) + end; + + +implementation + +uses + SysUtils; +// JvJCLUtils, JvJVCLUtils; + +(******************** NOT CONVERTED *** +//=== { TJvCheckBoxDataConnector } =========================================== + +constructor TJvCheckBoxDataConnector.Create(ACheckBox: TJvCheckBox); +begin + inherited Create; + FCheckBox := ACheckBox; + FValueChecked := DefaultValueChecked; + FValueUnchecked := DefaultValueUnchecked; +end; + +function TJvCheckBoxDataConnector.IsValueCheckedStored: Boolean; +begin + Result := FValueChecked <> DefaultValueChecked; +end; + +function TJvCheckBoxDataConnector.IsValueUncheckedStored: Boolean; +begin + Result := FValueUnchecked <> DefaultValueUnchecked; +end; + +procedure TJvCheckBoxDataConnector.Assign(Source: TPersistent); +begin + inherited Assign(Source); + if Source is TJvCheckBoxDataConnector then + begin + FValueChecked := TJvCheckBoxDataConnector(Source).ValueChecked; + FValueUnchecked := TJvCheckBoxDataConnector(Source).ValueUnchecked; + Reset; + end; +end; + +procedure TJvCheckBoxDataConnector.RecordChanged; +begin + if Field.IsValid and (ValueChecked <> '') and (ValueUnchecked <> '') then + begin + if not (csDesigning in FCheckBox.ComponentState) then + FCheckBox.ReadOnly := not Field.CanModify; + if not Field.IsNull then + FCheckBox.Checked := AnsiCompareText(Field.AsString, ValueUnchecked) <> 0 + else + FCheckBox.State := cbGrayed; + end + else + begin + FCheckBox.State := cbGrayed; + if not (csDesigning in FCheckBox.ComponentState) then + FCheckBox.ReadOnly := True; + end; +end; + +procedure TJvCheckBoxDataConnector.UpdateData; +begin + if Field.CanModify and Field.IsValid and (ValueChecked <> '') and (ValueUnchecked <> '') then + begin + if FCheckBox.Checked then + Field.AsString := ValueChecked + else + Field.AsString := ValueUnchecked; + end; +end; + +procedure TJvCheckBoxDataConnector.SetValueChecked(const Value: string); +begin + if Value <> FValueChecked then + begin + FValueChecked := Value; + Reset; + end; +end; + +procedure TJvCheckBoxDataConnector.SetValueUnchecked(const Value: string); +begin + if Value <> FValueUnchecked then + begin + FValueUnchecked := Value; + Reset; + end; +end; +***) + +//=== { TJvCheckBox } ======================================================== + +constructor TJvCheckBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + (***************** NOT CONVERTED *** + FDataConnector := CreateDataConnector; + FCanvas := TControlCanvas.Create; + FCanvas.Control := Self; + FHotTrack := False; + FHotTrackFont := TFont.Create; + FFontSave := TFont.Create; + FHotTrackFontOptions := DefaultTrackFontOptions; + FAutoSize := True; + FWordWrap := False; + FAlignment := taLeftJustify; + FLeftText := False; + FLayout := tlCenter; + FReadOnly := False; + ***) + FLinkedControls := TJvLinkedControls.Create(Self); + FLinkedControls.OnChange := @LinkedControlsChange; +end; + +destructor TJvCheckBox.Destroy; +begin + (************* NOT CONVERTED *** + FHotTrackFont.Free; + FFontSave.Free; + FDataConnector.Free; + *) + FreeAndNil(FLinkedControls); + inherited Destroy; + (************* NOT CONVERTED *** + // (rom) destroy Canvas AFTER inherited Destroy + FCanvas.Free; + ***) +end; + +procedure TJvCheckBox.Loaded; +begin + inherited Loaded; + CheckLinkedControls; + (************* NOT CONVERTED *** + CalcAutoSize; + DataConnector.Reset; + *) +end; + + +(************* NOT CONVERTED *** +function TJvCheckBox.CreateDataConnector: TJvCheckBoxDataConnector; +begin + Result := TJvCheckBoxDataConnector.Create(Self); +end; + +procedure TJvCheckBox.DoExit; +begin + try + DataConnector.UpdateRecord; + except + SetFocus; + raise; + end; + inherited DoExit; +end; + +function TJvCheckBox.GetCanvas: TCanvas; +begin + Result := FCanvas; +end; + +procedure TJvCheckBox.KeyPress(var Key: Char); +begin + inherited KeyPress(Key); + case Key of + #8, ' ': + DataConnector.Modify; + #27: + DataConnector.Reset; + end; +end; + +procedure TJvCheckBox.SetDataConnector(const Value: TJvCheckBoxDataConnector); +begin + if Value <> FDataConnector then + FDataConnector.Assign(Value); +end; +*) + +(******************** TO DO (Font HotTracking) *** +procedure TJvCheckBox.CreateParams(var Params: TCreateParams); +const + cAlign: array [TAlignment] of Word = (BS_LEFT, BS_RIGHT, BS_CENTER); + cLeftText: array [Boolean] of Word = (0, BS_RIGHTBUTTON); + cLayout: array [TTextLayout] of Word = (BS_TOP, BS_VCENTER, BS_BOTTOM); + cWordWrap: array [Boolean] of Word = (0, BS_MULTILINE); +begin + inherited CreateParams(Params); + with Params do + Style := Style or cAlign[Alignment] or cLayout[Layout] or + cLeftText[LeftText] or cWordWrap[WordWrap]; +end; + +procedure TJvCheckBox.MouseEnter; +begin + if csDesigning in ComponentState then + Exit; + if FHotTrack then + begin + FFontSave.Assign(Font); + Font.Assign(FHotTrackFont); + end; + inherited MouseEnter; +end; + +procedure TJvCheckBox.MouseLeave; +begin + if FHotTrack then + Font.Assign(FFontSave); + inherited MouseLeave; +end; + +procedure TJvCheckBox.FontChanged; +begin + inherited FontChanged; + CalcAutoSize; + UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions); +end; + +procedure TJvCheckBox.UpdateProperties; +begin + RecreateWnd(self); +end; + +procedure TJvCheckBox.TextChanged; +begin + inherited TextChanged; + CalcAutoSize; +end; + +procedure TJvCheckBox.SetClientSize(W, H: Integer); +var + Client: TRect; +begin + Client := GetClientRect; + SetBounds(Left, Top, Width - Client.Right + W, Height - Client.Bottom + H); +end; + +procedure TJvCheckBox.CalcAutoSize; +const + Flags: array [Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK); +var + AWidth, AHeight: Integer; + ASize: TSize; + R: TRect; +begin + if (Parent = nil) or not AutoSize or (csDestroying in ComponentState) or + (csLoading in ComponentState) then + Exit; + ASize := GetDefaultCheckBoxSize; + // add some spacing + Inc(ASize.cy, 4); + FCanvas.Font := Font; + // This is slower than GetTextExtentPoint but it does consider hotkeys + if Caption <> '' then + begin + R := ClientRect; + DrawText(FCanvas, Caption, -1, R, Flags[WordWrap] or DT_LEFT or DT_NOCLIP or DT_CALCRECT); + AWidth := (R.Right - R.Left) + ASize.cx + 8; + AHeight := R.Bottom - R.Top; + end + else + begin + AWidth := ASize.cx; + AHeight := ASize.cy; + end; + if AWidth < ASize.cx then + AWidth := ASize.cx; + if AHeight < ASize.cy then + AHeight := ASize.cy; + SetClientSize(AWidth, AHeight); +end; + +procedure TJvCheckBox.SetHotTrackFont(const Value: TFont); +begin + FHotTrackFont.Assign(Value); +end; + +procedure TJvCheckBox.SetAutoSize(Value: Boolean); +begin + if FAutoSize <> Value then + begin + //inherited SetAutoSize(Value); + FAutoSize := Value; + if Value then + WordWrap := False; + CalcAutoSize; + end; +end; + +function TJvCheckBox.IsHotTrackFontStored: Boolean; +begin + Result := IsHotTrackFontDfmStored(HotTrackFont, Font, HotTrackFontOptions); +end; + +procedure TJvCheckBox.SetHotTrackFontOptions(const Value: TJvTrackFontOptions); +begin + if FHotTrackFontOptions <> Value then + begin + FHotTrackFontOptions := Value; + UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions); + end; +end; + +procedure TJvCheckBox.SetWordWrap(const Value: Boolean); +begin + if FWordWrap <> Value then + begin + FWordWrap := Value; + if Value then + AutoSize := False; + UpdateProperties; + end; +end; + +procedure TJvCheckBox.SetAlignment(const Value: TAlignment); +begin + if FAlignment <> Value then + begin + FAlignment := Value; + UpdateProperties; + end; +end; + +procedure TJvCheckBox.SetLayout(const Value: TTextLayout); +begin + if FLayout <> Value then + begin + FLayout := Value; + UpdateProperties; + end; +end; + +procedure TJvCheckBox.SetLeftText(const Value: Boolean); +begin + if FLeftText <> Value then + begin + FLeftText := Value; + UpdateProperties; + end; +end; +*) + +procedure TJvCheckBox.SetLinkedControls(const Value: TJvLinkedControls); +begin + FLinkedControls.Assign(Value); +end; + +procedure TJvCheckBox.CheckLinkedControls; +var + I: Integer; +begin + if not FCheckingLinkedControls then // prevent an infinite recursion + begin + FCheckingLinkedControls := True; + try + if LinkedControls <> nil then + for I := 0 to LinkedControls.Count - 1 do + with LinkedControls[I] do + if Control <> nil then + Control.Enabled := CheckLinkControlEnabled(Self.Enabled, Self.Checked, Options); + finally + FCheckingLinkedControls := False; + end; + end; +end; + +procedure TJvCheckBox.LinkedControlsChange(Sender: TObject); +begin + CheckLinkedControls; +end; + +procedure TJvCheckBox.ReadAssociated(Reader: TReader); +var + C: TComponent; +begin + if Owner <> nil then + C := Owner.FindComponent(Reader.ReadIdent) + else + C := nil; + if (C is TControl) and (LinkedControls <> nil) then + LinkedControls.Add.Control := TControl(C); +end; + +type + TWinControlAccess = class(TWinControl); + +procedure TJvCheckBox.SetFocus; +var + I: Integer; + FocusLinkedControl: TJvLinkedControl; + FocusTargetControl: TControl; +begin + inherited SetFocus; + + // We want to transfer our own focus either to our children or to + // the first focus accepting sibling, depending on the direction + // that the user asked for. + if GetKeyState(VK_SHIFT) >= 0 then + begin + for I := 0 to LinkedControls.Count - 1 do + begin + FocusLinkedControl := LinkedControls[I]; + if loForceFocus in FocusLinkedControl.Options then + begin + FocusTargetControl := FocusLinkedControl.Control; + if (FocusTargetControl is TWinControl) and TWinControl(FocusTargetControl).CanFocus then + begin + TWinControl(FocusTargetControl).SetFocus; + Break; // found the new focus owner + end; + end; + end; + end + else + if LinkedControls.Count > 0 then + TWinControlAccess(Parent).SelectNext(Self, False, True); +end; + +procedure TJvCheckBox.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + Filer.DefineProperty('Associated', @ReadAssociated, nil, False); +end; + +(******************** NOT CONVERTED *** +procedure TJvCheckBox.BmSetCheck(var Msg: TMessage); +begin +// if not ReadOnly then +// begin + inherited; + CheckLinkedControls; +// end; +end; +***) + +procedure TJvCheckbox.DoClickOnChange; +begin + inherited; + CheckLinkedControls; +end; + +procedure TJvCheckBox.EnabledChanged; +begin + inherited EnabledChanged; + CheckLinkedControls; +end; + +procedure TJvCheckBox.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if Assigned(FLinkedControls) then + LinkedControls.Notification(AComponent, Operation); +end; + +procedure TJvCheckBox.SetChecked(AValue: Boolean); +begin + inherited; + CheckLinkedControls; +end; + +procedure TJvCheckBox.Toggle; +begin + (****************** NOT CONVERTED *** + if not ReadOnly then + begin + ************************************) + inherited; + CheckLinkedControls; + (****************** NOT CONVERTED *** + if not (csLoading in ComponentState) then + DataConnector.Modify; + end; + ***********************************) +end; + + +end. diff --git a/components/jvcllaz/run/JvStdCtrls/jvlinkedcontrols.pas b/components/jvcllaz/run/JvStdCtrls/jvlinkedcontrols.pas new file mode 100644 index 000000000..92e657e8e --- /dev/null +++ b/components/jvcllaz/run/JvStdCtrls/jvlinkedcontrols.pas @@ -0,0 +1,283 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvLinkedControls.PAS, released on 2004-01-26. + +The Initial Developer of the Original Code is Peter Thörnqvist +Portions created by Peter Thörnqvist are Copyright (C) 2004 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvLinkedControls; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Controls, Classes; + +type + TJvLinkedControlsOption = (loLinkChecked, loLinkEnabled, loInvertChecked, loInvertEnabled, loForceFocus); + TJvLinkedControlsOptions = set of TJvLinkedControlsOption; + + TJvLinkedControl = class(TCollectionItem) + private + FOwnerControl, FControl: TControl; + FOptions: TJvLinkedControlsOptions; + FOriginalEnabled: Boolean; + procedure SetControl(const Value: TControl); + procedure SetOptions(const Value: TJvLinkedControlsOptions); + protected + function GetDisplayName: string; override; + public + constructor Create(ACollection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + published + property Control: TControl read FControl write SetControl; + property Options: TJvLinkedControlsOptions read FOptions write SetOptions default [loLinkChecked, loLinkEnabled]; + end; + + TJvLinkedControls = class(TOwnedCollection) + private + FControl: TControl; + FOnChange: TNotifyEvent; + FRestoreEnabled: Boolean; + function GetItems(Index: Integer): TJvLinkedControl; + procedure SetItems(Index: Integer; const Value: TJvLinkedControl); + protected + procedure Update(Item: TCollectionItem); override; + public + // You must call Notification in the Owning controls overridden Notification + // or hell will break loose when linked controls are removed!!! + procedure Notification(AComponent: TComponent; Operation: TOperation); virtual; + constructor Create(AControl: TControl); + function Add: TJvLinkedControl; + procedure Assign(Source: TPersistent); override; + // If RestoreEnabled is True, TJvLinkedControls will try to restore the Enabled state + // of linked controls when an item is changed or removed + property Items[Index: Integer]: TJvLinkedControl read GetItems write SetItems; default; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property RestoreEnabled: Boolean read FRestoreEnabled write FRestoreEnabled default True; + end; + +function CheckLinkControlEnabled(Enabled, Checked: Boolean; Options: TJvLinkedControlsOptions): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JVCL\run' + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JvResources; + +function CheckLinkControlEnabled(Enabled, Checked: Boolean; Options: TJvLinkedControlsOptions): Boolean; +var + IsChecked, IsEnabled: Boolean; +begin + if loInvertChecked in Options then + IsChecked := not Checked + else + IsChecked := Checked; + + if loInvertEnabled in Options then + IsEnabled := not Enabled + else + IsEnabled := Enabled; + + if (loLinkChecked in Options) and (loLinkEnabled in Options) then + Result := IsChecked and IsEnabled + else + Result := ((loLinkChecked in Options) and IsChecked) or ((loLinkEnabled in Options) and IsEnabled); + + // Result := ((loLinkChecked in Options) and ((not Checked and (loInvertChecked in Options) or (Checked and not (loInvertChecked in Options))))) or + // ((loLinkEnabled in Options) and (not Enabled and (loInvertEnabled in Options)) or (Enabled and not (loInvertEnabled in Options))); +end; + +//=== { TJvLinkedControl } =================================================== + +constructor TJvLinkedControl.Create(ACollection: TCollection); +begin + inherited Create(ACollection); + if (ACollection is TJvLinkedControls) then + FOwnerControl := TJvLinkedControls(ACollection).FControl; + FOptions := [loLinkChecked, loLinkEnabled]; +end; + +destructor TJvLinkedControl.Destroy; +begin + if (FControl <> nil) and not (csDestroying in FControl.ComponentState) and + (Collection is TJvLinkedControls) and TJvLinkedControls(Collection).RestoreEnabled then + FControl.Enabled := FOriginalEnabled; + inherited Destroy; +end; + +procedure TJvLinkedControl.Assign(Source: TPersistent); +begin + if Source is TJvLinkedControl then + begin + if Source <> Self then + begin + Control := TJvLinkedControl(Source).Control; + Options := TJvLinkedControl(Source).Options; + Changed(False); + end; + end + else + inherited Assign(Source); +end; + +function TJvLinkedControl.GetDisplayName: string; +begin + if Control <> nil then + Result := Control.Name + else + Result := inherited GetDisplayName; +end; + +procedure TJvLinkedControl.SetControl(const Value: TControl); +begin + if FControl <> Value then + begin + if (FOwnerControl = nil) and (Collection is TJvLinkedControls) then + FOwnerControl := TJvLinkedControls(Collection).FControl; + if (Value = FOwnerControl) and (FOwnerControl <> nil) then + raise Exception.CreateRes(@RsEOwnerLinkError); + if Assigned(FControl) then + begin + if Assigned(FOwnerControl) then + FControl.RemoveFreeNotification(FOwnerControl); + if (Collection is TJvLinkedControls) and TJvLinkedControls(Collection).RestoreEnabled and + not (csDestroying in FControl.ComponentState) then + FControl.Enabled := FOriginalEnabled; + end; + if (FOwnerControl <> nil) and (csDestroying in FOwnerControl.ComponentState) then + FControl := nil + else + FControl := Value; + if Assigned(FControl) then + begin + FOriginalEnabled := FControl.Enabled; + if Assigned(FOwnerControl) then + FControl.FreeNotification(FOwnerControl); + end; + Changed(False); + end; +end; + +procedure TJvLinkedControl.SetOptions(const Value: TJvLinkedControlsOptions); +begin + if FOptions <> Value then + begin + FOptions := Value; + Changed(False); + end; +end; + +//=== { TJvLinkedControls } ================================================== + +constructor TJvLinkedControls.Create(AControl: TControl); +begin + inherited Create(AControl, TJvLinkedControl); + FControl := AControl; + FRestoreEnabled := True; +end; + +function TJvLinkedControls.Add: TJvLinkedControl; +begin + Result := TJvLinkedControl(inherited Add); + Result.FOwnerControl := FControl; +end; + +procedure TJvLinkedControls.Assign(Source: TPersistent); +var + I: Integer; +begin + if Source is TJvLinkedControls then + begin + if Source <> Self then + begin + BeginUpdate; + try + Clear; + for I := 0 to TJvLinkedControls(Source).Count - 1 do + Add.Assign(TJvLinkedControls(Source)[I]); + RestoreEnabled := TJvLinkedControls(Source).RestoreEnabled; + finally + EndUpdate; + end; + end; + end + else + inherited Assign(Source); +end; + +function TJvLinkedControls.GetItems(Index: Integer): TJvLinkedControl; +begin + Result := TJvLinkedControl(inherited Items[Index]); +end; + +procedure TJvLinkedControls.Notification(AComponent: TComponent; Operation: TOperation); +var + I: Integer; +begin + if (Operation = opRemove) and (AComponent is TControl) then + begin + BeginUpdate; + try + for I := 0 to Count - 1 do + if Items[I].Control = AComponent then + Items[I].Control := nil; + finally + EndUpdate; + end; + end; +end; + +procedure TJvLinkedControls.SetItems(Index: Integer; const Value: TJvLinkedControl); +begin + inherited Items[Index] := Value; +end; + +procedure TJvLinkedControls.Update(Item: TCollectionItem); +begin + inherited Update(Item); + if Item <> nil then + TJvLinkedControl(Item).FOwnerControl := FControl; + if Assigned(FOnChange) then + FOnChange(Self); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end.