umultiselect.pas

简单易用的按件按时计工资管理系统

unit uMultiSelect;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, DB, DBClient, uMain, StdCtrls, Buttons, ExtCtrls,
  ComCtrls, ToolWin, dxExEdtr, dxCntner, dxTL, dxDBCtrl, dxDBGrid,
  dxDBTLCl, dxGrClms, ImgList, Grids, DBGrids, Provider;

type
  TMultiSelect = class(TForm)
    cdsMast: TClientDataSet;
    dsMast: TDataSource;
    Actions: TActionList;
    actFirst: TAction;
    actPrior: TAction;
    actNext: TAction;
    actLast: TAction;
    actQuery: TAction;
    actClose: TAction;
    actOK: TAction;
    actSelectReverse: TAction;
    actClearSelected: TAction;
    actSelectAll: TAction;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    pnlTop: TPanel;
    lblTip_InputCond: TLabel;
    edtValue: TEdit;
    BitBtn1: TBitBtn;
    pnlCell: TPanel;
    Cell: TdxDBGrid;
    ToolButton1: TToolButton;
    Img_Main: TImageList;
    dspMast: TDataSetProvider;
    procedure actFirstExecute(Sender: TObject);
    procedure actPriorExecute(Sender: TObject);
    procedure actNextExecute(Sender: TObject);
    procedure actLastExecute(Sender: TObject);
    procedure actQueryExecute(Sender: TObject);
    procedure actCloseExecute(Sender: TObject);
    procedure actOKExecute(Sender: TObject);
    procedure actSelectReverseExecute(Sender: TObject);
    procedure actClearSelectedExecute(Sender: TObject);
    procedure actSelectAllExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure CellColumn0ToggleClick(Sender: TObject; const Text: String;
      State: TdxCheckBoxState);
    procedure FormCreate(Sender: TObject);
    procedure edtValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  private
    FSelectedCount: Integer;
    FSelectedRecords: Olevariant;
    FTableName: string;

    function GetAQueryCondition(pField, pValue: string): string;
    function IsQueryField(pField: string): Boolean;
    function IsStringField(pField: string): Boolean;
    function GetSelectedRecords(pDataSet: TClientDataSet): Olevariant;
    { Private declarations }
    procedure OnDrawNoCell(Sender: TObject; ACanvas: TCanvas; //重画序号列
      ARect: TRect; ANode: TdxTreeListNode; AColumn: TdxTreeListColumn;
      ASelected, AFocused, ANewItemRow: Boolean; var AText: string;
      var AColor: TColor; AFont: TFont; var AAlignment: TAlignment;
      var ADone: Boolean);
    procedure SetTableName(const Value: string);

  protected
    FOldCondition: string;
    procedure First; virtual; //首记录
    procedure Prior; virtual; //前一条
    procedure Next; virtual; //下一条
    procedure Last; virtual; //尾记录

    procedure SelectAll; virtual; //全选
    procedure SelectReverse; virtual; //反选
    procedure ClearSelected; virtual; //清除
    procedure SelectRecorders(DataSet: TDataSet; pOptions: Integer);virtual; 
    procedure DoOk; virtual;
    procedure Query; virtual;

    function GetCondition: string;
    function GetDefaultCond: string;
    function GetQueryCond: string;

    function GetEmptyData: OleVariant;

  public
    { Public declarations }
    property  TableName:string read FTableName write SetTableName;
    property SelectedRecords: Olevariant read FSelectedRecords write FSelectedRecords;
    property SelectedCount: Integer read FSelectedCount write FSelectedCount;
  end;

var
  MultiSelect: TMultiSelect;

implementation

uses uGlobal, uDM;

{$R *.dfm}

{ TSelectCust }

procedure TMultiSelect.SelectRecorders(DataSet: TDataSet; pOptions: Integer);
{参数pID: 0:ClearSelected; 1选择全部; -1反选}
begin
  if not CheckDataSet(DataSet) then Exit;
  DataSet.CheckBrowseMode;
  with DataSet do
  begin
    if FindField(CS_SelectFieldName) = nil then Exit;
    DisableControls;
    First;
    try
      while not Eof do
      begin
        case pOptions of
          0: if FieldByName(CS_SelectFieldName).AsString = CS_Default_Yes then //清除
            begin
              Edit;
              FieldByName(CS_SelectFieldName).AsString := CS_Default_NO;
              Post;
            end;
          1: if FieldByName(CS_SelectFieldName).AsString = CS_Default_No then //全选
            begin
              Edit;
              FieldByName(CS_SelectFieldName).AsString := CS_Default_Yes;
              Post;
            end;
          -1:
            begin
              Edit;
              if FieldByName(CS_SelectFieldName).AsString = CS_Default_Yes then //反选
                FieldByName(CS_SelectFieldName).AsString := CS_Default_NO
              else FieldByName(CS_SelectFieldName).AsString := CS_Default_Yes;
              Post;
            end;
        end;
        Next;
      end;
    finally
      EnableControls;
    end;
  end;
