jsdbrzlistview.pas

销售软件

unit JSDBRzListView;

interface

uses
  Graphics,
  SysUtils,
  Windows,
  Classes,
  Controls,
  ComCtrls,
  RzListVw,
  ADODB_TLB,
  Variants,
  StrUtils;

type
  TJSDBRzListView = class(TRzListView)
  private
    m_cnDBLV: _Connection;
    m_rsDBLV: _Recordset;
    m_sSQLString, m_sKeyFieldName: string;
    m_avarDatas: array of array of Variant;
    m_bShowKeyField, m_bItemBackColor, m_bShowIDField: Boolean;
    m_nKeyField, m_nDefaultImageIndex: Integer;
    m_eColumnCreate: TLVColumnClickEvent;
    m_clItemBackColorStart, m_clItemBackColorEnd: TColor;
    procedure SetShowIDField(const Value: Boolean);
    procedure SetItemBackColorEnd(const Value: TColor);
    procedure SetItemBackColorStart(const Value: TColor);
    procedure SetItemBackColor(const Value: Boolean);
    procedure SetColumnCreate(const Value: TLVColumnClickEvent);
    procedure SetDefaultImageIndex(const Value: Integer);
    procedure SetShowKeyField(const Value: Boolean);
    procedure SetKeyFieldName(const Value: string);
    procedure SetRecordset(const Value: _Recordset);
    procedure SetSQLString(const Value: string);
    procedure SetConnection(const Value: _Connection);
  protected
    function OwnerDataFetch(Item: TListItem; Request: TItemRequest): Boolean;
      override;
    function OwnerDataFind(Find: TItemFind; const FindString: string;
      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
      Direction: TSearchDirection; Wrap: Boolean): Integer; override;
    function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
      Stage: TCustomDrawStage): Boolean; override;
    procedure Delete(Item: TListItem); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure StartFillData;
    procedure RefreshData;
    function ItemKeyFieldValue(nItemIdx: Integer): Variant;
    function FieldName(nFieldIdx: Integer): string;
    function GetValue(nFieldIdx, nRecordIdx: Integer): Variant;
  published
    property Connection: _Connection read m_cnDBLV
      write SetConnection;
    property SQLString: string read m_sSQLString
      write SetSQLString;
    property RecordSet: _Recordset read m_rsDBLV
      write SetRecordset;
    property KeyFieldName: string read m_sKeyFieldName
      write SetKeyFieldName;
    property ShowKeyField: Boolean read m_bShowKeyField
      write SetShowKeyField
      default True;
    property DefaultImageIndex: Integer read m_nDefaultImageIndex
      write SetDefaultImageIndex default -1;
    property OnColumnCreate: TLVColumnClickEvent read m_eColumnCreate
      write SetColumnCreate;
    property ItemBackColor: Boolean read m_bItemBackColor
      write SetItemBackColor default False;
    property ItemBackColorStart: TColor read m_clItemBackColorStart
      write SetItemBackColorStart default clWindow;
    property ItemBackColorEnd: TColor read m_clItemBackColorEnd
      write SetItemBackColorEnd default clWindow;
    property ShowIDField: Boolean read m_bShowIDField
      write SetShowIDField default False;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Jerk System', [TJSDBRzListView]);
end;

{ TJSDBRzListView }

constructor TJSDBRzListView.Create(AOwner: TComponent);
begin
  inherited;

  m_rsDBLV := CoRecordset.Create;
  m_nKeyField := -1;
  m_eColumnCreate := nil;

  OwnerData := True;
  ViewStyle := vsReport;
  RowSelect := True;
  ShowKeyField := True;
  ShowIDField := False;
  DefaultImageIndex := -1;
  ItemBackColor := False;
  ItemBackColorStart := clWindow;
  ItemBackColorEnd := clWindow;
end;

