抉择不悔

倒计时


日志分类
小站公告
“人只不过是一根苇草,是自然界最脆弱的东西;但他是一根能思想的苇草。用不着整个宇宙都拿起武器来才能毁灭他;一口气、一滴水就足以致他死命了。然而,纵使宇宙毁灭了他,人却仍然要比致他于死命的东西更高贵得多;因为他知道自己要死亡,以及宇宙对他所具有的优势,而宇宙对此却是一无所知。因而,我们全部的尊严就在于思……”
    ----帕斯卡尔
最新日志
最新回复
最新留言
用户登陆
博客统计
博客名称:抉择不悔 日志总数:20 评论数量:4 访问次数:97474 建立时间::2005年05月21日

 [我的文摘] 1.扩展cxLookupComboBox,使其支持多列查询的cxLookupComboBoxEx
标签(TAG): http://www.delphibbs.com/keylife/iblog_show.asp?xid=5366

2004-1-10 17:08:06    1.扩展cxLookupComboBox,使其支持多列查询的cxLookupComboBoxEx

//==============================================================================
// Unit Name: cxLookupComboBoxEx
// Author   : ysai
// Date     : 2003
// Purpose  : 扩展cxLookupComboBox,cxDBLookupComboBox,使其支持多列过滤
// History  :
//    2003-05-28大数据量改进
//    2003-07-07可操作性改进
//    2003-08-20效率改进
//    2003-08-29加入过滤延时
// 注意:
//     限制1,不能再使用Properties.OnChange事件
//     限制2,不能再使用Properties.ListSource.DataSet.OnFilterRecord事件
//     限制3,不能再使用Properties.ListSource.DataSet.Filtered属性
//     其它,最好在设计期设好一切属性,运行期再设置属性可能引发求知错误
//==============================================================================

unit cxLookupComboBoxEx;

interface

uses
  SysUtils, Classes, Controls, Windows, Messages,DB,StrUtils,
  cxControls, cxContainer, cxEdit, cxTextEdit,
  cxMaskEdit, cxDropDownEdit, cxLookupEdit, cxDBLookupEdit,
  cxDBLookupComboBox;

type
  TcxLookupComboBoxEx = class(TcxLookupComboBox)
  private
    //保存要过滤的字段列表
    FFieldList  : TList;
    FFindText   : String;
   
    //过滤事件
    procedure _OnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    //编辑框文字改变事件
    procedure _OnChange(Sender : TObject);
    procedure GetFieldList;
    //延时过滤消息
    procedure WMTimer (var Message: TMessage); message WM_TIMER;
  protected
    //下拉表格收回时
    procedure CloseUp(AAccept: Boolean); override;
    //过滤过程
    procedure _FilterListSource;
    //初始化下拉表格事件
    procedure DoInitPopup; override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    //更新要过滤的字段列表
    procedure UpdateFilterFields;
  published
  end;

  TcxDBLookupComboBoxEx = class(TcxDBLookupComboBox)
  private
    //保存要过滤的字段列表
    FFieldList  : TList;
    FFindText   : String;

    //过滤事件
    procedure _OnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    //编辑框文字改变事件
    procedure _OnChange(Sender : TObject);
    //取得要过滤的字段列表
    procedure GetFieldList;
    //延时过滤消息
    procedure WMTimer (var Message: TMessage); message WM_TIMER;
  protected
    //下拉表格收回时
    procedure CloseUp(AAccept: Boolean); override;
    //过滤过程
    procedure _FilterListSource;
    //初始化下拉表格事件
    procedure DoInitPopup; override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    //更新要过滤的字段列表
    procedure UpdateFilterFields;
  published
  end;

procedure Register;

implementation

const
  UM_TIMER_FILTER = WM_USER + $101;             //自定义延时消息ID
  FILTERTIMER     = 500;                        //延时时间
  DROPDOWN_ROWS   = 12;

procedure Register;
begin
  RegisterComponents('Dev Express', [TcxLookupComboBoxEx,TcxDBLookupComboBoxEx]);
