diff --git a/.gitattributes b/.gitattributes index 9ef74b3846..7bc679a085 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/lcl/Makefile b/lcl/Makefile index 36f0397612..0f4158c0ed 100644 --- a/lcl/Makefile +++ b/lcl/Makefile @@ -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 diff --git a/lcl/Makefile.fpc b/lcl/Makefile.fpc index 118ed0edbb..1727df7186 100644 --- a/lcl/Makefile.fpc +++ b/lcl/Makefile.fpc @@ -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 diff --git a/lcl/allunits.pp b/lcl/allunits.pp index 6f0a59680e..83793cedc3 100644 --- a/lcl/allunits.pp +++ b/lcl/allunits.pp @@ -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 diff --git a/lcl/dbctrls.pp b/lcl/dbctrls.pp index 5d5203c508..c499a0da3b 100644 --- a/lcl/dbctrls.pp +++ b/lcl/dbctrls.pp @@ -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 diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 804c2d1d92..c00b64241e 100644 --- a/lcl/extctrls.pp +++ b/lcl/extctrls.pp @@ -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 diff --git a/lcl/include/checkbox.inc b/lcl/include/checkbox.inc index d1f8d3876f..763299a925 100644 --- a/lcl/include/checkbox.inc +++ b/lcl/include/checkbox.inc @@ -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 diff --git a/lcl/include/customcheckbox.inc b/lcl/include/customcheckbox.inc index 203da4cef8..fd121155c3 100644 --- a/lcl/include/customcheckbox.inc +++ b/lcl/include/customcheckbox.inc @@ -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 diff --git a/lcl/include/dbcheckbox.inc b/lcl/include/dbcheckbox.inc new file mode 100644 index 0000000000..8bca4cc1e4 --- /dev/null +++ b/lcl/include/dbcheckbox.inc @@ -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 + diff --git a/lcl/include/dbradiogroup.inc b/lcl/include/dbradiogroup.inc index 1ad500e892..0e8f256b20 100644 --- a/lcl/include/dbradiogroup.inc +++ b/lcl/include/dbradiogroup.inc @@ -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); diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index e17a343819..9137c2f82d 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -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