end;

procedure TMultiSelect.DoOk;
begin
  ModalResult := mrOK;
end;

procedure TMultiSelect.First;
begin
  if not CheckDataSet(cdsMast) then Exit;
  cdsMast.First;
end;

procedure TMultiSelect.Last;
begin
  if not CheckDataSet(cdsMast) then Exit;
  cdsMast.Last;
end;

procedure TMultiSelect.Next;
begin
  if not CheckDataSet(cdsMast) then Exit;
  cdsMast.Next;
end;

procedure TMultiSelect.Prior;
begin
  if not CheckDataSet(cdsMast) then Exit;
  cdsMast.Prior;
end;

procedure TMultiSelect.SelectAll;
begin
  SelectRecorders(cdsMast, 1);
end;

procedure TMultiSelect.SelectReverse;
begin
  SelectRecorders(cdsMast, -1);
end;

procedure TMultiSelect.ClearSelected;
begin
  SelectRecorders(cdsMast, 0);
end;

procedure TMultiSelect.actFirstExecute(Sender: TObject);
begin
  First;
end;

procedure TMultiSelect.actPriorExecute(Sender: TObject);
begin
  Prior;
end;

procedure TMultiSelect.actNextExecute(Sender: TObject);
begin
  Next;
end;

procedure TMultiSelect.actLastExecute(Sender: TObject);
begin
  Last;
end;

procedure TMultiSelect.actQueryExecute(Sender: TObject);
begin
  Query;
end;