end;

{ TcxLookupComboBoxEx }

procedure TcxLookupComboBoxEx.CloseUp(AAccept: Boolean);
begin
  inherited;
  //收起下拉后取消过滤
  if  Assigned(Properties.ListSource) then
    if Assigned(Properties.ListSource.DataSet) then
      Properties.ListSource.DataSet.Filtered := False;
end;

constructor TcxLookupComboBoxEx.Create(AOwner: TComponent);
begin
  inherited;
  //默认值
  Properties.AutoSelect                 :=  False;
  Properties.DropDownAutoSize           :=  True;
  Properties.DropDownListStyle          :=  lsEditList;
  Properties.DropDownRows               :=  DROPDOWN_ROWS;
  Properties.DropDownSizeable           :=  True;
  Properties.IncrementalFiltering       :=  False;
  Properties.Revertable                 :=  True;
  Properties.OnChange                   :=  _OnChange;
  Properties.UseLeftAlignmentOnEditing  :=  False;
end;

destructor TcxLookupComboBoxEx.Destroy;
begin
  //释放过滤字段列表
  if Assigned(FFieldList) then FFieldList.Free;
  inherited;
end;

procedure TcxLookupComboBoxEx.DoInitPopup;
begin
  //取得过滤字段
  if  Assigned(Properties.ListSource) then
    if Assigned(Properties.ListSource.DataSet) then
    begin
      GetFieldList;
      Properties.ListSource.DataSet.Filtered := False;
    end;
  inherited DoInitPopup;
end;

procedure TcxLookupComboBoxEx._FilterListSource;
//过滤字段
begin
  if Assigned(Properties.ListSource)
      and Assigned(Properties.ListSource.DataSet) then
  try
    Properties.ListSource.DataSet.DisableControls;
    Properties.ListSource.DataSet.Filtered        :=  False;
    Properties.ListSource.DataSet.OnFilterRecord  :=  _OnFilterRecord;
    if Text <>  '' then
    begin
      FFindText :=  Text;
      if SelLength > 0 then
        FFindText :=  LeftStr(Text,SelStart);
      Properties.ListSource.DataSet.Filtered  :=  FFindText <> '';
    end;
    Changed;
  finally
    Properties.ListSource.DataSet.EnableControls;
  end;
end;

procedure TcxLookupComboBoxEx.GetFieldList;
//取得过滤字段列表
var
  i           : Integer;
  sFieldName  : String;
  fdTemp      : TField;
begin
  if not Assigned(FFieldList) then
  begin
    FFieldList  :=  TList.Create;
    for i:=0 to Properties.ListColumns.Count -1 do
    begin
      sFieldName := Properties.ListColumns.Items[i].FieldName;
      if sFieldName = '' then Continue;
      fdTemp  :=  Properties.ListSource.DataSet.FindField(sFieldName);
      if Assigned(fdTemp) then
        FFieldList.Add(Pointer(fdTemp));
    end;
  end;
end;

procedure TcxLookupComboBoxEx._OnChange(Sender: TObject);
//设置延时
begin
  if Focused and DroppedDown then
  begin
    KillTimer(Handle,UM_TIMER_FILTER);
    SetTimer(Handle,UM_TIMER_FILTER,FILTERTIMER,nil);
  end;
end;

procedure TcxLookupComboBoxEx._OnFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
//过滤事件
var
  s : String;
  i : Integer;
begin
  s :=  LowerCase(FFindText);
  if (s <> '') and (Properties.ListColumns.Count > 0) then
  begin
    Accept  :=  False;
    for i := 0 to FFieldList.Count -1 do
    begin
      Accept  :=  Pos(s,LowerCase(TField(FFieldList[i]).AsString))>0;
      if Accept then Exit;
    end;
  end
  else
    Accept  :=  True;
end;

procedure TcxLookupComboBoxEx.WMTimer(var Message: TMessage);
//延时更新消息
begin
  KillTimer(Handle,UM_TIMER_FILTER);
  if Focused and DroppedDown then _FilterListSource;
