setconntypefrm.pas

来自「群星医药系统源码」· PAS 代码 · 共 179 行

unit SetConnTypeFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzSpnEdt, StdCtrls, Mask, RzEdit, RzCmboBx, RzPanel, RzButton,
  ExtCtrls, IMainFrm, uDataTypes, Buttons, RzLstBox, uGlobal, RzRadChk, xBaseFrm,
  DB, DBClient, MConnect, SConnect;

type
  TFmSetConnType = class(TxBaseForm)
    RzPanel1: TRzPanel;
    BtnOk: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    cbConnType: TRzComboBox;
    Label3: TLabel;
    lbSvrList: TRzListBox;
    RzGroupBox2: TRzGroupBox;
    Label2: TLabel;
    lbPort: TLabel;
    edAddress: TRzEdit;
    edPort: TRzSpinEdit;
    BtnAdd: TRzButton;
    BtnUpd: TRzButton;
    BtnDel: TRzButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ckLoadBalanced: TRzCheckBox;
    Label4: TLabel;
    edInterceptName: TRzEdit;
    Label5: TLabel;
    procedure BtnOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lbSvrListClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnUpdClick(Sender: TObject);
    procedure BtnDelClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    IFmMain: IMainForm;
    SvrSetting: PSvrSetting;
    function CurrSvrSetting: String;
  public
    { Public declarations }
  end;

var
  FmSetConnType: TFmSetConnType;

implementation

{$R *.dfm}

procedure TFmSetConnType.FormCreate(Sender: TObject);
begin
  IFmMain := Application.MainForm as IMainForm;
  SvrSetting := IFmMain.IFmMainEx.GetSvrSetting;
end;

procedure TFmSetConnType.BtnOkClick(Sender: TObject);
var str: String;
    i: Integer;
begin
  i := cbConnType.ItemIndex;
  if i<0 then Exit;
  if (i=1)and(lbSvrList.Count=0) then begin
    Application.MessageBox('在Socket连接模式下至少需要指定一台应用程序服务器！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  if lbSvrList.Count>0 then begin
    str := xStrListToStr(lbSvrList.Items, ';');
    Delete(str, 1, 1);
  end;
  SvrSetting^.ConnType := i;
  SvrSetting^.SvrList  := str;
  Svrsetting^.LoadBalanced := ckLoadBalanced.Checked;
  Svrsetting^.InterceptName:= edInterceptName.Text;
  IFmMain.IFmMainEx.SaveSetting;
  ModalResult := mrOk;
end;

procedure TFmSetConnType.RzBitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TFmSetConnType.FormShow(Sender: TObject);
begin
  Inherited;
  cbConnType.ItemIndex  := SvrSetting.ConnType;
  ckLoadBalanced.Checked:= SvrSetting.LoadBalanced;
  edInterceptName.Text  := SvrSetting.InterceptName;
  xStrSplit(SvrSetting.SvrList, [';'], lbSvrList.Items);
end;

procedure TFmSetConnType.lbSvrListClick(Sender: TObject);
var str: String;
    n, iPort: Integer;
begin
  if lbSvrList.ItemIndex<0 then Exit;
  str := lbSvrList.Items[lbSvrList.ItemIndex];
  n := AnsiPos(':', str);
  if n>0 then begin
    iPort := StrToInt(Copy(str, n+1, Length(str)-n));
    str := Copy(str, 1, n-1);
  end else
    iPort := 211;
  edAddress.Text := str;
  edPort.IntValue:= iPort;
end;

function TFmSetConnType.CurrSvrSetting: String;
var str: String;
begin
  str := edAddress.Text;
  if (str='')or(AnsiPos(':', str)>0)or(AnsiPos(';', str)>0) then
    raise Exception.Create('请指定合法的服务器地址(名称)！');
  Result := str+':'+IntToStr(edPort.IntValue);
end;

procedure TFmSetConnType.BtnAddClick(Sender: TObject);
begin
  lbSvrList.Add(CurrSvrSetting);
  lbSvrList.ItemIndex := lbSvrList.Count-1;
end;

procedure TFmSetConnType.BtnUpdClick(Sender: TObject);
begin
  if lbSvrList.ItemIndex<0 then begin
    BtnAdd.Click;
    Exit;
  end;
  lbSvrList.Items[lbSvrList.ItemIndex] := CurrSvrSetting;
end;

procedure TFmSetConnType.BtnDelClick(Sender: TObject);
begin
  if lbSvrList.ItemIndex<0 then Exit;
  lbSvrList.Delete(lbSvrList.ItemIndex);
end;

procedure TFmSetConnType.SpeedButton1Click(Sender: TObject);
var str: String;
    i: Integer;
begin
  i := lbSvrList.ItemIndex;
  if i<=0 then Exit;
  str := lbSvrList.Items[i-1];
  lbSvrList.Items[i-1] := lbSvrList.Items[i];
  lbSvrList.Items[i] := str;
  lbSvrList.ItemIndex:= i-1;
end;

procedure TFmSetConnType.SpeedButton2Click(Sender: TObject);
var str: String;
    i: Integer;
begin
  i := lbSvrList.ItemIndex;
  if i=lbSvrList.Count-1 then Exit;
  str := lbSvrList.Items[i+1];
  lbSvrList.Items[i+1] := lbSvrList.Items[i];
  lbSvrList.Items[i] := str;
  lbSvrList.ItemIndex:= i+1;
end;

initialization
  RegisterClass(TFmSetConnType);

finalization
  UnRegisterClass(TFmSetConnType);

end.