new component - TRXDBCurrEdit

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1274 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2010-08-11 18:38:19 +00:00 · 2010-08-11 18:38:19 +00:00 · f285301da7
commit f285301da7
parent 6eda53c6b7
10 changed files with 309 additions and 18 deletions
--- a/components/rx/dbcurredit.pas
+++ b/components/rx/dbcurredit.pas
@ -0,0 +1,250 @@
+{ dbcurredit unit
+
+  Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+  First version By Daniel Simões de Almeida
+}
+
+unit dbcurredit ;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, LMessages, LCLType, Controls, Graphics,
+  DB, DbCtrls, curredit ;
+
+type
+
+  { TRxDBCurrEdit }
+
+  TRxDBCurrEdit = class(TCurrencyEdit)
+  private
+    FDataLink: TFieldDataLink;
+    procedure DoCheckEnable;
+    function GetDataField: string;
+    function GetDataSource: TDataSource;
+    function GetReadOnly: Boolean;
+    procedure SetDataField(const AValue: string);
+    procedure SetDataSource(const AValue: TDataSource);
+    procedure SetReadOnly(const AValue: Boolean);
+  protected
+    procedure ActiveChange(Sender:TObject);
+    procedure DataChange(Sender:TObject);
+    procedure EditingChange(Sender: TObject);
+    procedure UpdateData(Sender:TObject);
+    procedure CMExit(var Message:TLMessage); message CM_EXIT;
+    procedure LMCut(var Message: TLMessage); message LM_CUT;
+    procedure LMPaste(var Message: TLMessage); message LM_PASTE;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure Change; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure EditingDone; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property DataField: string read GetDataField write SetDataField;
+    property DataSource: TDataSource read GetDataSource write SetDataSource;
+    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+  end;
+
+implementation
+
+Uses math ;
+
+{ TRxDBCurrEdit }
+
+procedure TRxDBCurrEdit.DoCheckEnable;
+begin
+  Enabled:=FDataLink.Active and (FDataLink.Field<>nil) and (not FDataLink.Field.ReadOnly);
+end;
+
+function TRxDBCurrEdit.GetDataField: string;
+begin
+  Result:=FDataLink.FieldName;
+end;
+
+function TRxDBCurrEdit.GetDataSource: TDataSource;
+begin
+  Result:=FDataLink.DataSource;
+end;
+
+function TRxDBCurrEdit.GetReadOnly: Boolean;
+begin
+  Result:=FDataLink.ReadOnly;
+end;
+
+procedure TRxDBCurrEdit.SetDataField(const AValue: string);
+begin
+  try
+    FDataLink.FieldName:=AValue;
+  finally
+    DoCheckEnable;
+  end;
+end;
+
+procedure TRxDBCurrEdit.SetDataSource(const AValue: TDataSource);
+begin
+  FDataLink.DataSource:=AValue;
+  DoCheckEnable;
+end;
+
+procedure TRxDBCurrEdit.SetReadOnly(const AValue: Boolean);
+begin
+  FDataLink.ReadOnly:=AValue;
+end;
+
+procedure TRxDBCurrEdit.ActiveChange(Sender: TObject);
+begin
+  DoCheckEnable;
+end;
+
+procedure TRxDBCurrEdit.DataChange(Sender: TObject);
+begin
+  if Assigned(FDataLink.Field) and
+    (FDataLink.Field is TNumericField) then
+  begin
+    if FDataLink.Field.IsNull then
+      Text:=''
+    else
+      Self.Value := SimpleRoundTo( FDataLink.Field.AsFloat, -DecimalPlaces) ;
+  end
+  else Text:='';
+end;
+
+procedure TRxDBCurrEdit.EditingChange(Sender: TObject);
+begin
+  inherited ReadOnly := not FDataLink.Editing;
+{  if FDataLink.Editing and DefaultToday and (FDataLink.Field <> nil) and
+    (FDataLink.Field.AsDateTime = NullDate) then
+    FDataLink.Field.AsDateTime := SysUtils.Now;}
+end;
+
+procedure TRxDBCurrEdit.UpdateData(Sender: TObject);
+begin
+  if Assigned(FDataLink.Field) then
+  begin
+    if Self.Text<>'' then
+      FDataLink.Field.AsFloat := SimpleRoundTo( Self.Value, -Self.DecimalPlaces)
+    else
+      FDataLink.Field.Clear;
+  end;
+end;
+
+procedure TRxDBCurrEdit.CMExit(var Message: TLMessage);
+begin
+  try
+    FDataLink.UpdateRecord;
+  except
+    SetFocus;
+    SelectAll;
+    raise;
+  end;
+  inherited;
+end;
+
+procedure TRxDBCurrEdit.LMCut(var Message: TLMessage);
+begin
+  FDataLink.Edit;
+  inherited;
+end;
+
+procedure TRxDBCurrEdit.LMPaste(var Message: TLMessage);
+begin
+  FDataLink.Edit;
+  inherited;
+end;
+
+procedure TRxDBCurrEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if Key=VK_ESCAPE then
+  begin
+    //cancel out of editing by reset on esc
+    FDataLink.Reset;
+    SelectAll;
+    Key := VK_UNKNOWN;
+  end
+  else
+  if (Key<>VK_UNKNOWN) then
+  begin
+    //make sure we call edit to ensure the datset is in edit,
+    //this is for where the datasource is in autoedit, so we aren't
+    //read only even though the dataset isn't realy in edit
+    FDataLink.Edit;
+  end;
+end;
+
+procedure TRxDBCurrEdit.Change;
+begin
+  FDataLink.Modified;
+  inherited Change;
+end;
+
+procedure TRxDBCurrEdit.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  // if the datasource is being removed then we need to make sure
+  // we are updated or we can get AV/Seg's *cough* as I foolishly
+  // discovered firsthand....
+  if (Operation=opRemove) then
+  begin
+    if (FDataLink<>nil) and (AComponent=DataSource) then
+      DataSource:=nil;
+  end;
+end;
+
+procedure TRxDBCurrEdit.EditingDone;
+begin
+  inherited EditingDone;
+  if FDataLink.CanModify then
+    FDataLink.UpdateRecord;
+end;
+
+constructor TRxDBCurrEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDataLink:=TFieldDataLink.Create;
+  FDataLink.Control:=Self;
+  FDataLink.OnActiveChange:=@ActiveChange;
+  FDataLink.OnDataChange:=@DataChange;
+  FDataLink.OnUpdateData:=@UpdateData;
+end;
+
+destructor TRxDBCurrEdit.Destroy;
+begin
+  FreeAndNil(FDataLink);
+  inherited Destroy;
+end;
+
+end.
+
--- a/components/rx/images/TRxDBCurrEdit.png
+++ b/components/rx/images/TRxDBCurrEdit.png
--- a/components/rx/images/mk_res.bat
+++ b/components/rx/images/mk_res.bat
@ -1,2 +1,2 @@
 del rx.lrs
