jsdblistview.pas

销售软件

unit JSDBListView;

interface

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

type
  TJSDBListView = class( TRzListView )
  private
    m_cnDBListView: _Connection;
    m_rsDBListView: _Recordset;
    m_sSQLString: string;
    m_sKeyFieldName: string;
    m_bShowKeyField: Boolean;
    m_bItemBackColor: Boolean;
    m_bShowIDField: Boolean;
    m_nKeyField: Integer;
    m_nDefaultImageIndex: Integer;
    m_eColumnCreate: TLVColumnClickEvent;
    m_clItemBackColorStart: TColor;
    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( const bClearColumnHeader: Boolean = True );
    procedure RefreshData;
    function ItemKeyFieldValue( nItemIdx: Integer ): Variant;
    function FieldName( nFieldIdx: Integer ): string;
    function GetValue( nFieldIdx, nRecordIdx: Integer ): Variant;
    function GetItemByKeyFieldValue( varKeyFieldValue: Variant ):
      TListItem;
    procedure CloseRecordset;
  published
    property Connection: _Connection
      read m_cnDBListView
      write SetConnection;
    property SQLString: string
      read m_sSQLString
      write SetSQLString;
    property RecordSet: _Recordset
      read m_rsDBListView
      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', [ TJSDBListView ] );
end;

{ TJSDBListView }

procedure TJSDBListView.CloseRecordset;
begin
  if ( m_rsDBListView <> nil ) and ( m_rsDBListView.State <> adStateClosed )
    then
    m_rsDBListView.Close;
end;

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

  m_rsDBListView := 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 TJSDBListView.CustomDrawItem( Item: TListItem;
  State: TCustomDrawState; Stage: TCustomDrawStage ): Boolean;
begin
  Result := inherited CustomDrawItem( Item, State, Stage );

  if m_bItemBackColor then
    if ( Item.Index mod 2 ) = 0 then
      Canvas.Brush.Color := m_clItemBackColorStart
    else
      Canvas.Brush.Color := m_clItemBackColorEnd;
end;

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

destructor TJSDBListView.Destroy;
begin
  if m_rsDBListView.State <> adStateClosed then
    m_rsDBListView.Close;
  m_rsDBListView := nil;
  m_cnDBListView := nil;

  inherited;
end;

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

function TJSDBListView.GetItemByKeyFieldValue( varKeyFieldValue: Variant ):
  TListItem;
var
  n: Integer;
begin
  Result := nil;
  if varKeyFieldValue <> Null then
    for n := 0 to m_rsDBListView.RecordCount - 1 do
    begin
      m_rsDBListView.Move( n, AdBookmarkFirst );
      if m_rsDBListView.Fields[ KeyFieldName ].Value = varKeyFieldValue then
      begin
        Result := Items[ n ];
        Exit;
      end;
    end;
end;

function TJSDBListView.GetValue( nFieldIdx, nRecordIdx: Integer ): Variant;
begin
  Result := Null;
  if m_rsDBListView.State <> adStateClosed then
  begin
    m_rsDBListView.Move( nRecordIdx, AdBookmarkFirst );
    Result := m_rsDBListView.Fields[ nFieldIdx ].Value;
  end;
end;

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

  if ( m_nKeyField <> -1 ) and ( m_rsDBListView.State <> adStateClosed ) then
  begin
    m_rsDBListView.Move( nItemIdx, adBookmarkFirst );
    Result := m_rsDBListView.Fields[ m_nKeyField ].Value;
  end
  else
    Result := Null;
end;

function TJSDBListView.OwnerDataFetch( Item: TListItem;
  Request: TItemRequest ): Boolean;
var
  n, nIdx, nColIdx: Integer;
  sDataValue: string;
begin
  Result := False;
  if ( m_rsDBListView.State <> adStateClosed ) and ( m_rsDBListView.RecordCount
    <> 0 ) then
  begin
    nIdx := Item.Index;
    Item.SubItems.Clear;

    if m_rsDBListView.RecordCount >= nIdx then
    begin
      m_rsDBListView.Move( nIdx, AdBookmarkFirst );
      if not m_rsDBListView.EOF then
        for n := 0 to Columns.Count - 1 do
        begin
          nColIdx := Column[ n ].Tag;
          sDataValue := VarToStr( m_rsDBListView.Fields[ nColIdx ].Value );
          if n = 0 then
          begin
            Item.Caption := sDataValue;
            Item.ImageIndex := m_nDefaultImageIndex;
          end
          else
            Item.SubItems.Add( sDataValue );
        end;
    end;

    Result := True;
  end;
end;

function TJSDBListView.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 ( m_rsDBListView.State <> adStateClosed ) and ( ( Find = ifExactString ) or
    ( Find = ifPartialString ) ) then
  begin
    nIdx := Column[ 0 ].Tag;
    for n := StartIndex to m_rsDBListView.RecordCount - 1 do
    begin
      m_rsDBListView.Move( n, adBookmarkFirst );
      if SameText( FindString, m_rsDBListView.Fields[ nIdx ].Value ) then
      begin
        Result := n;
        Exit;
      end;
    end;
  end;
end;

procedure TJSDBListView.RefreshData;
begin
  { 刷新/显示数据 }

  Items.Count := m_rsDBListView.RecordCount;
  Refresh;
end;

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

procedure TJSDBListView.SetConnection( const Value: _Connection );
begin
  m_cnDBListView := Value;
end;

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

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

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

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

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

procedure TJSDBListView.SetRecordset( const Value: _Recordset );
begin
  m_rsDBListView := Value;
end;

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

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

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

procedure TJSDBListView.StartFillData( const bClearColumnHeader: Boolean = True
  );
var
  n: Integer;
  sColCaption: string;
  col: TListColumn;
begin
  { 开始填充 }

  if ( m_sSQLString <> EmptyStr ) and ( m_cnDBListView <> nil ) then
  begin
    // TODO: 如果记录集打开则关闭记录集
    if m_rsDBListView.State <> adStateClosed then
      m_rsDBListView.Close;
    m_rsDBListView.Open( m_sSQLString, m_cnDBListView, adOpenKeyset,
      adLockReadOnly, adCmdText );

    if m_rsDBListView.State <> adStateClosed then
    begin
      Items.Clear;

      // TODO: 清空列表头
      if bClearColumnHeader then
      begin
        Columns.Clear;
        for n := 0 to m_rsDBListView.Fields.Count - 1 do
        begin
          sColCaption := m_rsDBListView.Fields[ n ].Name;

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

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

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

end.