y por último los componente usados.
He usado componentes estándar excepto , NewPAnelDb, SpeedButtonBC, GroupBoxJL, DbComboBoxExt, DBIBCheckbox, DBIBMemo que ya los he subido al club en su momento y que son gratuitos, pro último esta el DBColorBox que lo he creado esta tarde y que pongo su código a continuación
Componente DBColorBox
Código Delphi
[-]unit DBColorComboBox;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Stdctrls, DbTables, DB, ExtCtrls, DBCtrls;
type
TDBColorBox = class(TColorBox)
private
FDataLink : TFieldDataLink;
procedure AutoInitialize;
procedure AutoDestroy;
function GetDataField : String;
procedure SetDataField(Value : String);
function GetDataSource : TDataSource;
procedure SetDataSource(Value : TDataSource);
procedure ActiveChange(Sender : TObject);
procedure DataChange(Sender : TObject);
procedure EditingChange(Sender : TObject);
procedure UpdateData(Sender : TObject);
protected
procedure Change; override;
procedure Click; override;
procedure KeyPress(var Key : Char); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property DataField : String read GetDataField write SetDataField;
property DataSource : TDataSource read GetDataSource write SetDataSource;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TDBColorBox]);
end;
procedure TDBColorBox.ActiveChange(Sender: TObject);
const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
if DataField = '' then Exit;
if FDataLink <> nil then
if FDataLink.Dataset <> nil then
if FDataLink.Dataset.Active then TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString);
end;
procedure TDBColorBox.AutoDestroy;
begin
FDataLink.Free;
end;
procedure TDBColorBox.AutoInitialize;
begin
FDataLink := TFieldDataLink.Create;
with FDataLink do
begin
OnDataChange := DataChange;
OnUpdateData := UpdateData;
OnEditingChange := EditingChange;
OnActiveChange := ActiveChange;
end;
end;
procedure TDBColorBox.Change;
begin
inherited Change;
end;
procedure TDBColorBox.Click;
begin
if DataField = '' then Exit;
if FDataLink <> nil then
if FDataLink.Dataset <> nil then
if FDataLink.Dataset.Active then
if FDataLink.Dataset.State in [dsEdit,dsInsert] then
FDataLink.Dataset.FieldByName(DataField).Value:=ColorToString(TColorBox(Self).Selected);
inherited Click;
end;
constructor TDBColorBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;
procedure TDBColorBox.DataChange(Sender: TObject);
begin
if FDataLink.Field = nil then
begin
end else
begin
if FDataLink.Dataset.FieldByName(DataField).AsString <> '' then TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString)
else TColorBox(Self).Selected:=clBlack;
end
end;
destructor TDBColorBox.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;
procedure TDBColorBox.EditingChange(Sender: TObject);
begin
end;
function TDBColorBox.GetDataField: String;
begin
Result := FDataLink.FieldName;
end;
function TDBColorBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDBColorBox.KeyPress(var Key: Char);
const TabKey = Char(VK_TAB);
EnterKey = Char(VK_RETURN);
begin
inherited KeyPress(Key);
end;
procedure TDBColorBox.Loaded;
begin
inherited Loaded;
end;
procedure TDBColorBox.SetDataField(Value: String);
begin
FDataLink.FieldName := Value;
end;
procedure TDBColorBox.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
end;
procedure TDBColorBox.UpdateData(Sender: TObject);
begin
end;
end.