Question

using db controls connected to a FireBird database. and I have a simple dblabel I want to change text color based on current value for current record

The user navigate using the dbnavigator and I wrote code in the navigator button click. but there is a problem the code always read the previous record value not the current one so the color is wrong !! for example:

procedure <navigator button click>;
begin
  if table1.FieldByName('field1').AsString = 'val1' then
    <dblabel.textcolor> := red
  else
    <dblabel.textcolor> := green; 

end;

but as I said the value is one record behind. why is that and what is the best approach to change label text color ?

Thanks

Answer 1

You can use a bunch of events!

• TDataSource.OnDataChange
• TJvDataSource.OnDatasetScrolled
• DataSet.AfterScroll plus DataSet.AfterOpen

Demo EXE: http://rghost.ru/40321071 (leftmost button is “download”)

DFM:

object Form1: TForm1
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Form1'
  ClientHeight = 301
  ClientWidth = 685
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnHide = FormHide
  PixelsPerInch = 120
  TextHeight = 16
  object dbgrd1: TDBGrid
    Left = 8
    Top = 8
    Width = 425
    Height = 277
    DataSource = ds1
    ReadOnly = True
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -13
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object edtL_DS_ODC: TLabeledEdit
    Left = 448
    Top = 24
    Width = 200
    Height = 24
    EditLabel.Width = 163
    EditLabel.Height = 16
    EditLabel.Caption = 'TDataSource.OnDataChange'
    ReadOnly = True
    TabOrder = 1
  end
  object edtL_JDS_ODS: TLabeledEdit
    Left = 448
    Top = 104
    Width = 200
    Height = 24
    EditLabel.Width = 194
    EditLabel.Height = 16
    EditLabel.Caption = 'TJvDataSource.OnDatasetScrolled'
    ReadOnly = True
    TabOrder = 2
  end
  object edtL_T_AS: TLabeledEdit
    Left = 448
    Top = 184
    Width = 200
    Height = 24
    EditLabel.Width = 117
    EditLabel.Height = 16
    EditLabel.Caption = 'TDataSet.AfterScroll'
    ReadOnly = True
    TabOrder = 3
  end
  object pnl1: TPanel
    Left = 480
    Top = 48
    Width = 105
    Height = 25
    BevelOuter = bvLowered
    Caption = 'pnl1'
    Color = clBlack
    ParentBackground = False
    TabOrder = 4
    object dbtxt1: TDBText
      Left = 24
      Top = 6
      Width = 65
      Height = 17
      DataField = 'Dummy'
      DataSource = ds1
    end
  end
  object pnl2: TPanel
    Left = 480
    Top = 128
    Width = 105
    Height = 25
    BevelOuter = bvLowered
    Caption = 'pnl1'
    Color = clBlack
    ParentBackground = False
    TabOrder = 5
    object dbtxt2: TDBText
      Left = 24
      Top = 6
      Width = 65
      Height = 17
      DataField = 'Dummy'
      DataSource = ds1
    end
  end
  object pnl3: TPanel
    Left = 480
    Top = 208
    Width = 105
    Height = 25
    BevelOuter = bvLowered
    Caption = 'pnl1'
    Color = clBlack
    ParentBackground = False
    TabOrder = 6
    object dbtxt3: TDBText
      Left = 24
      Top = 6
      Width = 65
      Height = 17
      DataField = 'Dummy'
      DataSource = ds1
    end
  end
  object dbnvgr1: TDBNavigator
    Left = 439
    Top = 260
    Width = 240
    Height = 25
    DataSource = ds1
    Kind = dbnHorizontal
    TabOrder = 7
  end
  object ds1: TDataSource
    DataSet = data
    OnDataChange = ds1DataChange
    Left = 24
    Top = 80
  end
  object ds2: TJvDataSource
    DataSet = data
    OnDataSetScrolled = ds2DataSetScrolled
    Left = 64
    Top = 80
  end
  object data: TClientDataSet
    Aggregates = <>
    Params = <>
    AfterScroll = dataAfterScroll
    Left = 24
    Top = 24
    object fldValue: TIntegerField
      FieldName = 'Value'
    end
    object fldDummy: TIntegerField
      FieldName = 'Dummy'
    end
  end
end

PAS:

type
  TForm1 = class(TForm)
    ds1: TDataSource;
    ds2: TJvDataSource;
    data: TClientDataSet;
    fldValue: TIntegerField;
    fldDummy: TIntegerField;
    dbgrd1: TDBGrid;
    edtL_DS_ODC: TLabeledEdit;
    edtL_JDS_ODS: TLabeledEdit;
    edtL_T_AS: TLabeledEdit;
    dbtxt1: TDBText;
    pnl1: TPanel;
    pnl2: TPanel;
    dbtxt2: TDBText;
    pnl3: TPanel;
    dbtxt3: TDBText;
    dbnvgr1: TDBNavigator;
    procedure FormCreate(Sender: TObject);
    procedure dataAfterScroll(DataSet: TDataSet);
    procedure ds1DataChange(Sender: TObject; Field: TField);
    procedure ds2DataSetScrolled(Sender: TObject);
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
    procedure ShowIt(const el: TLabeledEdit; Const color, value: integer); overload;
    procedure ShowIt(const el: TLabeledEdit); overload;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i,j,k: integer;
begin
   data.CreateDataSet;

   for i := 1 to 20 do begin
       j := Random(100) - 50;
       k := Random(20);
       data.AppendRecord([j,k]);
   end;
end;

procedure TForm1.FormHide(Sender: TObject);
begin
  data.Close;
end;

procedure TForm1.ShowIt(const el: TLabeledEdit);
begin
  ShowIt(el, fldValue.AsInteger, fldDummy.AsInteger);
end;

procedure TForm1.ShowIt(const el: TLabeledEdit; const color, value: integer);
begin
  if el = nil then exit;

  if color < 0 then el.Color := clYellow
               else el.Color := clWhite;

  el.Text := IntToStr(color) + ' ==> ' + IntToStr(value);

  dbtxt1.Font.Color := edtL_DS_ODC.color;
  dbtxt2.Font.Color := edtL_JDS_ODS.color;
  dbtxt3.Font.Color := edtL_T_AS.color;
end;

procedure TForm1.dataAfterScroll(DataSet: TDataSet);
begin
 ShowIt(edtL_T_AS);
end;

procedure TForm1.ds1DataChange(Sender: TObject; Field: TField);
begin
 ShowIt(edtL_DS_ODC);
end;

procedure TForm1.ds2DataSetScrolled(Sender: TObject);
begin
 ShowIt(edtL_JDS_ODS);
end;