pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Implement custom color for negative values

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5633 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo
2017-01-12 10:00:41 +00:00
parent a3d3ce9f37
commit 7a1c4be7be
6 changed files with 127 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
components/jujiboutils/src/jdblabeledcurrencyedit.pas
View File

@ -22,7 +22,7 @@ unit jdblabeledcurrencyedit;
interface
uses
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls,
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls, Graphics,
LMessages, LCLType, Dialogs,
SysUtils, jinputconsts;
@ -35,11 +35,14 @@ type
fFormat: string;
FDataLink: TFieldDataLink;
fDecimales: integer;
fNColor: TColor;
fPColor: TColor;
fNull: boolean;
procedure DataChange(Sender: TObject);
function getDecimals: integer;
procedure setDecimals(AValue: integer);
procedure setNegativeColor(AValue: TColor);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
@ -83,6 +86,7 @@ type
property Decimals: integer read getDecimals write setDecimals;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
property AllowNull: boolean read fNull write fNull default False;
property NegativeColor: TColor read fNColor write setNegativeColor;
property Action;
property Align;
@ -170,6 +174,14 @@ begin
fDecimales := AValue;
end;
procedure TJDBLabeledCurrencyEdit.setNegativeColor(AValue: TColor);
begin
if fNColor = AValue then
Exit;
fNColor := AValue;
formatInput;
end;
procedure TJDBLabeledCurrencyEdit.UpdateData(Sender: TObject);
var
@ -245,7 +257,10 @@ end;
procedure TJDBLabeledCurrencyEdit.formatInput;
begin
if Font.Color <> fNColor then
fPColor := Font.Color; // store original font color
if FDataLink.Field <> nil then
begin
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if FDataLink.Field.IsNull then
Caption := ''
@ -253,9 +268,17 @@ begin
if fFormat <> '' then
Caption := FormatFloat(fFormat, FDataLink.Field.AsCurrency)
else
Caption := FDataLink.Field.DisplayText
Caption := FDataLink.Field.DisplayText;
if FDataLink.Field.AsCurrency < 0 then
font.Color := fNColor
else
font.Color := fPColor;
end
else
begin
Caption := 'nil';
font.Color := fPColor;
end;
end;
function TJDBLabeledCurrencyEdit.GetReadOnly: boolean;
@ -380,6 +403,8 @@ begin
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
fPColor := Font.Color;
fNColor := Font.Color;
// Set default values
//fDecimales := 2;
//fFormat := '0.00';

29
components/jujiboutils/src/jdblabeledfloatedit.pas
View File

@ -22,7 +22,7 @@ unit JDBLabeledFloatEdit;
interface
uses
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls,
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls, Graphics,
LMessages, LCLType, Dialogs,
SysUtils, jinputconsts;
@ -36,11 +36,14 @@ type
fEFormat: string;
FDataLink: TFieldDataLink;
fDecimales: integer;
fNColor: TColor;
fPColor: TColor;
fNull: boolean;
procedure DataChange(Sender: TObject);
function getDecimals: integer;
procedure setDecimals(AValue: integer);
procedure setNegativeColor(AValue: TColor);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
@ -85,6 +88,7 @@ type
property Decimals: integer read getDecimals write setDecimals;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
property AllowNull: boolean read fNull write fNull default False;
property NegativeColor: TColor read fNColor write setNegativeColor;
property Action;
property Align;
@ -174,6 +178,14 @@ begin
fDecimales := AValue;
end;
procedure TJDBLabeledFloatEdit.setNegativeColor(AValue: TColor);
begin
if fNColor = AValue then
Exit;
fNColor := AValue;
formatInput;
end;
procedure TJDBLabeledFloatEdit.UpdateData(Sender: TObject);
var
@ -255,7 +267,10 @@ end;
procedure TJDBLabeledFloatEdit.formatInput;
begin
if Font.Color <> fNColor then
fPColor := Font.Color; // store original font color
if FDataLink.Field <> nil then
begin
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if FDataLink.Field.IsNull then
Caption := ''
@ -263,9 +278,17 @@ begin
if fFormat <> '' then
Caption := FormatFloat(fFormat, FDataLink.Field.AsFloat)
else
Caption := FDataLink.Field.DisplayText
Caption := FDataLink.Field.DisplayText;
if FDataLink.Field.AsFloat < 0 then
font.Color := fNColor
else
font.Color := fPColor;
end
else
begin
Caption := 'nil';
font.Color := fPColor;
end;
end;
function TJDBLabeledFloatEdit.GetReadOnly: boolean;
@ -393,6 +416,8 @@ begin
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
fEFormat := '';
fPColor := Font.Color;
fNColor := Font.Color;
// Set default values
//fDecimales := 2;
//fFormat := '0.00';

30
components/jujiboutils/src/jdblabeledintegeredit.pas
View File