end;

procedure TcxLookupComboBoxEx.UpdateFilterFields;
//更新要过滤的字段列表
begin
  if Assigned(FFieldList) then
  begin
    FFieldList.Free;
    FFieldList  :=  nil;
  end;
  GetFieldList;
end;

{ TcxDBLookupComboBoxEx }

procedure TcxDBLookupComboBoxEx.CloseUp(AAccept: Boolean);
begin
  inherited;
  //收起下拉后取消过滤
  if  Assigned(Properties.ListSource) then
    if Assigned(Properties.ListSource.DataSet) then
      Properties.ListSource.DataSet.Filtered := False;
end;

constructor TcxDBLookupComboBoxEx.Create(AOwner: TComponent);
begin
  inherited;
  //默认值
  Properties.AutoSelect                 :=  False;
  Properties.DropDownListStyle          :=  lsEditList;
  Properties.DropDownRows               :=  DROPDOWN_ROWS;
  Properties.DropDownSizeable           :=  True;
  Properties.IncrementalFiltering       :=  False;
  Properties.Revertable                 :=  True;
  Properties.OnChange                   :=  _OnChange;
  Properties.UseLeftAlignmentOnEditing  :=  False;
end;

destructor TcxDBLookupComboBoxEx.Destroy;
begin
  //释放过滤字段列表
  if Assigned(FFieldList) then FFieldList.Free;
  inherited;
end;

procedure TcxDBLookupComboBoxEx.DoInitPopup;
begin
  //取得过滤字段
  if  Assigned(Properties.ListSource) then
    if Assigned(Properties.ListSource.DataSet) then
    begin
      GetFieldList;
      Properties.ListSource.DataSet.Filtered := False;
    end;
  inherited DoInitPopup;
end;

procedure TcxDBLookupComboBoxEx._FilterListSource;
//过滤字段
begin
  if Assigned(Properties.ListSource)
      and Assigned(Properties.ListSource.DataSet) then
  try
    Properties.ListSource.DataSet.DisableControls;
    Properties.ListSource.DataSet.Filtered        :=  False;
    Properties.ListSource.DataSet.OnFilterRecord  :=  _OnFilterRecord;
    if Text <>  '' then
    begin
      FFindText :=  Text;
      if SelLength > 0 then
        FFindText :=  LeftStr(Text,SelStart);
      Properties.ListSource.DataSet.Filtered  :=  FFindText <> '';
    end;
    Changed;
  finally
    Properties.ListSource.DataSet.EnableControls;
  end;
end;

procedure TcxDBLookupComboBoxEx.GetFieldList;
//取得过滤字段列表
var
  i           : Integer;
  sFieldName  : String;
  fdTemp      : TField;
begin
  if not Assigned(FFieldList) then
  begin
    FFieldList  :=  TList.Create;
    for i:=0 to Properties.ListColumns.Count -1 do
    begin
      sFieldName := Properties.ListColumns.Items[i].FieldName;
      if sFieldName = '' then Continue;
      fdTemp  :=  Properties.ListSource.DataSet.FindField(sFieldName);
      if Assigned(fdTemp) then
        FFieldList.Add(Pointer(fdTemp));
    end;
  end;
end;

procedure TcxDBLookupComboBoxEx._OnChange(Sender: TObject);
//设置延时
begin
  if Focused and DroppedDown then
  begin
    KillTimer(Handle,UM_TIMER_FILTER);
    SetTimer(Handle,UM_TIMER_FILTER,FILTERTIMER,nil);
  end;
end;

procedure TcxDBLookupComboBoxEx._OnFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
//过滤事件
var
  s : String;
  i : Integer;
begin
  s :=  LowerCase(FFindText);
  if (s <> '') and (Properties.ListColumns.Count > 0) then
  begin
    Accept  :=  False;
    for i := 0 to FFieldList.Count -1 do
    begin
      Accept  :=  Pos(s,LowerCase(TField(FFieldList[i]).AsString))>0;
      if Accept then Exit;
    end;
  end
  else
    Accept  :=  True;