function TJSDBRzListView.CustomDrawItem(Item: TListItem;
  State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
begin
  if m_bItemBackColor then
    if (Item.Index mod 2) = 0 then
      Canvas.Brush.Color := m_clItemBackColorStart
    else
      Canvas.Brush.Color := m_clItemBackColorEnd;
  Result := True;
end;

procedure TJSDBRzListView.Delete(Item: TListItem);
begin
  inherited;
end;

destructor TJSDBRzListView.Destroy;
begin
  if m_rsDBLV.State <> 0 then
    m_rsDBLV.Close;
  m_avarDatas := nil;

  inherited;
end;

function TJSDBRzListView.FieldName(nFieldIdx: Integer): string;
begin
  Result := m_rsDBLV.Fields[nFieldIdx].Name;
end;

function TJSDBRzListView.GetValue(nFieldIdx, nRecordIdx: Integer): Variant;
begin
  Result := m_avarDatas[nFieldIdx, nRecordIdx];
end;

function TJSDBRzListView.ItemKeyFieldValue(nItemIdx: Integer): Variant;
begin
  { 获取索引数据 }

  if m_nKeyField <> -1 then
    Result := m_avarDatas[m_nKeyField, nItemIdx]
  else
    Result := EmptyParam;
end;

function TJSDBRzListView.OwnerDataFetch(Item: TListItem;
  Request: TItemRequest): Boolean;
var
  n, nIdx, nColIdx: Integer;
  sDataValue: string;
begin
  nIdx := Item.Index;
  Item.SubItems.Clear;

  for n := 0 to Columns.Count - 1 do
  begin
    nColIdx := Column[n].Tag;
    sDataValue := VarToStr(m_avarDatas[nColIdx, nIdx]);
    if n = 0 then
    begin
      Item.Caption := sDataValue;
      Item.ImageIndex := m_nDefaultImageIndex;
    end
    else
      Item.SubItems.Add(sDataValue);
  end;

  Result := True;
end;

function TJSDBRzListView.OwnerDataFind(Find: TItemFind;
  const FindString: string; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean): Integer;
var
  n, nIdx: Integer;
begin
  Result := -1;
  if (Find = ifExactString) or (Find = ifPartialString) then
  begin
    nIdx := Column[0].Tag;
    for n := StartIndex to m_rsDBLV.RecordCount - 1 do
      if SameText(FindString, m_avarDatas[nIdx, n]) then
      begin
        Result := n;
        Exit;
      end;
  end;
end;

procedure TJSDBRzListView.RefreshData;
var
  s:string;
begin
  { 刷新/显示数据 }

  if m_rsDBLV.State <> 0 then
    m_rsDBLV.Close;
  m_rsDBLV.Open(SQLString, Connection, adOpenKeyset, adLockReadOnly, adCmdText);

  try
    if not m_rsDBLV.EOF then
      //m_avarDatas := m_rsDBLV.GetRows(adGetRowsRest, adBookmarkFirst,
      //  EmptyParam);
      s:=m_rsDBLV.GetString(adClipString,-1,EmptyStr,EmptyStr,EmptyStr);
    Items.Count := m_rsDBLV.RecordCount;
  except

  end;
end;

procedure TJSDBRzListView.SetColumnCreate(const Value: TLVColumnClickEvent);
begin
  m_eColumnCreate := Value;
end;

procedure TJSDBRzListView.SetConnection(const Value: _Connection);
begin
  m_cnDBLV := Value;
end;

procedure TJSDBRzListView.SetDefaultImageIndex(const Value: Integer);
begin
  m_nDefaultImageIndex := Value;
end;

procedure TJSDBRzListView.SetItemBackColor(const Value: Boolean);
begin
  m_bItemBackColor := Value;
end;

procedure TJSDBRzListView.SetItemBackColorEnd(const Value: TColor);
begin
  m_clItemBackColorEnd := Value;
end;

procedure TJSDBRzListView.SetItemBackColorStart(const Value: TColor);
begin
  m_clItemBackColorStart := Value;
end;

procedure TJSDBRzListView.SetKeyFieldName(const Value: string);
begin
  m_sKeyFieldName := Value;
end;

procedure TJSDBRzListView.SetRecordset(const Value: _Recordset);
begin
  m_rsDBLV := Value;
end;

procedure TJSDBRzListView.SetShowIDField(const Value: Boolean);
begin
  m_bShowIDField := Value;
end;

procedure TJSDBRzListView.SetShowKeyField(const Value: Boolean);
begin
  m_bShowKeyField := Value;
end;

procedure TJSDBRzListView.SetSQLString(const Value: string);
begin
  m_sSQLString := Value;
end;

procedure TJSDBRzListView.StartFillData;
var
  n: Integer;
  sColCaption, sSQLString: string;
  col: TListColumn;
begin
  { 开始填充 }

  if (m_sSQLString <> EmptyStr) and (m_cnDBLV <> nil) then
  begin
    // TODO: 如果记录集打开则关闭记录集
    if m_rsDBLV.State <> 0 then
      m_rsDBLV.Close;

    // 构造'SELECT TOP 0 ...'的语句返回字段名
    sSQLString := m_sSQLString;
    if SameText(LeftBStr(sSQLString, 7), 'SELECT ') and not
      SameText(LeftBStr(sSQLString, 11), 'SELECT TOP ') then
      Insert('TOP 0 ', m_sSQLString, 8);

    m_rsDBLV.Open(m_sSQLString, m_cnDBLV,
      adOpenForwardOnly, adLockReadOnly, adCmdText);
    m_sSQLString := sSQLString;

    if m_rsDBLV.State <> 0 then
    begin
      Columns.Clear;
      Items.Clear;
      for n := 0 to m_rsDBLV.Fields.Count - 1 do
      begin
        sColCaption := m_rsDBLV.Fields[n].Name;

        // TODO: 判断是否为Key字段
        if SameText(sColCaption, m_sKeyFieldName) then
          m_nKeyField := n;

        // TODO: 判断是否为Key字段和ID字段并添加字段
        if ((m_nKeyField <> n) or m_bShowKeyField) and
          ((SameText(RightBStr(sColCaption, 3), '_ID') = False) or
          m_bShowIDField) then
        begin
          col := Columns.Add;
          col.Caption := sColCaption;
          col.Tag := n;
          if Assigned(m_eColumnCreate) then
            m_eColumnCreate(Self, col);
        end;
      end;

      if Columns.Count > 0 then
        RefreshData;
    end;
  end;
end;

end.