Question

使用此代码我调用表单

procedure TfrmMain.actDevTest_2Execute(Sender: TObject);
var
  SelectedApp: string;
begin
  if ApplicationSelect(Self, SelectedApp) then
    ShowMessage(SelectedApp);
end;

表格如下所示

unit F_JsApplicationSelect;

interface

uses
{$Include UniDACCommon.inc}
  Db, MemDS, DbAccess, Uni,
  Classes, Controls, Forms,
  U_Forms.Move,
  Winapi.Messages, U_CustomMessages,
  Dialogs, StdCtrls, Buttons, ComCtrls,
  cxGroupBox, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, cxStyles, dxSkinsCore, dxSkinOffice2010Blue,
  dxSkinscxPCPainter, cxCustomData, cxFilter, cxData, cxDataStorage, cxEdit,
  cxNavigator, cxDBData, cxCheckBox, cxTextEdit, cxContainer, Vcl.Menus,
  cxButtons, cxGridLevel, cxGridCustomTableView, cxGridTableView,
  cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid,
  dxmdaset;

type
  TfrmJsApplicationSelect = class(TForm)
    grdApplicationsView1: TcxGridDBTableView;
    grdApplicationsLevel1: TcxGridLevel;
    grdApplications: TcxGrid;
    colContact: TcxGridDBColumn;
    colSection: TcxGridDBColumn;
    colSelected: TcxGridDBColumn;
    cxGroupBox1: TcxGroupBox;
    btnOK: TcxButton;
    srcApplications: TUniDataSource;
    mdApplications: TdxMemData;
    mdApplicationsfldselected: TBooleanField;
    mdApplicationsfldcontact: TStringField;
    mdApplicationsfldsection: TStringField;
    mdApplicationsfldposition: TStringField;
    mdApplicationsflddate: TDateField;
    mdApplicationsfldguid: TStringField;
    colPosition: TcxGridDBColumn;
    colDdate: TcxGridDBColumn;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure grdApplicationsView1CellDblClick(Sender: TcxCustomGridTableView;
      ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
      AShift: TShiftState; var AHandled: Boolean);
  private
    procedure SetupApplications;
    procedure MessageClose(var aMessage: TMessage); message WM_FORMCLOSE;
  public
    constructor Create(aOwner: TComponent; var aApplication: string); reintroduce;
  end;

  function ApplicationSelect(aOwner: TComponent; var aApplication: string): boolean;

implementation

{$R *.dfm}

uses
  System.SysUtils, Winapi.Windows,
  F_UniConn,
  U_Logfile,
  U_AppDb, U_User;

var
  lApplication  : string;

function ApplicationSelect(aOwner: TComponent; var aApplication: string): boolean;
begin
  with TfrmJsApplicationSelect.Create(aOwner, aApplication) do
    try
      Result := ShowModal = mrOK;
    finally
      Release;
    end;
end;

procedure TfrmJsApplicationSelect.MessageClose(var aMessage: TMessage);
begin
  Close;
end;

procedure TfrmJsApplicationSelect.SetupApplications;
var
  Query: TUniQuery;
begin
  Query := frmUniConn.CreateQuery;
  try
    Query.SQL.Clear;
    Query.SQL.Add('SELECT fldapplication_guid');
    Query.SQL.Add('      ,fldapplication_date');
    Query.SQL.Add('      ,fldcontact_name');
    Query.SQL.Add('      ,fldsection_desc');
    Query.SQL.Add('      ,fldposition_desc');
    Query.SQL.Add('      ,fldcreated_by');
    Query.SQL.Add('  FROM ' + QueryJsApplications);
    Query.SQL.Add(' WHERE (fldcreated_by = :fldcreated_by)');
    Query.SQL.Add(' ORDER BY fldapplication_date DESC');
    Query.ParamByName('fldcreated_by').AsString                     := User.ID;
    try
      Query.Execute;
      if Query.RecordCount > 0 then
        begin
          while not Query.Eof do
            begin
              mdApplications.Open;
              mdApplications.Append;
              mdApplications.FieldByName('fldselected').AsBoolean := False;
              mdApplications.FieldByName('fldguid').AsString := Query.FieldByName('fldapplication_guid').AsString;
              mdApplications.FieldByName('flddate').AsDateTime := Query.FieldByName('fldapplication_date').AsDateTime;
              mdApplications.FieldByName('fldcontact').AsString := Query.FieldByName('fldcontact_name').AsString;
              mdApplications.FieldByName('fldsection').AsString := Query.FieldByName('fldsection_desc').AsString;
              mdApplications.FieldByName('fldposition').AsString := Query.FieldByName('fldposition_desc').AsString;
              mdApplications.FieldByName('fldguid').AsString := Query.FieldByName('fldapplication_guid').AsString;
              mdApplications.Post;
              Query.Next;
            end;
          mdApplications.First;
        end;
    except
      on E:exception do
        Logfile.Error('F_JsApplicationSelect.SetupApplications: ' + E.Message);
    end;
  finally
    Query.Free;
  end;
