From 48c80f43c5649402b8e1bbeec29a6318f4eb6366 Mon Sep 17 00:00:00 2001 From: alexs75 Date: Sun, 8 May 2011 18:25:31 +0000 Subject: [PATCH] missing file git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1619 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/rx/rxdbcolorbox.pas | 325 +++++++++++++++++++++++++++++++++ 1 file changed, 325 insertions(+) create mode 100644 components/rx/rxdbcolorbox.pas diff --git a/components/rx/rxdbcolorbox.pas b/components/rx/rxdbcolorbox.pas new file mode 100644 index 000000000..560a4789f --- /dev/null +++ b/components/rx/rxdbcolorbox.pas @@ -0,0 +1,325 @@ +unit RxDBColorBox; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ColorBox, + DbCtrls, DB, LMessages, LCLType; + +type + + { TRxCustomDBColorBox } + + TRxCustomDBColorBox = class(TCustomColorBox) + FDataLink: TFieldDataLink; + + procedure DataChange(Sender: TObject); + 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 UpdateData(Sender: TObject); + procedure FocusRequest(Sender: TObject); + procedure ActiveChange(Sender: TObject); + procedure LayoutChange(Sender: TObject); + procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK; + function IsReadOnly: boolean; + protected + property DataField: string read GetDataField write SetDataField; + property DataSource: TDataSource read GetDataSource write SetDataSource; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; + + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure Change; override; + + procedure Loaded; override; + procedure Notification(AComponent: TComponent; + Operation: TOperation); override; + procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; + procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Field: TField read GetField; + published + { Published declarations } + end; + + TRxDBColorBox = class(TRxCustomDBColorBox) + private + { Private declarations } + protected + { Protected declarations } + public + { Public declarations } + published + property DataField; + property DataSource; + property ReadOnly; + + property DefaultColorColor; + property NoneColorColor; + property Selected; + property Style; + property OnGetColors; + + property Align; + property Anchors; + property ArrowKeysTraverseList; + property AutoComplete; + property AutoCompleteText; + property AutoDropDown; + property AutoSelect; + property AutoSize; + property BidiMode; + property BorderSpacing; + property Color; + property Constraints; + property DragCursor; + property DragMode; + property DropDownCount; + property Enabled; + property Font; + property ItemHeight; + property ItemWidth; + property OnChange; + property OnChangeBounds; + property OnClick; + property OnCloseUp; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnDropDown; + property OnEditingDone; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + property OnSelect; + property OnUTF8KeyPress; + property ParentBidiMode; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + end; + +implementation + +type + TFieldDataLinkHack = class(TFieldDataLink) + end; + + +{ TRxCustomDBColorBox } + +procedure TRxCustomDBColorBox.DataChange(Sender: TObject); +begin + if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in [ftString, ftInteger, ftLargeint]) then + begin + if FDatalink.Field.DataType in [ftString] then + begin + if FDatalink.Field.AsString<>'' then + try + Selected:=StringToColor(FDatalink.Field.AsString) + except + Selected:=clNone; + end + else + Selected:=clNone; + end + else + if FDataLink.Field.DataType in [ftInteger, ftLargeint] then + begin + try + Selected:=TColor(FDatalink.Field.AsInteger); + except + Selected:=clNone; + end; + end; + end + else + begin + Selected := clNone; + end; +end; + +function TRxCustomDBColorBox.GetDataField: string; +begin + Result := FDataLink.FieldName; +end; + +function TRxCustomDBColorBox.GetDataSource: TDataSource; +begin + Result := FDataLink.DataSource; +end; + +function TRxCustomDBColorBox.GetField: TField; +begin + Result := FDataLink.Field; +end; + +function TRxCustomDBColorBox.GetReadOnly: Boolean; +begin + Result := FDataLink.ReadOnly; +end; + +procedure TRxCustomDBColorBox.SetDataField(const AValue: string); +begin + FDataLink.FieldName := AValue; +end; + +procedure TRxCustomDBColorBox.SetDataSource(const AValue: TDataSource); +begin + ChangeDataSource(Self,FDataLink,AValue); +end; + +procedure TRxCustomDBColorBox.SetReadOnly(const AValue: Boolean); +begin + inherited; + FDataLink.ReadOnly := AValue; +end; + +procedure TRxCustomDBColorBox.UpdateData(Sender: TObject); +begin + if FDataLink.Field.DataType in [ftString] then + FDataLink.Field.AsString := ColorToString(Selected) + else + if FDataLink.Field.DataType in [ftInteger, ftLargeint] then + FDataLink.Field.AsInteger := Integer(Selected); +end; + +procedure TRxCustomDBColorBox.FocusRequest(Sender: TObject); +begin + SetFocus; +end; + +procedure TRxCustomDBColorBox.ActiveChange(Sender: TObject); +begin + if FDatalink.Active then + DataChange(Sender) + else + begin + Selected := clNone; + FDataLink.Reset; + end; +end; + +procedure TRxCustomDBColorBox.LayoutChange(Sender: TObject); +begin + DataChange(Sender); +end; + +procedure TRxCustomDBColorBox.CMGetDataLink(var Message: TLMessage); +begin + Message.Result := PtrUInt(FDataLink); +end; + +function TRxCustomDBColorBox.IsReadOnly: boolean; +begin + Result := true; + if FDatalink.Active and (not Self.ReadOnly) then + Result := (Field = nil) or Field.ReadOnly; +end; + +procedure TRxCustomDBColorBox.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_DELETE then + begin + if not IsReadOnly then + FDatalink.Edit; + end + else + if Key=VK_TAB then + begin + if FDataLink.CanModify and FDatalink.Editing then + FDataLink.UpdateRecord; + end; +end; + +procedure TRxCustomDBColorBox.Change; +begin + FDatalink.Edit; + FDataLink.Modified; + inherited Change; +end; + +procedure TRxCustomDBColorBox.Loaded; +begin + inherited Loaded; + if (csDesigning in ComponentState) then + DataChange(Self); +end; + +procedure TRxCustomDBColorBox.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation=opRemove) then + begin + if (FDataLink<>nil) and (AComponent=DataSource) then + DataSource:=nil; + end; +end; + +procedure TRxCustomDBColorBox.WMSetFocus(var Message: TLMSetFocus); +begin + inherited WMSetFocus(Message); + if not FDatalink.Editing then + FDatalink.Reset; +end; + +procedure TRxCustomDBColorBox.WMKillFocus(var Message: TLMKillFocus); +begin + inherited WMKillFocus(Message); + if not FDatalink.Editing then + FDatalink.Reset + else + TFieldDataLinkHack(FDatalink).UpdateData; +end; + +constructor TRxCustomDBColorBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDataLink := TFieldDataLink.Create; + FDataLink.Control := Self; + FDataLink.OnDataChange := @DataChange; + FDataLink.OnUpdateData := @UpdateData; + FDataLink.OnActiveChange := @ActiveChange; + FDataLink.OnLayoutChange := @LayoutChange; +end; + +destructor TRxCustomDBColorBox.Destroy; +begin + FreeAndNil(FDataLink); + inherited Destroy; +end; + +end.