usorting.pas

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

unit USorting;

interface

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

type
  TfrmSorting = class(TForm)
    memoMain: TMemo;
    Splitter1: TSplitter;
    grdMain: TRealGrid;
    tblMain: TTable;
    tblMainACCT_NBR: TFloatField;
    tblMainSYMBOL: TStringField;
    tblMainSHARES: TFloatField;
    tblMainPUR_PRICE: TFloatField;
    tblMainPUR_DATE: TDateField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure grdMainColumnTitleClick(AColumn: TwColumn);
    procedure grdMainDrawRow(Sender: TObject; ARow: Integer; var BCol,
      FCol: TColor; var FStyle: TFontStyles);
    procedure grdMainDrawCol(Sender: TObject; ACol, ARow: Integer;
      var Text: String; var BCol, FCol: TColor; var FStyle: TFontStyles);
  private
    procedure SelectData;

  public
  end;

implementation

{$R *.DFM}

const
  GD_ACCT_NBR  = 0;
  GD_SYMBOL    = 1;
  GD_SHARES    = 2;
  GD_PUR_PRICE = 3;
  GD_PUR_DATE  = 4;

  Description = 'TRealGrid绰 拿烦窜困狼 沥纺 皋筋靛 Sort 甫 力傍钦聪促.' + #13#10 +
                '肚茄 TwColumn.Title篮 SortMark 加己阑 力傍窍咯 鸥捞撇俊 沥纺 惑怕甫 ' +
                '钎矫且 荐 乐档废 钦聪促.' + #13#10 +
                '酒贰绰 弊府靛狼 OnColumnTitleClick 捞亥飘俊辑 Sort窃荐甫 贸府茄 抗涝聪促.' +
                '阿 拿烦狼 鸥捞撇阑 努腐秦焊矫扁 官而聪促.' + #13#10 +
                '拿烦鸥捞撇 努腐篮 促弗 侩档肺 荤侩瞪 荐档 乐栏骨肺 鸥捞撇 努腐父栏肺 ' +
                '磊悼 沥纺登瘤绰 臼嚼聪促.';

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

    while not EOF do
    begin
      AddRow;

      Cells[GD_ACCT_NBR , RowCount - 1].AsFloat  := FieldByName('Acct_Nbr' ).AsFloat;
      Cells[GD_SYMBOL   , RowCount - 1].AsString := FieldByName('Symbol'   ).AsString;
      Cells[GD_SHARES   , RowCount - 1].AsFloat  := FieldByName('Shares'   ).AsFloat;
      Cells[GD_PUR_PRICE, RowCount - 1].AsFloat  := FieldByName('Pur_Price').AsFloat;
      Cells[GD_PUR_DATE , RowCount - 1].AsDate   := FieldByName('Pur_Date' ).AsDateTime;

      Next;
    end;

    Close;
  end;
end;

(*** Event Handlers ***)
procedure TfrmSorting.FormCreate(Sender: TObject);
begin
  SelectData;
  memoMain.Lines.Text := Description;
end;

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

procedure TfrmSorting.grdMainColumnTitleClick(AColumn: TwColumn);
begin
  if AColumn.Title.SortMark = wsmAsc then
    grdMain.Sort(AColumn.Index, True)
  else
    grdMain.Sort(AColumn.Index);
end;

procedure TfrmSorting.grdMainDrawRow(Sender: TObject; ARow: Integer;
  var BCol, FCol: TColor; var FStyle: TFontStyles);
begin
  with grdMain do
    if Cells[GD_SHARES, ARow].AsFloat >= 10000 then
    begin
      BCol := clGreen;
      FCol := clWhite;
    end
    else if Cells[GD_SHARES, ARow].AsFloat <= 2000 then
    begin
      BCol := clInfoBk;
    end
end;

procedure TfrmSorting.grdMainDrawCol(Sender: TObject; ACol, ARow: Integer;
  var Text: String; var BCol, FCol: TColor; var FStyle: TFontStyles);
begin
  if ACol = GD_PUR_PRICE then
    with grdMain do
      if Cells[ACol, ARow].AsFloat >= 50 then
      begin
        BCol   := clRed;
        FCol   := clWhite;
        FStyle := [fsBold];
      end
      else if Cells[ACol, ARow].AsFloat >= 40 then
      begin
        BCol   := clYellow;
        FCol   := clBlack;
        FStyle := [fsBold];
      end;
end;

end.