⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uselectcust.pas

📁 简单易用的按件按时计工资管理系统
💻 PAS
字号:
unit uSelectCust;

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;

type
  TSelectCust = 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;
    COL_NO: TdxDBGridColumn;
    CellColumn1: TdxDBGridColumn;
    CellColumn2: TdxDBGridColumn;
    CellColumn3: TdxDBGridColumn;
    CellColumn4: TdxDBGridColumn;
    CellColumn5: TdxDBGridColumn;
    CellColumn0: TdxDBGridCheckColumn;
    ToolButton1: TToolButton;
    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);
  private
    FSelectedCount: Integer;
    FSelectedRecords: Olevariant;

    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); 

  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 SelectedRecords: Olevariant read FSelectedRecords write FSelectedRecords;
    property SelectedCount: Integer read FSelectedCount write FSelectedCount;
  end;

var
  SelectCust: TSelectCust;

implementation

uses uGlobal, uDM;

{$R *.dfm}

{ TSelectCust }

procedure TSelectCust.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_FldName_Selected) = nil then Exit;
    DisableControls;
    First;
    try
      while not Eof do
      begin
        case pOptions of
          0: if FieldByName(CS_FldName_Selected).AsString = CS_Default_Yes then //清除
            begin
              Edit;
              FieldByName(CS_FldName_Selected).AsString := CS_Default_NO;
              Post;
            end;
          1: if FieldByName(CS_FldName_Selected).AsString = CS_Default_No then //全选
            begin
              Edit;
              FieldByName(CS_FldName_Selected).AsString := CS_Default_Yes;
              Post;
            end;
          -1:
            begin
              Edit;
              if FieldByName(CS_FldName_Selected).AsString = CS_Default_Yes then //反选
                FieldByName(CS_FldName_Selected).AsString := CS_Default_NO
              else FieldByName(CS_FldName_Selected).AsString := CS_Default_Yes;
              Post;
            end;
        end;
        Next;
      end;
    finally
      EnableControls;
    end;
  end;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function TSelectCust.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 TSelectCust.GetDefaultCond: string;
begin
  Result:='(FIN_USE = ''0'' OR FIN_USE IS NULL) AND FIS_CUST=''1'''
end;

procedure TSelectCust.Query;
var
  sCondition: string;
  pData: OleVariant;
begin
  sCondition := GetCondition;
  if sCondition = FOldCondition then exit;

  DM.GetList(CS_OrderType_Cust, CS_TableType_HeaderVW, CS_SelType_Selected1, sCondition, pData);
  cdsMast.Data :=pData;
  SetCellAutoWidth(Cell);
end;

function TSelectCust.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 TSelectCust.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 TSelectCust.IsQueryField(pField: string): Boolean;
begin
  Result := False;
  if pField = '' then Exit;
  Result := Cell.FindColumnByFieldName(pField) <> nil;
end;

function TSelectCust.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 TSelectCust.GetSelectedRecords(pDataSet: TClientDataSet): Olevariant;
{获取当前被选择的记录作为Olevariant参数传出}
var
  BM: TBookmark;
  aCds: TClientDataSet;
begin
  Result := Null;
  SelectedCount:=0;
  if not CheckDataSet(pDataSet) then Exit;

  aCds := TClientDataSet.Create(nil);
  BM := pDataSet.GetBookmark;  
  try
    pDataSet.CheckBrowseMode;
    pDataSet.DisableControls;

    aCds.FieldDefs := pDataSet.FieldDefs;
    aCds.CreateDataSet;
    aCds.Open;

    if pDataSet.FindField(CS_FldName_Selected) = nil then
    begin
      aCds.Append;
      move(pDataSet.activebuffer^, aCds.activebuffer^, pDataSet.RecordSize);
      aCds.Post;
      Result := aCds.Data;
      SelectedCount := 1;
      Exit;
    end;

    pDataSet.First;
    SelectedCount := 0;
    while not pDataSet.Eof do
    begin
      if pDataSet.FieldByName(CS_FldName_Selected).AsString = CS_DefVal_Yes then
      begin
        aCds.Append;
        move(pDataSet.activebuffer^, aCds.activebuffer^, pDataSet.RecordSize);
        aCds.Post;

        SelectedCount := SelectedCount + 1;
        pDataSet.Next;
        Continue;
      end;
      pDataSet.Next;
    end;

    Result := acds.Data;
  finally
    pDataSet.GotoBookmark(BM);
    pDataSet.FreeBookmark(BM);
    pDataSet.EnableControls;
    aCds.Close;
    FreeAndNil(acds);
  end;
end;

procedure TSelectCust.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 TSelectCust.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 TSelectCust.CellColumn0ToggleClick(Sender: TObject;
  const Text: String; State: TdxCheckBoxState);
begin
  if cdsMast.FindField(CS_FldName_Selected) = nil then Exit;
  cdsMast.FieldByName(CS_Fldname_Selected).AsString := Text;
  cdsMast.CheckBrowseMode;
end;

procedure TSelectCust.FormCreate(Sender: TObject);
begin
  Cell.OnCustomDrawCell := OnDrawNoCell; //将重画序号列
  cdsMast.Data := GetEmptyData;
  SetCellAutoWidth(Cell);
end;

function TSelectCust.GetEmptyData: OleVariant;
var
  sCondition: string;
begin
  sCondition := ' WHERE 1=2 ';
  DM.GetList(CS_OrderType_Cust, CS_TableType_HeaderVW, CS_SelType_Selected1, sCondition, Result);
end;

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

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -