GENQ3.PAS
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:3k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit GenQ3;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils,
  5.   Classes, Graphics, Controls,
  6.   Forms, Dialogs, Gen_Q,DBClient;
  7. type
  8.   TGenQ3 = class(Tcomponent)
  9.   private
  10.     { Private declarations }
  11.     FV_AppServName: TCustomRemoteServer; //设置连接的应用服务器名;
  12.     FV_ProviderName:  string; // 设置连接查询的表接口;
  13.     FV_TableName: string; //设置查询的表名
  14.     FV_fieldsstrings: Tstrings;
  15.     procedure setfieldsstrings(value: Tstrings);
  16.     function copyLelf(aStringsFrom: Tstrings; var aStringsTo: Tstrings): boolean;
  17.     function copyRight(aStringsFrom: Tstrings; var aStringsTo: Tstrings): boolean;
  18.   public
  19.     V_filtervalue: string; //存储过滤条件
  20.     constructor Create(AOwner: TComponent); override;
  21.     destructor destroy; override;
  22.     function execute: boolean;
  23.     { Public declarations }
  24.   published
  25.     property v_AppServName: TCustomRemoteServer read FV_AppServName write FV_AppServName;
  26.     property v_ProviderName:  string read FV_ProviderName write FV_ProviderName;
  27.     property v_TableName: string read FV_TableName write FV_TableName;
  28.     property v_fieldsstrings: Tstrings read FV_fieldsstrings write setfieldsstrings;
  29.     { Published declarations }
  30.   end;
  31. procedure Register;
  32. implementation
  33. procedure Register;
  34. begin
  35.   RegisterComponents('Unleash', [TGenQ3]);
  36. end;
  37. function TGenQ3.copyLelf(aStringsFrom: Tstrings; var aStringsTo: Tstrings): boolean;
  38. var
  39.   i: integer;
  40. begin
  41.   result := true;
  42.   for i := 0 to aStringsFrom.Count - 1 do
  43.   begin
  44.     if pos(';', aStringsFrom[i]) <= 1 then
  45.     begin
  46.       result := false;
  47.       exit;
  48.     end;
  49.     aStringsTo.Add(copy(aStringsFrom[i], 1, pos(';', aStringsFrom[i]) - 1));
  50.   end;
  51. end;
  52. function TGenQ3.copyRight(aStringsFrom: TStrings; var aStringsTo: TStrings): Boolean;
  53. var
  54.   i: integer;
  55. begin
  56.   result := true;
  57.   for i := 0 to aStringsFrom.Count - 1 do
  58.   begin
  59.     if length(aStringsFrom[i]) - pos(';', aStringsFrom[i]) <= 0 then
  60.     begin
  61.       result := false;
  62.       exit;
  63.     end;
  64.     aStringsTo.add(copy(aStringsFrom[i], pos(';', aStringsFrom[i]) + 1, length(aStringsFrom[i]) - pos(';', aStringsFrom[i])));
  65.   end;
  66. end;
  67. procedure TGenQ3.setfieldsstrings(value: Tstrings);
  68. begin
  69.   if Assigned(value) then
  70.     Fv_fieldsstrings.Assign(value);
  71. end;
  72. constructor TGenQ3.Create(AOwner: TComponent);
  73. begin
  74.   inherited Create(AOwner);
  75.   FV_fieldsstrings := Tstringlist.Create;
  76. end;
  77. destructor TGenQ3.Destroy;
  78. begin
  79.   FV_fieldsstrings.Free;
  80.   inherited Destroy;
  81. end;
  82. function TGenQ3.Execute: Boolean;
  83. var
  84.   F_Query: TF_Query;
  85. begin
  86.   result := false;
  87.   F_Query := TF_Query.Create(application);
  88.   F_Query.AppServName := Fv_AppServName;
  89.   F_Query.ProviderName := FV_ProviderName;
  90.   F_Query.TableName := FV_TableName;
  91.   if copyLelf(FV_fieldsstrings, F_Query.fields) = false then
  92.   begin
  93.     showmessage('V_fieldsstrings属性设置有错');
  94.     exit;
  95.   end;
  96.   if copyRight(FV_fieldsstrings, F_Query.fieldsAlias) = false then
  97.   begin
  98.     showmessage('V_fieldsstrings属性设置有错');
  99.     exit;
  100.   end;
  101.   F_Query.Position := poScreenCenter;
  102.   F_Query.AutoSize := true;
  103.   try
  104.     F_Query.ShowModal;
  105.     result := F_Query.Conf ;
  106.     V_filtervalue := F_Query.filtervalue;
  107.   finally
  108.     F_Query.Free;
  109.   end;
  110. end;
  111. initialization
  112.   registerclass(TF_Query);
  113. end.