end;

constructor TfrmJsApplicationSelect.Create(aOwner: TComponent; var aApplication: string);
begin
  inherited Create(aOwner);
  lApplication  := aApplication;
end;

procedure TfrmJsApplicationSelect.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
    mdApplications.First;
    while not mdApplications.Eof do
      begin
        if mdApplications.FieldByName('fldselected').AsBoolean = True then
          begin
ShowMessage(mdApplications.FieldByName('fldguid').AsString);
            lApplication := mdApplications.FieldByName('fldguid').AsString;
ShowMessage(lApplication);
          end;
        mdApplications.Next;
      end;
  except
    on E: exception do
      Logfile.Error('F_JsApplicationSelect.FormClose: ' + E.Message);
  end;
end;

procedure TfrmJsApplicationSelect.FormKeyPress(Sender: TObject; var Key: Char);
begin
  If Ord(Key) = 27 Then
    ModalResult := mrAbort;
end;

procedure TfrmJsApplicationSelect.FormShow(Sender: TObject);
begin
  SetupApplications;
  ActiveControl := grdApplications;
  if grdApplicationsView1.DataController.RecordCount > 0 then
    begin
      grdApplicationsView1.Controller.GoToFirst(False);
      grdApplicationsView1.Controller.FocusedRecord.MakeVisible;
    end;
end;

procedure TfrmJsApplicationSelect.grdApplicationsView1CellDblClick(
  Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo;
  AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
  try
    mdApplications.Edit;
    mdApplications.FieldByName('fldselected').AsBoolean := Not mdApplications.FieldByName('fldselected').AsBoolean;
    mdApplications.UpdateRecord;
  except
    on E: exception do
      Logfile.Error('F_JsApplicationSelect.grdApplicationsView1CellDblClick: ' + E.Message);
  end;
end;


end.

但为什么我的SelectedApp变量中没有任何值？我有另一个具有相同功能的表单只有我发送给它的var是一个TStringList - 工作正常。但字符串根本不起作用。

Answer 1

理解这一点所需的代码是：

function ApplicationSelect(aOwner: TComponent; 
  var aApplication: string): boolean;
begin
  with TfrmJsApplicationSelect.Create(aOwner, aApplication) do
    try
      Result := ShowModal = mrOK;
    finally
      Release;
    end;
end;

反过来调用

constructor TfrmJsApplicationSelect.Create(aOwner: TComponent; 
  var aApplication: string);
begin
  inherited Create(aOwner);
  lApplication  := aApplication;
end;

所以，你问为什么ApplicationSelect的来电者在aApplication的电话回复时没有注意到ApplicationSelect的任何修改。

您无法修改var中的aApplication参数ApplicationSelect。您确实将其作为var参数传递给TfrmJsApplicationSelect.Create，但TfrmJsApplicationSelect.Create不再修改它。由于string变量是一个值，调用者看不到对变量的修改，因为它没有被修改。

我对ApplicationSelect的其他评论是，您应该致电Free而不是Release。

除此之外，我可以对您的代码做出更多评论，但我不会尝试进行全面的代码审查，只会对您提出的直接问题发表评论。

在评论中，您问为什么将aApplication更改为TStringList可让调用者观察修改。这是因为Delphi类变量是对象的引用。当您将TStringList变量作为参数传递时，您将传递对该对象的引用。当您在该对象上调用方法时，会对实际对象执行任何突变。

那么，我如何更改此代码以允许返回字符串值？首先，我会让ApplicationSelect成为一个返回string的函数。如果取消，我会Abort。

function SelectApplication(aOwner: TComponent): string;
var
  Form: TfrmJsApplicationSelect; 
begin
  Form := TfrmJsApplicationSelect.Create(aOwner);
  try
    if Form.ShowModal <> mrOK then
      Abort;
    Result := Form.Application;
  finally
    Free;
  end;
end;

我绝对会删除全局变量lApplication。如果可能的话，应该避免使用全局变量。我会从代码中删除每一个。

而是在表单中添加一个私有字段来保存信息：

FApplication: string;

将其公开为公共财产：

property Application: string read FApplication;

然后表单只需要设置FApplication，调用者就可以看到该值。

为什么我不能从表格中获得退货价值

1 个答案: