pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Add JvCheckbox (can disable linked controls).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6661 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-09-28 11:09:45 +00:00
parent f103e78625
commit 1c20854168
11 changed files with 1208 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
View File

@ -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.

1
components/jvcllaz/design/JvStdCtrls/images/images.txt
View File

@ -1 +1,2 @@
tjvcheckbox.bmp
tjvcalcedit.bmp

BIN
components/jvcllaz/design/JvStdCtrls/images/tjvcheckbox.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

82
components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpi Normal file
View File

@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="JvCheckBoxDemo"/>
<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>

22
components/jvcllaz/examples/JvCheckBox/JvCheckBoxDemo.lpr Normal file
View File

@ -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.

128
components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.lfm Normal file
View File

@ -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

47
components/jvcllaz/examples/JvCheckBox/jvcheckboxdemounit.pas Normal file
View File

@ -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.

10
components/jvcllaz/packages/JvStdCtrlsLazR.lpk
View File

@ -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>

BIN
components/jvcllaz/resource/JvStdCtrlsReg.res
View File

Binary file not shown.

634
components/jvcllaz/run/JvStdCtrls/jvcheckbox.pas Normal file
View File

@ -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.

283
components/jvcllaz/run/JvStdCtrls/jvlinkedcontrols.pas Normal file
View File

@ -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.