-D:\lazarus\tools\lazres.exe rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.bmp TRxClock.bmp TRxSpeedButton.bmp TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png
+c:\lazarus\tools\lazres.exe rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png TRxAboutDialog.png TRxDBCurrEdit.png
--- a/components/rx/images/mk_res.sh
+++ b/components/rx/images/mk_res.sh
@ -1,2 +1,2 @@
 rm rx.lrs
-/usr/local/share/lazarus/tools/lazres rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png TRxAboutDialog.png
+/usr/local/share/lazarus/tools/lazres rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png TRxAboutDialog.png TRxDBCurrEdit.png
--- a/components/rx/images/rx.lrs
+++ b/components/rx/images/rx.lrs
@ -610,3 +610,20 @@ LazarusResources.Add('TRxAboutDialog','PNG',[
  +#242'O~'#248#211#17#145#251#127#238#12'o'#239#175'R'#255#176#141'Ys'#0#0#0#0
  +'IEND'#174'B`'#130
 ]);
+LazarusResources.Add('TRxDBCurrEdit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135
+  +#0#0#1'HIDATx'#218#237#151'A'#14#131' '#16'E'#165#139#246#6#158#199#243#224
+  +'!JO'#208'Ma'#231#162'7'#209'e'#23#158#137':'#137#180#160'B-'#181#14'$'#243
+  +#19#3#26#193#255#252#163'(+2'#23#195'6@'#0#216#6#8#0#219#0#1'`'#27' '#0'l'#3
+  +#4#128'm'#128#0'b'#7'r'#206#181#233'+'#165#134'y'#180#14#143'`'#127#185'YQ'
+  +#147#130'y)'#213'k'#191#174#249#8#225#19#192'%'#2'05'#31#134'XJe['#144'('#0
+  +'h'#167#9#128#202#178#156#157'/'#196#217#234'_'#130's'#11'!'#190#246#19#157
+  +#128'1m`'#198#4'<'#163#244#154'KE%'#179'i'#9'I)c<'#20']'#215#21'UU'#237#7#0
+  +#237'R'#9'}'#2'`c'#249#235#225#209#176#251#187#3#248'Jhm'#2'`^['#207'7'#10
+  +#192'T'#6#128'-'#172#8#211'c'#232#0#208'.'#149#144'Rn'#2#246#219'?)'#128'P'#9
+  +'e'#145#128#127'!{'''#224#26'N'#12#0'Z'#223'['#200#152#181'M'''#5'`C'#216#186
+  +#222'dq:'#188#247#147'M'#0#212'4w'#221#247#15#199#252#145#249#204#206#161'P'
+  +#1#134#239#21'=l'#142#129#213#23'Ka!'#251#5#192''''#20#128#182'm7'#3#0#237#13
+  +#144#204#175'h2F'#8' W'#17#0#182#8#0'['#4#128'-'#2#192#22#1'`'#139#0#176#149
+  +'='#192#19'C'#237#245'1T'#130#194#231#0#0#0#0'IEND'#174'B`'#130
+]);
--- a/components/rx/registerrx.pas
+++ b/components/rx/registerrx.pas
@ -42,7 +42,7 @@ procedure Register;

 implementation
 uses
