📄 uselectcust.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 + -