ucells.pas

Korea, a data table control 韩国控件的DEMO 值得学习

unit UCells;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, URGrids, Db, DBTables, URCtrls, UREdits, URCombos,
  URNEdit;

type
  TfrmCells = class(TForm)
    memoMain: TMemo;
    Splitter1: TSplitter;
    Panel1: TPanel;
    Splitter2: TSplitter;
    grdMain: TRealGrid;
    tblMain: TTable;
    tblMainEmpNo: TIntegerField;
    tblMainLastName: TStringField;
    tblMainFirstName: TStringField;
    tblMainPhoneExt: TStringField;
    tblMainHireDate: TDateTimeField;
    tblMainSalary: TFloatField;
    Label1: TLabel;
    edCol: TwNumEdit;
    Label2: TLabel;
    edRow: TwNumEdit;
    Label3: TLabel;
    Label4: TLabel;
    cbProp: TwCombo;
    edValue: TwEdit;
    Button1: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure grdMainDrawCol(Sender: TObject; ACol, ARow: Integer;
      var Text: String; var BCol, FCol: TColor; var FStyle: TFontStyles);
    procedure Button1Click(Sender: TObject);
    procedure edColKeyPress(Sender: TObject; var Key: Char);
    procedure edColExit(Sender: TObject);
    procedure edRowKeyPress(Sender: TObject; var Key: Char);
    procedure edRowExit(Sender: TObject);
    procedure cbPropValueChange(Sender: TObject);
  private
    procedure SelectData;
    procedure GetValue;
    procedure SetValue;

  public
  end;

implementation

uses URDEdit;

{$R *.DFM}

const
  GD_EMPNO     = 0;
  GD_LASTNAME  = 1;
  GD_FIRSTNAME = 2;
  GD_PHONEEXT  = 3;
  GD_HIREDATE  = 4;
  GD_SALARY    = 5;
  GD_MARRIED   = 6;

  Description = 'TRealGrid 阿 拿烦伎狼 单捞磐绰 Cells 加己阑 烹秦 立辟窍霸 邓聪促.' + #13#10 +
                'Cells绰 拿烦狼 DataType寇狼 促弗 磊丰屈栏肺档 奖霸 立辟且 荐 乐档废 ' +
                'Delphi狼 扁夯 磊丰屈狼 措何盒栏肺 函券窍绰 加己阑 力傍窍绰 按眉 加己涝聪促.' + #13#10 +
                'Cells绰 肚茄 TRealGrid狼 default 加己涝聪促.';

(*** Private Methods ***)
procedure TfrmCells.SelectData;
begin
  with tblMain, grdMain do
  begin
    Open;

    while not EOF do
    begin
      AddRow;

      Cells[GD_EMPNO    , RowCount - 1].AsLong   := FieldByName('EmpNo').AsInteger;
      Cells[GD_LASTNAME , RowCount - 1].AsString := FieldByName('LastName').AsString;
      Cells[GD_FIRSTNAME, RowCount - 1].AsString := FieldByName('FirstName').AsString;
      Cells[GD_PHONEEXT , RowCount - 1].AsString := FieldByName('PhoneExt').AsString;
      Cells[GD_HIREDATE , RowCount - 1].AsDate   := FieldByName('HireDate').AsDateTime;
      Cells[GD_SALARY   , RowCount - 1].AsFloat  := FieldByName('Salary').AsFloat;
      Cells[GD_MARRIED  , RowCount - 1].AsBool   := Round(FieldByName('Salary').AsFloat) mod 2 = 0;

      Next;
    end;

    Close;
  end;
end;

procedure TfrmCells.GetValue;
var
  C, R: Integer;
begin
  C := Round(edCol.Value);
  R := Round(edRow.Value);

  with grdMain do
    case cbProp.ValueIndex of
      0: edValue.Text := Cells[C, R].AsString;
      1: edValue.Text := IntToStr(Cells[C, R].AsLong);
      2: edValue.Text := FloatToStr(Cells[C, R].AsFloat);
      3: with Columns[C] do
           edValue.Text := RGFormatDate(Cells[C, R].AsDate, DateFormat, Separator);
    end;
end;

procedure TfrmCells.SetValue;
var
  C, R: Integer;
begin
  C := Round(edCol.Value);
  R := Round(edRow.Value);

  with grdMain do
    case cbProp.ValueIndex of
      0: Cells[C, R].AsString := edValue.Text;
      1: Cells[C, R].AsLong   := StrToInt(edValue.Text);
      2: Cells[C, R].AsFloat  := StrToFloat(edValue.Text);
      3: with Columns[C] do
           Cells[C, R].AsDate := RGFormatDate(edValue.Text, DateFormat, Separator);
    end;
end;

(*** Event Handlers ***)
procedure TfrmCells.FormCreate(Sender: TObject);
begin
  memoMain.Lines.Text := Description;
  SelectData;
  cbProp.ValueIndex := 0;
  GetValue;
end;

procedure TfrmCells.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmCells.grdMainDrawCol(Sender: TObject; ACol, ARow: Integer;
  var Text: String; var BCol, FCol: TColor; var FStyle: TFontStyles);
begin
  if ACol = GD_SALARY then
    with grdMain do
      if Cells[GD_SALARY, ARow].AsLong >= 40000 then
      begin
        BCol   := clRed;
        FCol   := clWhite;
        FStyle := [fsBold];
      end
      else if Cells[GD_SALARY, ARow].AsLong < 25000 then
      begin
        BCol   := clYellow;
        FStyle := [fsBold];
      end;
end;

procedure TfrmCells.Button1Click(Sender: TObject);
begin
  SetValue;
end;

procedure TfrmCells.edColKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    grdMain.Row := Round(edRow.Value);
    grdMain.Col := Round(edCol.Value);
    GetValue;
  end;
end;

procedure TfrmCells.edColExit(Sender: TObject);
begin
  grdMain.Row := Round(edRow.Value);
  grdMain.Col := Round(edCol.Value);
  GetValue;
end;

procedure TfrmCells.edRowKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    grdMain.Row := Round(edRow.Value);
    grdMain.Col := Round(edCol.Value);
    GetValue;
  end;
end;

procedure TfrmCells.edRowExit(Sender: TObject);
begin
  grdMain.Row := Round(edRow.Value);
  grdMain.Col := Round(edCol.Value);
  GetValue;
end;

procedure TfrmCells.cbPropValueChange(Sender: TObject);
begin
  GetValue;
end;

end.