paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 07:58:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

started TDBCheckBox

Browse Source 
git-svn-id: trunk@4631 -
This commit is contained in:
mattias 2003-09-16 11:35:14 +00:00
parent ae92ebc5f5
commit 55955882c7
11 changed files with 286 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -806,6 +806,7 @@ lcl/include/custompanel.inc svneol=native#text/pascal
lcl/include/customradiogroup.inc svneol=native#text/pascal
lcl/include/customstatictext.inc svneol=native#text/pascal
lcl/include/customupdown.inc svneol=native#text/pascal
lcl/include/dbcheckbox.inc svneol=native#text/pascal
lcl/include/dbedit.inc svneol=native#text/pascal
lcl/include/dblistbox.inc svneol=native#text/pascal
lcl/include/dbradiogroup.inc svneol=native#text/pascal

10
lcl/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/09/02]
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/09/12]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx
@ -246,7 +246,7 @@ override REQUIRE_PACKAGESDIR+=$(LCLCOMPONENTDIR)
override COMPILER_UNITDIR+=$(LCLUNITDIR)
override TARGET_DIRS+=interfaces
override TARGET_UNITS+=allunits
override TARGET_IMPLICITUNITS+=arrow actnlist buttons calendar clipbrd clistbox comctrls commctrl controls dialogs dynamicarray dynhasharray extctrls extendedstrings filectrl forms graphics graphmath graphtype grids imglist interfacebase lazqueue lclmemmanager lcllinux lclstrconsts lcltype lmessages lresources maskedit menus messages registry spin stdctrls stringhashlist toolwin utrace vclglobals printers postscriptprinter intfgraphics
override TARGET_IMPLICITUNITS+=arrow actnlist buttons calendar clipbrd clistbox comctrls commctrl controls dialogs dynamicarray dynhasharray extctrls extendedstrings filectrl forms graphics graphmath graphtype grids imglist interfacebase lazlinkedlist lclmemmanager lcllinux lclstrconsts lcltype lmessages lresources maskedit menus messages registry spin stdctrls stringhashlist toolwin utrace vclglobals printers postscriptprinter intfgraphics dbctrls
override TARGET_RSTS+=dialogs
override CLEAN_FILES+=$(wildcard units/*$(OEXT)) $(wildcard units/*$(PPUEXT)) $(wildcard units/*$(RSTEXT))$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
override INSTALL_BUILDUNIT=allunits
@ -1684,7 +1684,7 @@ fpc_debug:
$(MAKE) all DEBUG=1
fpc_release:
$(MAKE) all RELEASE=1
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp .rc .res
%$(PPUEXT): %.pp
$(COMPILER) $<
$(EXECPPAS)
@ -1697,14 +1697,10 @@ fpc_release:
%$(EXEEXT): %.pas
$(COMPILER) $<
$(EXECPPAS)
%$(EXEEXT): %.dpr
$(COMPILER) $<
$(EXECPPAS)
%.res: %.rc
windres -i $< -o $@
vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
ifdef INSTALL_UNITS

4
lcl/Makefile.fpc
View File

@ -13,10 +13,10 @@ units=allunits
implicitunits=arrow actnlist buttons calendar clipbrd clistbox comctrls \
commctrl controls dialogs dynamicarray dynhasharray extctrls \
extendedstrings filectrl forms graphics graphmath graphtype grids \
imglist interfacebase lazqueue lclmemmanager lcllinux lclstrconsts \
imglist interfacebase lazlinkedlist lclmemmanager lcllinux lclstrconsts \
lcltype lmessages lresources maskedit menus messages registry spin \
stdctrls stringhashlist toolwin utrace vclglobals printers \
postscriptprinter intfgraphics
postscriptprinter intfgraphics dbctrls
# and do not add allunits. It is just a dummy unit used for compiling.
rsts=dialogs

6
lcl/allunits.pp
View File

@ -38,7 +38,8 @@ uses
Buttons, Extctrls, Registry, Calendar, Clipbrd, Forms, LCLLinux, Spin,
Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
Printers, PostScriptPrinter, CheckLst, PairSplitter, DirSel, ExtDlgs;
Printers, PostScriptPrinter, CheckLst, PairSplitter, DirSel, ExtDlgs,
DBCtrls;
implementation
@ -47,6 +48,9 @@ end.
{ =============================================================================
$Log$
Revision 1.29 2003/09/16 11:35:14 mattias
started TDBCheckBox
Revision 1.28 2003/09/02 21:32:56 mattias
implemented TOpenPictureDialog

87
lcl/dbctrls.pp
View File

@ -37,7 +37,7 @@ interface
uses
Classes, SysUtils, DB, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
MaskEdit, LMessages;
MaskEdit, LMessages, ExtCtrls;
Type
{ TFieldDataLink }
@ -191,7 +191,7 @@ Type
function GetDataSource: TDataSource;
function GetField: TField;
Procedure SetItems(Values : TStrings);
Procedure SetItems(Values : TStrings); override;
function GetReadOnly: Boolean;
procedure SetReadOnly(Value: Boolean);
@ -254,6 +254,7 @@ Type
procedure UpdateData(Sender: TObject);
property DataLink: TFieldDataLink read FDataLink;
function GetButtonValue(Index: Integer): string;
procedure UpdateRadioButtonStates; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -282,9 +283,87 @@ Type
end;
{ TDBCheckBox }
TDBCheckBox = class(TCustomCheckBox)
private
FDataLink: TFieldDataLink;
FValueCheck: string;
FValueUncheck: string;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const AValue: string);
procedure SetDataSource(const AValue: TDataSource);
procedure SetReadOnly(const AValue: Boolean);
procedure SetValueCheck(const AValue: string);
procedure SetValueUncheck(const AValue: string);
function ValueEqualsField(const AValue, AFieldText: string): boolean;
protected
function GetFieldCheckState: TCheckBoxState; virtual;
procedure DataChange(Sender: TObject); virtual;
procedure UpdateData(Sender: TObject); virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property Checked;
property Field: TField read GetField;
property State;
published
property AllowGrayed;
property Anchors;
property AutoSize;
property Caption;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Hint;
property OnChange;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property UseOnChange;
property ValueChecked: string read FValueCheck write SetValueCheck;
property ValueUnchecked: string read FValueUncheck write SetValueUncheck;
property Visible;
end;
// ToDo: Move this to db.pp
function ExtractFieldName(const Fields: string; var StartPos: Integer): string;
implementation
function ExtractFieldName(const Fields: string; var StartPos: Integer): string;
var
i: Integer;
begin
i:=StartPos;
while (i<=Length(Fields)) and (Fields[i]<>';') do Inc(i);
Result:=Trim(Copy(Fields,StartPos,i-StartPos));
if (i<=Length(Fields)) and (Fields[i]=';') then Inc(i);
StartPos:=i;
end;
{TFieldDataLink Private Methods}
{hack around broken Field method by using this instead}
@ -595,12 +674,16 @@ end;
{$Include dbtext.inc}
{$Include dblistbox.inc}
{$Include dbradiogroup.inc}
{$Include dbcheckbox.inc}
end.
{ =============================================================================
$Log$
Revision 1.4 2003/09/16 11:35:14 mattias
started TDBCheckBox
Revision 1.3 2003/09/15 22:02:02 mattias
implemented TDBRadioGroup

5
lcl/extctrls.pp
View File

@ -433,7 +433,7 @@ type
procedure Clicked(Sender: TObject); virtual;
procedure DoPositionButtons;
protected
procedure UpdateRadioButtonStates;
procedure UpdateRadioButtonStates; virtual;
procedure ReadState(Reader: TReader); override;
procedure SetItem(Value: TStrings);
procedure SetColumns(Value: integer);
@ -756,6 +756,9 @@ end.
{
$Log$
Revision 1.73 2003/09/16 11:35:14 mattias
started TDBCheckBox
Revision 1.72 2003/09/15 22:02:02 mattias
implemented TDBRadioGroup

4
lcl/include/checkbox.inc
View File

@ -18,7 +18,6 @@
constructor TCheckbox.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
fCompStyle := csCheckbox;
AutoSize := True;
end;
@ -70,6 +69,9 @@ end;
{
$Log$
Revision 1.9 2003/09/16 11:35:14 mattias
started TDBCheckBox
Revision 1.8 2002/10/03 00:08:50 lazarus
AJ: TCustomLabel Autosize, TCustomCheckbox '&' shortcuts started

4
lcl/include/customcheckbox.inc
View File

@ -83,6 +83,7 @@ end;
constructor TCustomCheckBox.Create(TheOwner : TComponent);
begin
Inherited Create(TheOwner);
fCompStyle := csCheckbox;
FState := cbUnchecked;
FAllowGrayed := True;
Height:=20;
@ -193,6 +194,9 @@ end;
{
$Log$
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

149
lcl/include/dbcheckbox.inc Normal file
View File

@ -0,0 +1,149 @@
// included by dbctrls.pas
{
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
{ TDBCheckBox }
function TDBCheckBox.GetDataField: string;
begin
Result:=FDataLink.FieldName;
end;
function TDBCheckBox.GetDataSource: TDataSource;
begin
Result:=FDataLink.DataSource;
end;
function TDBCheckBox.GetField: TField;
begin
Result:=FDataLink.Field;
end;
function TDBCheckBox.GetReadOnly: Boolean;
begin
Result:=FDataLink.ReadOnly;
end;
procedure TDBCheckBox.SetDataField(const AValue: string);
begin
FDataLink.FieldName:=AValue;
end;
procedure TDBCheckBox.SetDataSource(const AValue: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource:=AValue;
if AValue<>nil then
AValue.FreeNotification(Self);
end;
procedure TDBCheckBox.SetReadOnly(const AValue: Boolean);
begin
FDataLink.ReadOnly:=AValue;
end;
procedure TDBCheckBox.SetValueCheck(const AValue: string);
begin
if FValueCheck=AValue then exit;
FValueCheck:=AValue;
DataChange(Self);
end;
procedure TDBCheckBox.SetValueUncheck(const AValue: string);
begin
if FValueUncheck=AValue then exit;
FValueUncheck:=AValue;
DataChange(Self);
end;
function TDBCheckBox.GetFieldCheckState: TCheckBoxState;
var
FieldText: string;
begin
if FDatalink.Field=nil then begin
Result:=cbUnchecked;
exit;
end;
if FDataLink.Field.IsNull then
Result:=cbGrayed
else if FDataLink.Field.DataType = ftBoolean then begin
if FDataLink.Field.AsBoolean then
Result:=cbChecked
else
Result:=cbUnchecked;
end else begin
Result:=cbGrayed;
// ToDo: use Field.Text
FieldText:=FDataLink.Field.DisplayText;
if ValueEqualsField(FValueCheck,FieldText) then
Result:=cbChecked
else if ValueEqualsField(FValueUncheck,FieldText) then
Result:=cbUnchecked;
end;
end;
procedure TDBCheckBox.DataChange(Sender: TObject);
begin
State:=GetFieldCheckState;
end;
procedure TDBCheckBox.UpdateData(Sender: TObject);
var
NewFieldText: string;
begin
if State = cbGrayed then
FDataLink.Field.Clear
else
if FDataLink.Field.DataType = ftBoolean then
FDataLink.Field.AsBoolean:=Checked
else begin
if Checked then
NewFieldText:=FValueCheck
else
NewFieldText:=FValueUncheck;
// ToDo: use Field.Text
FDataLink.Field.AsString:=Trim(NewFieldText);
end;
end;
function TDBCheckBox.ValueEqualsField(const AValue, AFieldText: string
): boolean;
begin
Result:=AnsiCompareText(AValue,AFieldText)=0;
end;
constructor TDBCheckBox.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FValueCheck:='True';
FValueUncheck:='False';
ControlStyle:=ControlStyle+[csReplicatable];
State:=cbUnchecked;
FDataLink:=TFieldDataLink.Create;
FDataLink.Control:=Self;
FDataLink.OnDataChange:=@DataChange;
FDataLink.OnUpdateData:=@UpdateData;
end;
destructor TDBCheckBox.Destroy;
begin
FDataLink.Free;
FDataLink:=nil;
inherited Destroy;
end;
// included by dbctrls.pas

18
lcl/include/dbradiogroup.inc
View File

@ -105,7 +105,8 @@ end;
procedure TDBRadioGroup.DataChange(Sender: TObject);
begin
if FDataLink.Field<>nil then
Value:=FDataLink.Field.Text
// ToDo: Use Field.Text
Value:=FDataLink.Field.DisplayText
else
Value:='';
end;
@ -113,7 +114,8 @@ end;
procedure TDBRadioGroup.UpdateData(Sender: TObject);
begin
if FDataLink.Field<>nil then
FDataLink.Field.Text:=Value;
// ToDo: Use Field.Text
FDataLink.Field.AsString:=Value;
end;
function TDBRadioGroup.GetButtonValue(Index: Integer): string;
@ -126,6 +128,18 @@ begin
Result:='';
end;
procedure TDBRadioGroup.UpdateRadioButtonStates;
var
OldValue: String;
begin
OldValue:=Value;
inherited UpdateRadioButtonStates;
Value := GetButtonValue(ItemIndex);
if (Value<>OldValue) then begin
if FDataLink.Editing then FDataLink.Modified;
end;
end;
constructor TDBRadioGroup.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);

23
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -5484,8 +5484,10 @@ var
gdkRect : TGDKRectangle;
Widget, PaintWidget: PGtkWidget;
LCLObject: TObject;
{$IfDef Win32}
AWindow: PGdkWindow;
Event : TGDKEvent;
{$ENDIF}
begin
// Writeln(format('Rect = %d,%d,%d,%d',[rect^.left,rect^.top,rect^.Right,rect^.Bottom]));
Widget:=PGtkWidget(aHandle);
@ -5526,21 +5528,21 @@ begin
end;
{$EndIf}
{$IfNDef Win32}
{$IfDef Win32}
if bErase then begin
AWindow:=GetControlWindow(PaintWidget);
if AWindow<>nil then
gdk_window_clear_area(AWindow,
gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
end;
gtk_widget_draw(PaintWidget, @gdkRect);
{$Else}
if bErase then
gtk_widget_queue_clear_area(PaintWidget,
gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
gtk_widget_queue_draw_area(PaintWidget,
gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
{$Else}
if bErase then begin
AWindow:=GetControlWindow(PaintWidget);
if AWindow<>nil then
gdk_window_clear_area(AWindow,
gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
end;
gtk_widget_draw(PaintWidget, @gdkRect);
{$EndIf}
end;
@ -8775,6 +8777,9 @@ end;
{ =============================================================================
$Log$
Revision 1.282 2003/09/16 11:35:14 mattias
started TDBCheckBox
Revision 1.281 2003/09/15 15:43:04 mattias
fixed gtk2interface package