end;

procedure TcxDBLookupComboBoxEx.WMTimer(var Message: TMessage);
//延时更新消息
begin
  KillTimer(Handle,UM_TIMER_FILTER);
  if Focused and DroppedDown then _FilterListSource;
end;

procedure TcxDBLookupComboBoxEx.UpdateFilterFields;
//更新要过滤的字段列表
begin
  if Assigned(FFieldList) then
  begin
    FFieldList.Free;
    FFieldList  :=  nil;
  end;
  GetFieldList;
end;

end.

2004-1-10 17:14:06    2.动态生成TcxGridDBTableView的列及页脚的合计栏

var
  i   : Integer;
  cl  : TcxGridDBColumn;
begin
  Screen.Cursor :=  crHourGlass;
  cxtvMaster.BeginUpdate;
  try
    cxtvMaster.ClearItems;
    cxtvMaster.DataController.Summary.FooterSummaryItems.Clear;
    for i := 0 to cxtvMaster.DataController.DataSet.FieldCount - 1 do
    begin
      cl  :=  cxtvMaster.CreateColumn;
      cl.DataBinding.FieldName :=
          cxtvMaster.DataController.DataSet.Fields[i].FieldName;
      if cxtvMaster.DataController.DataSet.Fields[i] is TNumericField then
      begin
        TNumericField(cxtvMaster.DataController.DataSet.Fields[i])
            .DisplayFormat  :=  '#,##0.00';
        cl.Width := 80;
        with TcxGridDBTableSummaryItem(
            cxtvMaster.DataController.Summary.FooterSummaryItems.Add) do
        begin
          Column  :=  cl;
          FieldName :=  cl.DataBinding.FieldName;
          Format  :=  '#,##0.00';
          Kind  :=  skSum;
        end;
      end
      else if cxtvMaster.DataController.DataSet.Fields[i] is TStringField then
        cl.Width := 100
      else
        cl.Width := 80;
      cl.HeaderAlignmentHorz :=  taCenter;
    end;  //if
  finally
    cxtvMaster.EndUpdate;
    Screen.Cursor := crDefault;
  end;
end;

2004-1-10 17:24:32    3.动态生成TcxGridDBBandedTableView的列及页脚的合计栏

如果存储过程或SQL返回如下结果集

员工     1月$  1月¥ 2月$ 2月¥ 合计$ 合计¥
-------------------------------------------
测试员A  200   1658  300  2487  500   4145