-  PropEdits, dbdateedit, rxlookup, folderlister, rxmemds, duallist,
+  PropEdits, dbdateedit, dbcurredit, rxlookup, folderlister, rxmemds, duallist,
  curredit, rxswitch, rxdice, rxdbcomb, rxtoolbar, rxxpman, PageMngr, RxAppIcon,
  Dialogs, ComponentEditors, seldsfrm, DBPropEdits, DB, rxctrls, RxLogin,
  RxCustomChartPanel, AutoPanel, pickdate, rxconst, tooledit, rxclock,
@ -94,7 +94,7 @@ end;

 procedure RegisterUnitDBDateEdit;
 begin
-  RegisterComponents('RX DBAware',[TDBDateEdit, TRxDBCalcEdit]);
+  RegisterComponents('RX DBAware',[TDBDateEdit, TRxDBCalcEdit, TRxDBCurrEdit]);
 end;

 procedure RegisterRXLookup;
--- a/components/rx/rx.lrs
+++ b/components/rx/rx.lrs
@ -610,3 +610,20 @@ LazarusResources.Add('TRxAboutDialog','PNG',[
  +#242'O~'#248#211#17#145#251#127#238#12'o'#239#175'R'#255#176#141'Ys'#0#0#0#0
  +'IEND'#174'B`'#130
 ]);
+LazarusResources.Add('TRxDBCurrEdit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135
+  +#0#0#1'HIDATx'#218#237#151'A'#14#131' '#16'E'#165#139#246#6#158#199#243#224
+  +'!JO'#208'Ma'#231#162'7'#209'e'#23#158#137':'#137#180#160'B-'#181#14'$'#243
+  +#19#3#26#193#255#252#163'(+2'#23#195'6@'#0#216#6#8#0#219#0#1'`'#27' '#0'l'#3
+  +#4#128'm'#128#0'b'#7'r'#206#181#233'+'#165#134'y'#180#14#143'`'#127#185'YQ'
+  +#147#130'y)'#213'k'#191#174#249#8#225#19#192'%'#2'05'#31#134'XJe['#144'('#0
+  +'h'#167#9#128#202#178#156#157'/'#196#217#234'_'#130's'#11'!'#190#246#19#157
+  +#128'1m`'#198#4'<'#163#244#154'KE%'#179'i'#9'I)c<'#20']'#215#21'UU'#237#7#0
+  +#237'R'#9'}'#2'`c'#249#235#225#209#176#251#187#3#248'Jhm'#2'`^['#207'7'#10
+  +#192'T'#6#128'-'#172#8#211'c'#232#0#208'.'#149#144'Rn'#2#246#219'?)'#128'P'#9
+  +'e'#145#128#127'!{'''#224#26'N'#12#0'Z'#223'['#200#152#181'M'''#5'`C'#216#186
+  +#222'dq:'#188#247#147'M'#0#212'4w'#221#247#15#199#252#145#249#204#206#161'P'
+  +#1#134#239#21'=l'#142#129#213#23'Ka!'#251#5#192''''#20#128#182'm7'#3#0#237#13
+  +#144#204#175'h2F'#8' W'#17#0#182#8#0'['#4#128'-'#2#192#22#1'`'#139#0#176#149
+  +'='#192#19'C'#237#245'1T'#130#194#231#0#0#0#0'IEND'#174'B`'#130
+]);
--- a/components/rx/rxappicon.pas
+++ b/components/rx/rxappicon.pas
@ -33,6 +33,10 @@ unit rxappicon;

 {$mode objfpc}{$H+}

