select.pas

某疗养院动脉硬化管理系统

unit Select;

interface

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, Controls, StdCtrls, 
  Buttons, DB, ADODB;

type
  TFrmSelect = class(TForm)
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    GroupBox1: TGroupBox;
    SrcList: TListBox;
    GroupBox2: TGroupBox;
    DstList: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ADOQuery1: TADOQuery;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure IncludeBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure IncAllBtnClick(Sender: TObject);
    procedure ExcAllBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure SrcListClick(Sender: TObject);
    procedure DstListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure MoveSelected(List: TCustomListBox; Items: TStrings);
    procedure SetItem(List: TListBox; Index: Integer);
    function GetFirstSelection(List: TCustomListBox): Integer;
    procedure SetButtons;
  end;

var
  FrmSelect: TFrmSelect;

implementation

uses DataModule, PubFunction;

{$R *.dfm}

//获得项目数量
function GetItemCount(Lst:TListBox):integer;
begin
  Result:=Lst.Items.Count;
end;

procedure TFrmSelect.IncludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  if GetItemCount(SrcList)=0 then
    exit;
  Index := GetFirstSelection(SrcList);
  MoveSelected(SrcList, DstList.Items);
  SetItem(SrcList, Index);
end;

procedure TFrmSelect.ExcludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  if GetItemCount(DstList)=0 then
    exit;
  Index := GetFirstSelection(DstList);
  MoveSelected(DstList, SrcList.Items);
  SetItem(DstList, Index);
end;

procedure TFrmSelect.IncAllBtnClick(Sender: TObject);
var
  I: Integer;
begin
  if GetItemCount(SrcList)=0 then
    exit;
  for I := 0 to SrcList.Items.Count - 1 do
    DstList.Items.AddObject(SrcList.Items[I], 
      SrcList.Items.Objects[I]);
  SrcList.Items.Clear;
  SetItem(SrcList, 0);
end;

procedure TFrmSelect.ExcAllBtnClick(Sender: TObject);
var
  I: Integer;
begin
  if GetItemCount(DstList)=0 then
    exit;
  for I := 0 to DstList.Items.Count - 1 do
    SrcList.Items.AddObject(DstList.Items[I], DstList.Items.Objects[I]);
  DstList.Items.Clear;
  SetItem(DstList, 0);
end;

procedure TFrmSelect.MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
    begin
      Items.AddObject(List.Items[I], List.Items.Objects[I]);
      List.Items.Delete(I);
    end;
end;

procedure TFrmSelect.SetButtons;
var
  SrcEmpty, DstEmpty: Boolean;
begin
  SrcEmpty := SrcList.Items.Count = 0;
  DstEmpty := DstList.Items.Count = 0;
  IncludeBtn.Enabled := not SrcEmpty;
  IncAllBtn.Enabled := not SrcEmpty;
  ExcludeBtn.Enabled := not DstEmpty;
  ExAllBtn.Enabled := not DstEmpty;
end;

function TFrmSelect.GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;

procedure TFrmSelect.SetItem(List: TListBox; Index: Integer);
var
  MaxIndex: Integer;
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then
      Index := 0
    else
      if Index > MaxIndex then
        Index := MaxIndex;
    Selected[Index] := True;
  end;
  SetButtons;
end;

procedure TFrmSelect.FormCreate(Sender: TObject);
begin
  if Item='Desc' then
  begin
    ShowRecord(ADOQuery1,'id,DetailDesc','PicDesc','id');
    while not ADOQuery1.Eof do
    begin
      SrcList.Items.Add(ADOQuery1.FieldByName('DetailDesc').AsString);
      ADOQuery1.Next;
    end;
    Self.Caption :='描述';
  end;
  if Item='Conclusion' then
  begin
    ShowRecord(ADOQuery1,'id,DetailDesc','ExamDesc','id');
    while not ADOQuery1.Eof do
    begin
      SrcList.Items.Add(ADOQuery1.FieldByName('DetailDesc').AsString);
      ADOQuery1.Next;
    end;
    Self.Caption :='提示';
  end;
  if Item='Advice' then
  begin
    ShowRecord(ADOQuery1,'id,Advice','ExamAdvice','id');
    while not ADOQuery1.Eof do
    begin
      SrcList.Items.Add(ADOQuery1.FieldByName('Advice').AsString);
      ADOQuery1.Next;
    end;
    Self.Caption :='建议';
  end;
end;

procedure TFrmSelect.BitBtn2Click(Sender: TObject);
begin
  PicDesc:='';
  Advice:='';
  ExamDesc:='';
  close;
end;

procedure TFrmSelect.BitBtn1Click(Sender: TObject);
begin
  if Item='Desc' then
    PicDesc:=DstList.Items.Text;
  //ShowMessage(PicDesc);
  if Item='Conclusion' then
    ExamDesc:=DstList.Items.Text;
  //ShowMessage(ExamDesc);
  if Item='Advice' then
    Advice:=DstList.Items.Text;
  //ShowMessage(Advice);
  close;
end;

procedure TFrmSelect.SrcListClick(Sender: TObject);
var i: Integer;
begin
  for i:= SrcList.Items.Count - 1 downto 0 do
    if SrcList.Selected[i] then
      Memo1.Lines.Text:=SrcList.Items.Strings[i];
end;

procedure TFrmSelect.DstListClick(Sender: TObject);
var i:integer;
begin
  for i:= DstList.Items.Count - 1 downto 0 do
    if DstList.Selected[i] then
      Memo2.Lines.Text:=DstList.Items.Strings[i];
end;

end.