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

📄 cardbyhandle.~pas

📁 用户名:SYSTEM 密码:空 第一次运行请先恢复数据库 DATABASE 到SQL服务器
💻 ~PAS
字号:
unit CardByHandle;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseChildForm, StdCtrls, Buttons, ExtCtrls, ComCtrls,DataMod,AdoDb,
  Mask,DateUtils;

type
  TfCardByHandle = class(TfBaseChildForm)
    Panel1: TPanel;
    Label4: TLabel;
    Label5: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Label2: TLabel;
    RadioGroup1: TRadioGroup;
    DateTimePicker1: TDateTimePicker;
    GroupBox4: TGroupBox;
    RadioButton1: TRadioButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    RadioButton2: TRadioButton;
    GroupBox1: TGroupBox;
    BitBtn5: TBitBtn;
    Label12: TLabel;
    Label13: TLabel;
    ProgressBar1: TProgressBar;
    DateTimePicker3: TDateTimePicker;
    DateTimePicker4: TDateTimePicker;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    DateTimePicker9: TDateTimePicker;
    DateTimePicker10: TDateTimePicker;
    GroupBox2: TGroupBox;
    DateTimePicker5: TDateTimePicker;
    DateTimePicker6: TDateTimePicker;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    DateTimePicker7: TDateTimePicker;
    DateTimePicker8: TDateTimePicker;
    GroupBox3: TGroupBox;
    DateTimePicker11: TDateTimePicker;
    DateTimePicker12: TDateTimePicker;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    DateTimePicker13: TDateTimePicker;
    DateTimePicker14: TDateTimePicker;
    procedure RadioGroup1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure CheckBox7Click(Sender: TObject);
    procedure CheckBox8Click(Sender: TObject);
    procedure CheckBox9Click(Sender: TObject);
    procedure CheckBox10Click(Sender: TObject);
    procedure DateTimePicker1Change(Sender: TObject);
  private
    { Private declarations }
    intOldType:Integer;
    Procedure MoveItem(Const SourceList:TListbox;Const DescList:TListbox;Const MoveALL:Boolean);
  public
    { Public declarations }
  end;

var
  fCardByHandle: TfCardByHandle;

implementation

{$R *.dfm}

Function GetItemIDS(const Listbox:TListbox):String;
var
   strResult:String;
   i:Integer;
Begin
     if (Listbox=nil) or (Listbox.Items.Count=0) then
         Result:=''
     else begin
         strResult:='';
         for I:=0 to Listbox.Items.Count-1 do
         Begin
              if strResult<>'' then
                 strResult:=strResult+',';
              strResult:=strResult+''''+TItem(Listbox.Items.Objects[i]).ItemID+'''';
         end;
         Result:=strResult;
     end;
end;


procedure TfCardByHandle.RadioGroup1Click(Sender: TObject);
var
  Item:TItem;
  AdoQue:TAdoQuery;
begin
    if   intOldType<>RadioGroup1.ItemIndex then Begin
         intOldType:=RadioGroup1.ItemIndex ;
         Listbox2.Items.Clear ;
         AdoQue:=TAdoQuery.Create(self);
         AdoQue.Connection :=fdatamod.AdoCon ;
         Listbox1.Items.Clear ;
         Case RadioGroup1.ItemIndex of
              0:AdoQue.SQL.Add('Select cDepartMentNo As ItemID,cDepartmentName As ItemCaption From Department Order by cDepartMentNo') ;
              1:AdoQue.SQL.Add('Select cWorkerNo As ItemID,cWorkerName+''  [''+cDepartMentName+'']'' As ItemCaption From V_Workers Order by cDepartMentName,cWorkerNo') ;
              2:AdoQue.SQL.Add('Select cClassNo As ItemID,cClassName As ItemCaption From Class Order by cClassNo') ;
         end;
         AdoQue.Open;
         While Not AdoQue.Eof do
         Begin
             Item:=TItem.Create ;
             Item.ItemID :=AdoQue.fieldbyName('ItemID').AsString ;
             Item.ItemCaption :=AdoQue.fieldbyName('ItemCaption').AsString ;
             Listbox1.Items.AddObject(item.ItemCaption,Item);
             AdoQue.Next ;
         end;
         AdoQue.Free;
    End;
end;

procedure TfCardByHandle.MoveItem(const SourceList, DescList: TListbox;
  const MoveALL: Boolean);
var
   strMessage:String;
   intIndex :Integer;
begin
   if SourceList.Items.Count>0 then begin
         If MoveAll then Begin
             While SourceList.Items.Count >0 do
             Begin
                 SourceList.ItemIndex :=0;
                 MoveItem(SourceList,DescList,False);
             end;
         end Else begin
             If SourceList.ItemIndex>=0 then Begin
                 DescList.Items.AddObject(SourceList.Items[SourceList.ItemIndex],SourceList.Items.Objects[SourceList.ItemIndex]);
                 DescList.ItemIndex :=DescList.Items.IndexOf(SourceList.Items[SourceList.ItemIndex]);
                 If SourceList.ItemIndex=SourceList.Items.Count-1 then
                    intIndex:=SourceList.Items.count-2
                 else
                    intIndex:=SourceList.ItemIndex ;
                 SourceList.Items.Delete(SourceList.ItemIndex );
                 SourceList.ItemIndex :=intIndex;
             end Else begin
                 strMessage:='眤临⊿Τ匡拒';
                 Case RadioGroup1.ItemIndex of
                      0:strMessage:=strMessage+'场

⌨️ 快捷键说明

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