procedure TMultiSelect.actCloseExecute(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TMultiSelect.actOKExecute(Sender: TObject);
begin
  DoOk;
end;

procedure TMultiSelect.actSelectReverseExecute(Sender: TObject);
begin
  SelectReverse;
end;

procedure TMultiSelect.actClearSelectedExecute(Sender: TObject);
begin
  ClearSelected;
end;

procedure TMultiSelect.actSelectAllExecute(Sender: TObject);
begin
  SelectAll;
end;

function TMultiSelect.GetCondition: string;
var
  sTmp: string;
begin
  Result := GetDefaultCond;

  sTmp := GetQueryCond;
  if sTmp <> '' then
  begin
    if Result <> '' then
      Result := Result + ' AND ' + sTmp
    else
      Result := sTmp;
  end;

  if Result <> '' then
    Result := ' WHERE ' + Result;
end;

function TMultiSelect.GetDefaultCond: string;
begin
  Result:=' (是否作废=' + chr(39) + '0' + chr(39) + ') ';
end;

procedure TMultiSelect.Query;
var
  sCondition: string;
  //pData: OleVariant;
begin
  sCondition := GetCondition;
  if sCondition = FOldCondition then exit;
  FOldCondition:=sCondition;
  cdsMast.DisableControls ;
  try
    if cdsMast.Active then cdsMast.Close ;
    cdsMast.CommandText :='SELECT * FROM ' + FTableName + sCondition;
    cdsMast.Active:=True;
  finally
    cdsMast.EnableControls ;
  end;
 { DM.GetRecordsEx (FTableName, sCondition, pData);
  cdsMast.Data :=pData;
  SetCellAutoWidth(Cell);  }
end;

function TMultiSelect.GetAQueryCondition(pField,
  pValue: string): string;
begin
  Result := '';
  if (pField = '') or (pValue = '') then
    Exit;

  Result := '(' + 'UPPER('
    + pField + ')'
    + ' LIKE '
    + 'UPPER(' + chr(39) + '%' + pValue + '%' + chr(39) + ')) ';
end;


function TMultiSelect.GetQueryCond: string;
var
  i: Integer;
  sField, sCondition: string;
  pValue:string;
begin
  Result:='';
  pValue:=Trim(edtValue.Text);
  if pValue='' then exit;
  sCondition := '';
  
  for i := 0 to Cell.ColumnCount - 1 do
  begin
    sField := UpperCase(Cell.Columns[i].FieldName);
    if IsQueryField(sField) and IsStringField(sField) then
    begin
      if sCondition <> '' then
        sCondition := sCondition + ' OR ' + GetAQueryCondition(sField, pValue)
      else
        sCondition := GetAQueryCondition(sField, pValue);
    end;
  end;
  Result := sCondition;
  if Result <> '' then Result := '(' + Result + ') ';

end;

function TMultiSelect.IsQueryField(pField: string): Boolean;
begin
  Result := False;
  if pField = '' then Exit;
  Result := Cell.FindColumnByFieldName(pField) <> nil;
end;

function TMultiSelect.IsStringField(pField: string): Boolean;
begin
  Result := false;
  if (Cell.DataSource = nil) or
    (Cell.DataSource.DataSet = nil) then
    exit;
  with Cell.DataSource.DataSet do
  begin
    if FindField(pField) = nil then
      Exit;
    case FieldByName(pField).DataType of
      ftString,
        ftFixedChar,
        ftWideString,
        ftFmtMemo,
        ftMemo: Result := True
    else
      Result := False;
    end;
  end;
end;

function TMultiSelect.GetSelectedRecords(pDataSet: TClientDataSet): Olevariant;
{获取当前被选择的记录作为Olevariant参数传出}
var
  BM: TBookmark;
  aCds: TClientDataSet;
begin
  Result := Null;
  SelectedCount:=0;
  if not CheckDataSet(pDataSet) then Exit;
  if pDataSet.RecordCount =0 then exit;
  aCds := TClientDataSet.Create(nil);
  BM := pDataSet.GetBookmark;
  try
    pDataSet.CheckBrowseMode;
    pDataSet.DisableControls;
    aCds.CloneCursor(pDataSet, False);
    SelectedCount := aCds.RecordCount;
    with aCds do
    begin
      First;
      while not Eof do
      begin
        if FieldByName(CS_SelectFieldName).AsString = CS_DefVal_No then
        begin
          Delete;
          SelectedCount:=SelectedCount -1;
        end;
        Next;
      end;
    end;
    Result := acds.Data;
    if SelectedCount<0 then SelectedCount:=0;
  finally
    pDataSet.GotoBookmark(BM);
    pDataSet.FreeBookmark(BM);
    pDataSet.EnableControls;
    aCds.Close;
    FreeAndNil(acds);
  end;
end;

procedure TMultiSelect.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:= True;
  if ModalResult=mrOk then
  begin
    SelectedRecords:=GetSelectedRecords(cdsMast);
    if SelectedCount<=0 then
    begin
      CanClose:= False;
      Application.MessageBox('至少要选择一个记录', pchar(Application.Title ), MB_OK + MB_ICONWARNING);
    end;
  end;

end;

procedure TMultiSelect.OnDrawNoCell(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; ANode: TdxTreeListNode; AColumn: TdxTreeListColumn;
  ASelected, AFocused, ANewItemRow: Boolean; var AText: string;
  var AColor: TColor; AFont: TFont; var AAlignment: TAlignment;
  var ADone: Boolean);
begin
  if AColumn.Name = CS_ColName_No then
  begin
    AText := IntToStr(1 + ANode.Index);
    AColor := clBtnFace;
    AFont.Color := clBlack;
  end;
end;

procedure TMultiSelect.CellColumn0ToggleClick(Sender: TObject;
  const Text: String; State: TdxCheckBoxState);
begin
  if cdsMast.FindField(CS_SelectFieldName) = nil then Exit;
  cdsMast.FieldByName(CS_SelectFieldName).AsString := Text;
  cdsMast.CheckBrowseMode;
end;

procedure TMultiSelect.FormCreate(Sender: TObject);
begin
  Cell.OnCustomDrawCell := OnDrawNoCell; //将重画序号列
end;

function TMultiSelect.GetEmptyData: OleVariant;
var
  sCondition: string;
begin
  sCondition := ' WHERE 1=2 ';
  DM.GetRecordsEx (FTableName, sCondition, Result);
end;

procedure TMultiSelect.edtValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then
  begin
    actQuery.Execute ;
    Cell.SetFocus ;
  end;
end;

procedure TMultiSelect.SetTableName(const Value: string);
begin
  FTableName := Value;
end;

procedure TMultiSelect.FormShow(Sender: TObject);
begin
 // cdsMast.Data := GetEmptyData;
  Query;
  CreateCellCols(Cell, cdsMast);
  SetAllColumnsCanEdit(cell, False);
  AddCheckColumn(Cell, CS_SelectFieldName);
  SetCellAutoWidth(Cell);
end;

end.