2 Star 8 Fork 3

闲散居士/数据库备份

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
克隆/下载
mulselect.pas 6.70 KB
一键复制 编辑 原始数据 按行查看 历史
unit mulselect;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, CheckLst, ExtCtrls, Buttons,db;
type
TMulSelectForm = class(TForm)
Panel1: TPanel;
CheckListBox1: TCheckListBox;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
procedure CheckListBox1ClickCheck(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
CHECKCLICK:BOOLEAN;
setOnlyOne:Boolean;
selectValues:TStrings;
selectItems:TStrings;
values:TStrings;
procedure SELEONLY(SENDER:TObject);
function GetData(QUERY1: TDataSet; CheckListBox: TCheckListBox;
selected:TStrings): TStrings;
procedure SetChecked(selected: TStrings);
public
{ Public declarations }
function StartSelect(inQuery1:TDataSet;
var inSelectValues:TStrings; isOnlyOne:Boolean=false):TStrings;overload;
function StartSelect(inquery1:TDataSet;
var inSelectValues:String; isOnlyOne:Boolean=false):String;overload;
procedure SETSELECT(SENDER: TObject);
function GetSelectText(CheckListBox: TCheckListBox;
isString: Boolean=true): String;
end;
var
MulSelectForm: TMulSelectForm;
implementation
{$R *.DFM}
{ TMulSelectForm }
function TMulSelectForm.StartSelect(inQuery1: TDataSet;
var inSelectValues: TStrings; isOnlyOne: Boolean): TStrings;
begin
MulSelectForm:=TMulSelectForm.Create(Application);
MulSelectForm.selectValues:=inSelectValues;
MulSelectForm.selectItems:=TStringList.Create;
MulSelectForm.setOnlyOne:=isOnlyOne;
MulSelectForm.values:=MulSelectForm.GetData(inquery1,MulSelectForm.CheckListBox1,
MulSelectForm.selectValues);
MulSelectForm.CHECKCLICK:=FALSE;
MulSelectForm.ShowModal;
inSelectValues:=MulSelectForm.selectValues;
Result:=MulSelectForm.selectItems;
MulSelectForm.free;
end;
function TMulSelectForm.StartSelect(inquery1: TDataSet;
var inSelectValues: String; isOnlyOne: Boolean): String;
begin
MulSelectForm:=TMulSelectForm.Create(Application);
MulSelectForm.selectValues:=TStringList.Create;
MulSelectForm.selectItems:=TStringList.Create;
MulSelectForm.selectValues.Text:=inSelectValues;
MulSelectForm.setOnlyOne:=isOnlyOne;
MulSelectForm.values:=MulSelectForm.GetData(inquery1,MulSelectForm.CheckListBox1,
MulSelectForm.selectValues);
MulSelectForm.CHECKCLICK:=FALSE;
MulSelectForm.ShowModal;
inSelectValues:=MulSelectForm.selectValues.Text;
Result:=MulSelectForm.selectItems.Text;
MulSelectForm.selectValues.Destroy;
MulSelectForm.selectItems.Destroy;
MulSelectForm.values.Destroy;
MulSelectForm.free;
end;
procedure TMulSelectForm.SpeedButton1Click(Sender: TObject);
VAR I,J:INTEGER;
begin
J:=(Sender AS TSpeedButton).TAG;
FOR I:=1 TO CheckListBox1.Items.Count DO BEGIN
CASE J OF
1:CheckListBox1.Checked[I-1]:=TRUE;
2:CheckListBox1.Checked[I-1]:=FALSE;
3:CheckListBox1.Checked[I-1]:=NOT CheckListBox1.Checked[I-1];
END;
END;
end;
procedure TMulSelectForm.SELEONLY(SENDER: TObject);
VAR
I:INTEGER;
T:BOOLEAN;
begin
I:=(SENDER AS TCheckListBox).ItemIndex;
IF (setOnlyOne) THEN
BEGIN
T:=CheckListBox1.Checked[I];
SpeedButton1Click(SpeedButton2);
CheckListBox1.Checked[I]:=T;
END;
end;
procedure TMulSelectForm.CheckListBox1Click(Sender: TObject);
begin
IF NOT CHECKCLICK THEN
begin
SETSELECT(SENDER);
end;
CHECKCLICK:=FALSE;
SELEONLY(Sender);
end;
procedure TMulSelectForm.SETSELECT(SENDER:TObject);
VAR
I:INTEGER;
begin
I:=(SENDER AS TCheckListBox).ItemIndex;
(SENDER AS TCheckListBox).Checked[I]:=NOT ((SENDER AS TCheckListBox).Checked[I]);
end;
procedure TMulSelectForm.CheckListBox1ClickCheck(Sender: TObject);
begin
CHECKCLICK:=TRUE;
SELEONLY(Sender);
end;
FUNCTION TMulSelectForm.GetData(QUERY1:TDataSet;CheckListBox:TCheckListBox;
selected:TStrings):TStrings;
VAR
I,J:INTEGER;
S,S1:String;
hasOneCheck:Boolean;
begin
hasOneCheck:=false;
Result:=TStringList.Create;
CheckListBox.Clear;
i:=0;
while not Query1.Eof do
BEGIN
J:=QUERY1.FieldCount;
inc(i);
s:=Query1.Fields[0].AsString;
case J of
1: s1:=s;
2: s1:=Query1.Fields[1].AsString
else
begin
s:=s+Query1.Fields[2].AsString;
s1:=Query1.Fields[1].AsString;
end;
end;
CheckListBox.Items.Add(s);
Result.Add(s1);
If (not setOnlyOne) Or (not hasOneCheck) Then
Begin
If selected.IndexOf(s1)>=0 Then
Begin
hasOneCheck:=true;
CheckListBox.Checked[i-1]:=true;
End;
End;
Query1.Next;
END;
END;
procedure TMulSelectForm.SpeedButton6Click(Sender: TObject);
begin
close;
end;
procedure TMulSelectForm.SpeedButton4Click(Sender: TObject);
begin
SetChecked(selectValues);
end;
procedure TMulSelectForm.SetChecked(selected:TStrings);
VAR
I:INTEGER;
hasOneCheck:Boolean;
begin
hasOneCheck:=false;
for I := 0 to CheckListBox1.Items.Count-1 do
begin
If (setOnlyOne) And ( hasOneCheck) Then break;
If selected.IndexOf(values.Strings[i])>=0 Then
Begin
hasOneCheck:=true;
CheckListBox1.Checked[i]:=true;
End Else
CheckListBox1.Checked[i]:=false;
end;
end;
procedure TMulSelectForm.SpeedButton5Click(Sender: TObject);
VAR
I:INTEGER;
begin
selectValues.Clear;
for I := 0 to CheckListBox1.Items.Count-1 do
begin
If CheckListBox1.Checked[i] Then
Begin
selectValues.Add(values[i]);
selectItems.Add(CheckListBox1.Items.Strings[i]);
End;
end;
close;
end;
procedure TMulSelectForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
close;
end;
function TMulSelectForm.GetSelectText(CheckListBox:TCheckListBox;isString:Boolean):String;
var
I:Integer;
s:String;
begin
Result:='';
for i := 0 to CheckListBox.Items.Count-1 do
begin
If CheckListBox.Checked[i] Then
Begin
s:=CheckListBox.Items.Strings[i];
If isString Then
s:=''''+s+'''';
If Result<>'' Then
Result:=Result+',';
Result :=Result+s;
End;
end;
end;
end.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Delphi
1
https://gitee.com/xyxia/oraback.git
git@gitee.com:xyxia/oraback.git
xyxia
oraback
数据库备份
master

搜索帮助

0d507c66 1850385 C8b1a773 1850385