将生成如下样式的Grid(页脚没有画出,麻烦,另外设置了显示格式,金额将以#,##0.00的方式显示)
_________________________________________________
|  员工  |    1月     |    2月     |    合计    |
|-----------------------------------------------|
|  员工  |  $ |  ¥  |  $ |  ¥  |  $ |  ¥  |
|-----------------------------------------------|
|测试员A | 200 | 1658 | 300 | 2487 | 500 | 4145 |
-------------------------------------------------

var
  i     : Integer;
  cl    : TcxGridDBBandedColumn;
begin
  Screen.Cursor :=  crHourGlass;
  cxbtvMaster.BeginUpdate;
  try
    cxbtvMaster.ClearItems;
    cxbtvMaster.Bands.Clear;
    cxbtvMaster.DataController.Summary.FooterSummaryItems.Clear;
    for i := 0 to cxbtvMaster.DataController.DataSet.FieldCount - 1 do
    begin
      if i = 0 then
        with cxbtvMaster.Bands.Add do
        begin
          Options.HoldOwnColumnsOnly  :=  True;
          Caption  := cxbtvMaster.DataController.DataSet.Fields[i].FieldName;
        end;
      if RightStr(
          cxbtvMaster.DataController.DataSet.Fields[i].FieldName,
          1) = '$' then
        with cxbtvMaster.Bands.Add do
        begin
          Options.HoldOwnColumnsOnly  :=  True;
          Caption  := Copy(
              cxbtvMaster.DataController.DataSet.Fields[i].FieldName, 1,
              Length(cxbtvMaster.DataController.DataSet.Fields[i].FieldName)
              - 1);
          cxbtvMaster.DataController.DataSet.Fields[i].DisplayLabel :=  '$';
        end;
      if RightStr(
          cxbtvMaster.DataController.DataSet.Fields[i].FieldName,
          1) = '¥' then
        cxbtvMaster.DataController.DataSet.Fields[i].DisplayLabel :=  '¥';

      cl  :=  cxbtvMaster.CreateColumn;
      cl.HeaderAlignmentHorz :=  taCenter;
      cl.Position.BandIndex :=  cxbtvMaster.Bands.Count - 1;
      cl.DataBinding.FieldName :=
          cxbtvMaster.DataController.DataSet.Fields[i].FieldName;
      if cxbtvMaster.DataController.DataSet.Fields[i] is TNumericField then
      begin
        TNumericField(cxbtvMaster.DataController.DataSet.Fields[i])
            .DisplayFormat  :=  '#,##0.00';
        cl.Width := 80;
        with TcxGridDBBandedTableSummaryItem(
            cxbtvMaster.DataController.Summary.FooterSummaryItems.Add) do
        begin
          Column  :=  cl;
          FieldName :=  cl.DataBinding.FieldName;
          Format  :=  '#,##0.00';
          Kind  :=  skSum;
        end;
      end
      else if cxbtvMaster.DataController.DataSet.Fields[i] is TStringField then
        cl.Width := 100
      else
        cl.Width := 80;
    end;  //if
  finally
    cxbtvMaster.EndUpdate;
    Screen.Cursor := crDefault;
  end;
end;

2004-1-31 22:36:25    4.自动调整列宽的方法要注意的地方

可以用ApplyBestFit实现自动列宽;
不能在BeginUpdate和EndUpdate之间调用这个方法,否则会产生下标越界错误;
在BeginUpdate和EndUpdate中清除/建立列不会产生屏幕闪烁,其它需要长时间更新cxGrid数据的操作最好放在BeginUpdate和EndUpdate执行,并用try包起来.

2004-2-8 15:32:30    DevExpress Bar的动态菜单

没有什么说明,细心点应该知道表结构及数据的内容形式
对比了一下代码,用dxBar比用ToolBar+PopupMenu生成动态菜单要简单,只用了一个递归过程

type
  //菜单项
  PMenuItemInfo = ^TMenuItemInfo;
  TMenuItemInfo = record
    ID            : string;
    ParentID      : string;
    Caption       : string;
    Hint          : string;
    LibraryName   : string;
    ProcedureName : string;
    wParam        : Integer;
    lParam        : Integer;
  end;

procedure TmgMainForm.BuildMenu;
//生成菜单

  procedure SetMenuItemInfo(
      const ADataSet  : TDataSet;
      const AItem     : PMenuItemInfo
      );
  begin
    AItem.ID            :=  ADataSet.FieldByName('ID').AsString;
    AItem.ParentID      :=  ADataSet.FieldByName('ParentID').AsString;
    AItem.Caption       :=  ADataSet.FieldByName('Caption').AsString;
    AItem.Hint          :=  ADataSet.FieldByName('Hint').AsString;
    AItem.LibraryName   :=  ADataSet.FieldByName('LibraryName').AsString;
    AItem.ProcedureName :=  ADataSet.FieldByName('ProcedureName').AsString;
    AItem.wParam        :=  ADataSet.FieldByName('wParam').AsInteger;
    AItem.lParam        :=  ADataSet.FieldByName('lParam').AsInteger;
  end;

  procedure CreateItemList(
      const ADataSet  : TDataSet;
      const AList     : TList;
      const AText     : string
      );
  //根据父节点建立子项目列表
  var
    m : PMenuItemInfo;
    i : Integer;
  begin
    ADataSet.First;
    for i := 0 to ADataSet.RecordCount - 1 do
    begin
      if ADataSet.FieldByName('ParentID').AsString = AText then
      begin
        New(m);
        SetMenuItemInfo(ADataSet,m);
        AList.Add(m);
        ADataSet.Delete;
      end else
        ADataSet.Next;
    end;  //for
  end;

  procedure CreateMenuItems(
      const ADataSet    : TDataSet;
      const AKeyValue   : string;
      const AItemLinks  : TdxBarItemLinks;
      const AIndex      : Integer
      );
  //建立菜单项
  var
    db  : TdxBarButton;
    dbs : TdxBarSubItem;
    l   : TList;
    i   : Integer;
    j   : Integer;
    bg  : Boolean;
  begin
    bg  :=  False;
    j :=  AIndex;
    l :=  TList.Create;
    try
      CreateItemList(ADataSet, l, AKeyValue);
      for i := 0 to l.Count - 1 do
      begin
        if ADataSet.Locate('ParentID', PMenuItemInfo(l[i]).ID, []) then
        begin
          //有子项
          dbs         :=  TdxBarSubItem.Create(dxBar);
          dbs.Caption :=  PMenuItemInfo(l[i]).Caption;
          dbs.Hint    :=  PMenuItemInfo(l[i]).Hint;
          dbs.Tag     :=  Integer(l[i]);
          if AIndex > 0 then
            dbs.ImageIndex  :=  0;
          with AItemLinks.Add do
          begin
            Item        :=  dbs;
            Index       :=  j;
            BeginGroup  :=  bg;
          end;  //with
          bg          :=  False;
          CreateMenuItems(ADataSet, PMenuItemInfo(l[i]).ID, dbs.ItemLinks, 0);
          if dbs.ItemLinks.Count = 0 then
            dbs.Free
          else
            Inc(j);
        end
        else begin
          //无子项
          if not (PMenuItemInfo(l[i]).Caption = '-') then
          begin
            db          :=  TdxBarButton.Create(dxBar);
            db.Caption  :=  PMenuItemInfo(l[i]).Caption;
            db.Hint     :=  PMenuItemInfo(l[i]).Hint;
            db.Tag      :=  Integer(l[i]);
            db.OnClick  :=  MenuItemClick;
            if AIndex > 0 then
              db.ImageIndex :=  0;
            with AItemLinks.Add do
            begin
              Item        :=  db;
              Index       :=  j;
              BeginGroup  :=  bg;
            end;
            bg          :=  False;
            Inc(j);
          end
          else begin
            bg  :=  True;
          end;  //if bg
        end;  //if  Locate
      end;  //for
    finally
      l.Free;
    end;
  end;

var
  rsMenus : TDataSet;
begin
  rsMenus :=  mgDMMain.GetMenus;  //取得数据集
  if Assigned(rsMenus) then
  try
    CreateMenuItems(rsMenus, '', dxBar.Bars[0].ItemLinks, 1);
    //一定要刷新一下,否则不更改样式会出错
    dxBar.Bars[0].ItemLinks[0].Visible  :=  False;
    dxBar.Bars[0].ItemLinks[0].Visible  :=  True;
  finally
    rsMenus.Free;
  end;
end;

2005-1-4 16:34:35    取得TcxLookupComboBox下拉列表中各项的内容

Properties.DataController.Values包含了所有内容,如果要取得当前选择行的内容,用以下代码
//cmb:TcxLookupComboBox;
  with cmb.Properties.DataController do
    ShowMessage(Values[FindRecordIndexByKey(cmb.EditValue),0]);
//0代表显示的第一列,以Properties.ListColumns为准,可以从这个集合中查找对应的字段名

抉择不悔 发表于:2006/7/14 11:41:07 阅读(5710) 评论(84)
 

中华工控网 | 联系我们 | 工控论坛首页 | 工控博客首页 | 博客注册 | 博客登陆

工控博客管理联系邮箱:工控博客服务邮箱

中华工控网 © Copyright 2013. All rights reserved.