convertsearch.pas

倉庫下線條碼源碼

unit ConvertSearch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ExtCtrls, Buttons, ToolWin, ComCtrls, //SQueryButton, 
  StdCtrls, Grids,DoorForbidImplBody,ScktComp,DFTypeImplBody, ParamListIntfBody,
  EDC_Convert,MessageUnit,DFOutParaImplBody;  //, SQueryButton

type
  TfmConvertSearch = class(TForm)
    CoolBar1: TCoolBar;
    spbAdd: TSpeedButton;
    spbEdit: TSpeedButton;
    spbDelete: TSpeedButton;
    spbSave: TSpeedButton;
    spbCancel: TSpeedButton;
    spbFirst: TSpeedButton;
    spbPrior: TSpeedButton;
    spbNext: TSpeedButton;
    spbLast: TSpeedButton;
    spbExit: TSpeedButton;
    bvlData: TBevel;
    bvlQuery: TBevel;
    bvlNavigat: TBevel;
    spbRefresh: TSpeedButton;
    RightActionList: TActionList;
    actAdd: TAction;
    actEdit: TAction;
    actDelete: TAction;
    actSave: TAction;
    actCancel: TAction;
    actQuery: TAction;
    actFirst: TAction;
    actPrior: TAction;
    actNext: TAction;
    actLast: TAction;
    actExit: TAction;
    actRefresh: TAction;
    Panel1: TPanel;
    sgdConvert: TStringGrid;
    RichEdit1: TRichEdit;
    SpeedButton1: TSpeedButton;
    procedure actAddExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure actEditExecute(Sender: TObject);
    procedure sgdConvertSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure actRefreshExecute(Sender: TObject);
    procedure actQueryExecute(Sender: TObject);
    procedure actDeleteExecute(Sender: TObject);
  private
    { Private declarations }
    FOutParam: TParamListImpl;
    FACol,FARow: integer;
    FEDC_Converts: TEDC_Converter;
    procedure ClearObjectParam(outPar: TParamListImpl);
  public
    { Public declarations }
    procedure WMSEARCHSHOWINFO(var msg: TMessage); message WM_SEARCH_SHOWINFO; 
  end;

var
  fmConvertSearch: TfmConvertSearch;

implementation

uses ConvertSet;



{$R *.dfm}

procedure TfmConvertSearch.actAddExecute(Sender: TObject);
var
  FSearcher: TWG_DoorForbid_TCP;
  ParamObj : TTCP_IP_ParamObj;
  inParam,tcParam: TParamListImpl;
  tpObj: TObject;
  sSerial: string;
  nSerial: Integer;
begin
    nSerial :=0;
    FSearcher := TWG_DoorForbid_TCP.Create;
    ParamObj := TTCP_IP_ParamObj.Create;
    ParamObj.SetObjectName('TCPIPParamObject');
    ParamObj.FWorkModle := True;
    ParamObj.FLocalServerPort :=60000;
    ParamObj.FLocalServiceType := stNonBlocking;
    ParamObj.FTheadChacheSize :=15;
    ParamObj.FRemotServerPort := ParamObj.FLocalServerPort;
    ParamObj.FRemotServerAddr := '255.255.255.255';
    ParamObj.FRemotServerName := '';
    ParamObj.FLocalClientType := ctNonBlocking;
    
    tcParam := TParamListImpl.Create;
    tcParam.AddObjParam(ParamObj);

    FSearcher.SetTCPIPParam(tcParam);
    
    inParam := TParamListImpl.Create;
    inParam.AddStringParam(IntToStr(Self.Handle),'msgHandle');
    inParam.AddStringParam(sSerial,'DeviceSerial');
    ClearObjectParam(FOutParam);
    FSearcher.ConnectToServer;
    Application.ProcessMessages;
    screen.Cursor:=crSQLWait;
    FSearcher.SearchDevice(inParam,FOutParam);
    screen.Cursor:=crDefault;
    Application.ProcessMessages;
    PostMessage(Self.Handle,WM_SEARCH_SHOWINFO,0,0);
    Application.ProcessMessages;

    if FSearcher <> nil then
      FreeAndNil(FSearcher);
    if inParam <> nil then
      FreeAndNil(inParam);
end;

procedure TfmConvertSearch.ClearObjectParam(outPar: TParamListImpl);
var
  i: integer;
  tpObject: TObject;
begin
  if outPar <> nil then
  begin
    for i := 0 to outPar.GetObjParamCount-1 do
    begin
      tpObject := outPar.GetObjParam(i);
      if tpObject <> nil then
        FreeAndNil(tpObject);
    end;
    outPar.ClearObjParam;
  end;
end;


procedure TfmConvertSearch.FormCreate(Sender: TObject);
begin
  sgdConvert.Cells[0,0] := 'MAC