+{$IFDEF LCLQT}
+ {$DEFINE LCLGtk2}
+{$ENDIF}
+
 interface

 uses
@ -67,7 +71,7 @@ type
 implementation
 {$IFDEF WIN32}
 {$IFNDEF LCLGtk2} 
-uses Windows, win32int, InterfaceBase, vclutils;
+uses Windows, Win32Int, InterfaceBase, vclutils;
 {$ENDIF}
 {$ENDIF}

--- a/components/rx/rxnew.lpk
+++ b/components/rx/rxnew.lpk
@ -5,7 +5,7 @@
    <Name Value="rxnew"/>
    <Author Value="Lagunov Aleksey"/>
    <CompilerOptions>
-      <Version Value="8"/>
+      <Version Value="9"/>
      <PathDelim Value="\"/>
      <SearchPaths>
        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
@ -13,6 +13,7 @@
      <Parsing>
        <SyntaxOptions>
          <CStyleOperator Value="False"/>
+          <UseAnsiStrings Value="False"/>
        </SyntaxOptions>
      </Parsing>
      <Other>
@ -26,7 +27,7 @@ translate to Lazarus by alexs in 2005 - 2009
    <License Value="free ware
 "/>
    <Version Major="2" Minor="1" Release="2" Build="105"/>
-    <Files Count="53">
+    <Files Count="54">
      <Item1>
        <Filename Value="rxlookup.pas"/>
        <UnitName Value="rxlookup"/>
@ -241,6 +242,10 @@ translate to Lazarus by alexs in 2005 - 2009
        <Filename Value="rxaboutformunit.pas"/>
        <UnitName Value="rxaboutformunit"/>
      </Item53>
+      <Item54>
+        <Filename Value="dbcurredit.pas"/>
+        <UnitName Value="dbcurredit"/>
+      </Item54>
    </Files>
    <LazDoc Paths="docs\;\usr\local\share\lazarus\components\rxnew\docs\"/>
    <i18n>
--- a/components/rx/rxnew.pas
+++ b/components/rx/rxnew.pas
@ -1,10 +1,8 @@
-{ Этот файл был автоматически создан Lazarus. Н<EFBFBD>
-  <EFBFBD> редактировать!
-  Исходный код используется только для комп<EFBFBD>
-    <EFBFBD>ляции и установки пакета.
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
 }

-unit rxnew; 
+unit rxnew ; 

 interface

@ -17,16 +15,16 @@ uses
  rxsortmemds, AutoPanel, pickdate, rxiconv, rxceEditLookupFields, rxclock, 
  rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit, RxDBCtrls, 
  rxfilterby, rxconst, rxFileUtils, RxVersInfo, RxAboutDialog, 
-  rxAboutFormUnit, LazarusPackageIntf;
+  rxAboutFormUnit, dbcurredit, LazarusPackageIntf;

 implementation

-procedure Register; 
+procedure Register ; 
 begin
-  RegisterUnit('registerrx', @registerrx.Register); 
-  RegisterUnit('RegisterRxDB', @RegisterRxDB.Register); 
-end; 
+  RegisterUnit('registerrx', @registerrx.Register) ; 
+  RegisterUnit('RegisterRxDB', @RegisterRxDB.Register) ; 
+end ; 

 initialization
-  RegisterPackage('rxnew', @Register); 
+  RegisterPackage('rxnew', @Register) ; 
 end.