@ -22,7 +22,7 @@ unit jdblabeledintegeredit;
interface
uses
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls,
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls, Graphics,
LMessages, LCLType, Dialogs,
SysUtils, jinputconsts;
@ -34,9 +34,12 @@ type
private
fFormat: string;
FDataLink: TFieldDataLink;
fNColor: TColor;
fPColor: TColor;
fNull: boolean;
procedure DataChange(Sender: TObject);
procedure setNegativeColor(AValue: TColor);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
@ -78,6 +81,7 @@ type
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
property AllowNull: boolean read fNull write fNull default False;
property NegativeColor: TColor read fNColor write setNegativeColor;
property Action;
property Align;
@ -155,6 +159,14 @@ begin
Text := '';
end;
procedure TJDBLabeledIntegerEdit.setNegativeColor(AValue: TColor);
begin
if fNColor = AValue then
Exit;
fNColor := AValue;
formatInput;
end;
procedure TJDBLabeledIntegerEdit.UpdateData(Sender: TObject);
begin
@ -221,7 +233,10 @@ end;
procedure TJDBLabeledIntegerEdit.formatInput;
begin
if Font.Color <> fNColor then
fPColor := Font.Color; // store original font color
if FDataLink.Field <> nil then
begin
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if FDataLink.Field.IsNull then
Caption := ''
@ -229,9 +244,17 @@ begin
if fFormat <> '' then
Caption := FormatFloat(fFormat, FDataLink.Field.AsInteger)
else
Caption := FDataLink.Field.DisplayText
Caption := FDataLink.Field.DisplayText;
if FDataLink.Field.AsInteger < 0 then
font.Color := fNColor
else
font.Color := fPColor;
end
else
begin
Caption := 'nil';
font.Color := fPColor;
end;
end;
function TJDBLabeledIntegerEdit.GetReadOnly: boolean;
@ -342,6 +365,8 @@ begin
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
fPColor := Font.Color;
fNColor := Font.Color;
end;
destructor TJDBLabeledIntegerEdit.Destroy;
@ -363,4 +388,3 @@ begin
end;
end.

3
components/jujiboutils/src/jlabeledcurrencyedit.pas
View File

@ -48,16 +48,13 @@ type
procedure setNegativeColor(AValue: TColor);
procedure setValue(const AValue: currency);
protected
{ Protected declarations }
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key: char); override;
public
{ Public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property DisplayFormat: string read getFormat write setFormat;
property EditFormat: string read fEFormat write fEFormat;
property Decimals: integer read getDecimals write setDecimals;

24
components/jujiboutils/src/jlabeledfloatedit.pas
View File

@ -31,7 +31,8 @@ type
TJLabeledFloatEdit = class(TCustomLabeledEdit)
private
{ Private declarations }
fNColor: TColor;
fPColor: TColor;
theValue: double;
fFormat: string;
fEFormat: string;
@ -45,23 +46,22 @@ type
procedure setFormat(const AValue: string);
function scaleTo(const AValue: double; const NDecimals: integer): double;
function IsValidFloat(const Value: string): boolean;
procedure setNegativeColor(AValue: TColor);
procedure setValue(const AValue: double);
protected
{ Protected declarations }
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key: char); override;
public
{ Public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property CurrentValue: double read getCurrentValue;
published
{ Published declarations }
property DisplayFormat: string read getFormat write setFormat;
property EditFormat: string read fEFormat write fEFormat;
property Decimals: integer read getDecimals write setDecimals;
property Value: double read getValue write setValue;
property NegativeColor: TColor read fNColor write setNegativeColor;
property Action;
property Align;
@ -146,7 +146,13 @@ end;
procedure TJLabeledFloatEdit.formatInput;
begin
if Font.Color <> fNColor then
fPColor := Font.Color; // store original font color
Caption := FormatFloat(DisplayFormat, theValue);
if theValue < 0 then
font.Color := fNColor
else
font.Color := fPColor;
end;
procedure TJLabeledFloatEdit.setDecimals(const AValue: integer);
@ -175,6 +181,14 @@ begin
Result := True;
end;
procedure TJLabeledFloatEdit.setNegativeColor(AValue: TColor);
begin
if fNColor = AValue then
Exit;
fNColor := AValue;
formatInput;
end;
procedure TJLabeledFloatEdit.setValue(const AValue: double);
begin
if fDecimals > 0 then
@ -232,6 +246,8 @@ begin
fEFormat := '';
fFormat := '#,0.00';
fDecimals := 2;
fPColor := Font.Color;
fNColor := Font.Color;
formatInput;
end;

32
components/jujiboutils/src/jlabeledintegeredit.pas
View File

@ -31,33 +31,33 @@ type
TJLabeledIntegerEdit = class(TCustomLabeledEdit)
private
fNColor: TColor;
fPColor: TColor;
fNull: boolean;
{ Private declarations }
theValue: integer;
fFormat: string;
function getFormat: string;
function getValue: integer;
function getCurrentValue: integer;
procedure setFormat(const AValue: string);
procedure setNegativeColor(AValue: TColor);
procedure setValue(const AValue: integer);
function IsValidInteger(const Value: string): boolean;
procedure FormatInput;
protected
{ Protected declarations }
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key: char); override;
public
{ Public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function isNull: boolean;
property CurrentValue: integer read getCurrentValue;
published
{ Published declarations }
property DisplayFormat: string read getFormat write setFormat;
property Value: integer read getValue write setValue;
property AllowNull: boolean read fNull write fNull default False;
property NegativeColor: TColor read fNColor write setNegativeColor;
property Action;
property Align;
@ -141,6 +141,14 @@ begin
formatInput;
end;
procedure TJLabeledIntegerEdit.setNegativeColor(AValue: TColor);
begin
if fNColor = AValue then
Exit;
fNColor := AValue;
FormatInput;
end;
procedure TJLabeledIntegerEdit.setValue(const AValue: integer);
begin
theValue := AValue;
@ -157,10 +165,21 @@ end;
procedure TJLabeledIntegerEdit.FormatInput;
begin
if Font.Color <> fNColor then
fPColor := Font.Color; // store original font color
if isNull then
Text := ''
begin
Text := '';
font.Color := fNColor;
end
else
begin
Text := FormatFloat(fFormat, theValue);
if theValue < 0 then
font.Color := fNColor
else
font.Color := fPColor;
end;
end;
procedure TJLabeledIntegerEdit.DoEnter;
@ -205,6 +224,8 @@ begin
Text := '';
DisplayFormat := '0';
Value := 0;
fPColor := Font.Color;
fNColor := Font.Color;
end;
destructor TJLabeledIntegerEdit.Destroy;
@ -218,4 +239,3 @@ begin
end;
end.