rm_editorexpr.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 996 行 · 第 1/2 页

      Tag := 1;
      case ParamList[I + 1] of
        'N': Caption := RMLoadStr(rmRes + 719);
        'B': Caption := RMLoadStr(rmRes + 718);
        'S': Caption := RMLoadStr(rmRes + 717);
        'V': Caption := RMLoadStr(rmRes + 720);
        'D': Caption := RMLoadStr(rmRes + 716);
        'T': Caption := RMLoadStr(rmRes + 715);
        'E': Caption := RMLoadStr(rmRes + 714);
      end;
      Caption := Format(Caption, [I + 1]);
    end;
    with TEdit.Create(Self) do
    begin
      Parent := FuncParamSB;
      Left := 10;
      Top := I * 40 + 15;
      Width := Parent.Width - 60;
      Tag := I;
    end;
    with TSpeedButton.Create(Self) do
    begin
      Parent := FuncParamSB;
      Left := Parent.Width - 40;
      Width := 20;
      Height := 20;
      Top := I * 40 + 15;
      Caption := '...';
      Tag := I;
      OnClick := GetParamExprClick;
    end;
    FuncParamSB.VertScrollBar.Range := Length(ParamList) * 40;
    FuncParamSB.VertScrollBar.Increment := 40;
  end;

  FFuncParamsResult := 0;
  repeat
    Application.HandleMessage;
  until FFuncParamsResult <> 0;
  Result := FFuncParamsResult = 1;
  if Result then
  begin
    ParamResult := '';
    for I := 0 to FuncParamSB.ControlCount - 1 do
    begin
      if FuncParamSB.Controls[I] is TEdit then
      begin
        if TEdit(FuncParamSB.Controls[I]).Text <> '' then
        begin
          if ParamResult <> '' then
            ParamResult := ParamResult + ',';
          ParamResult := ParamResult + TEdit(FuncParamSB.Controls[I]).Text;
        end;
      end;
    end;
  end;
  while FuncParamSB.ControlCount > 0 do
    FuncParamSB.Controls[0].Free;
end;

function TRMFormExpressionBuilder.GetDatafield(var Field: string): boolean;
begin
  FDatafieldResult := 0;
  PageControl1.ActivePage := TabSheetDatabase;
  repeat
    Application.HandleMessage;
  until FDatafieldResult <> 0;

  Result := FDatafieldResult = 1;
  if Result and (lstDatasets.ItemIndex > -1) and (lstFields.ItemIndex > -1) then
  begin
    if chkUseTableName.Checked then
      Field := lstDatasets.Items[lstDatasets.ItemIndex] + '."'
    else
      Field := '"';
    Field := Field + lstFields.Items[lstFields.ItemIndex] + '"';
  end
  else
    Field := '';

  if isScript and (Field <> '') then
    Field := 'GetFieldValue(''' + Field + ''')';
end;

function TRMFormExpressionBuilder.GetFunc(var Func: string): boolean;
var
  AllArguments: string;
  Arguments: string;
begin
  PageControl1.ActivePage := TabSheetFunc;
  FFuncResult := 0;
  repeat
    Application.HandleMessage;
  until FFuncResult <> 0;

  if FFuncResult = 1 then
  begin
    Result := true;
    if (lstFunc.ItemIndex >= 0) and (lstFunc.ItemIndex <= lstFunc.Items.Count - 1) then
    begin
      Func := lstFunc.Items[lstFunc.ItemIndex];
      Arguments := GetArguments(Func);
    end;

    if Length(Arguments) > 0 then
    begin
      if GetParams(Arguments, AllArguments) then
        Func := Func + '(' + AllArguments + ')'
      else
        Result := false;
    end;
    PageControl1.ActivePage := TabSheetFunc;
  end
  else
    Result := false;

  if not Result then
    Func := '';
end;

function TRMFormExpressionBuilder.GetVariable(var Variable: string): boolean;
begin
  FVariableResult := 0;
  PageControl1.ActivePage := TabSheetVal;
  repeat
    Application.HandleMessage
  until FVariableResult <> 0;

  Result := FVariableResult = 1;
  if Result then
    Variable := FVal;
end;

procedure TRMFormExpressionBuilder.FormCreate(Sender: TObject);
begin
  FFunctionBMP := TBitmap.Create;
  FFunctionBMP.LoadFromResourceName(hInstance, 'RM_BMPFUNCTION');

  FDataSetBMP := TBitmap.Create;
  FDataSetBMP.LoadFromResourceName(hInstance, 'RM_FLD1');

  FFieldBMP := TBitmap.Create;
  FFieldBMP.LoadFromResourceName(hInstance, 'RM_FLD2');

  FVariableFolderBMP := TBitmap.Create;
  FVariableFolderBMP.LoadFromResourceName(hInstance, 'RM_FLD3');

  FVariableBMP := TBitmap.Create;
  FVariableBMP.LoadFromResourceName(hInstance, 'RM_FLD4');

  btnInsertDataField.Glyph.Assign(FDataSetBMP);
  btnInsertVariable.Glyph.Assign(FVariableBMP);
  
  Localize;
  PageControl1.ActivePage := TabSheetExpr;
  edtExpression := TWordWrapEdit.Create(Self);
  with edtExpression do
  begin
    Parent := TabSheetExpr;
    AutoSize := false;
    Top := 32;
    Left := 20;
    Width := 397;
    Height := 136;
  end;
end;

procedure TRMFormExpressionBuilder.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if FExprResult <> 1 then
    FExprResult := 2;
end;

procedure TRMFormExpressionBuilder.btnOKClick(Sender: TObject);
begin
  FExprResult := 1;
end;

procedure TRMFormExpressionBuilder.btnCancelClick(Sender: TObject);
begin
  FExprResult := 2;
end;

procedure TRMFormExpressionBuilder.btnClearExprClick(Sender: TObject);
begin
  edtExpression.Text := '';
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.btnInsertDataFieldClick(Sender: TObject);
var
  AField: string;
begin
  if GetDatafield(AField) then
  begin
    if IsScript then
      InsertText(AField)
    else
      InsertText(AddBrackets(AField));
  end;
  PageControl1.ActivePage := TabSheetExpr;
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.btnDataFieldOKClick(Sender: TObject);
begin
  if lstDatasets.ItemIndex >= 0 then
  begin
    RM_Dsg_LastDataSet := lstDatasets.Items[lstDatasets.ItemIndex];
    FDatafieldResult := 1;
  end;
end;

procedure TRMFormExpressionBuilder.DataFieldCancelBtnClick(
  Sender: TObject);
begin
  FDatafieldResult := 2;
end;

procedure TRMFormExpressionBuilder.btnInsertFunctionClick(Sender: TObject);
var
  AFunction: string;
begin
  if GetFunc(AFunction) then
  begin
    if isScript or (Pos('(', AFunction) <> 0) then
      InsertText(AFunction)
    else
      InsertText(AddBrackets(AFunction));
  end;
  PageControl1.ActivePage := TabSheetExpr;
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.btnFunctionOKClick(Sender: TObject);
begin
  if lstFunc.ItemIndex >= 0 then
    FFuncResult := 1;
end;

procedure TRMFormExpressionBuilder.btnInsertVariableClick(Sender: TObject);
var
  AVariable: string;
begin
  if GetVariable(AVariable) then
  begin
    if isScript then
      InsertText(AVariable)
    else
      InsertText(AddBrackets(AVariable));
  end;
  PageControl1.ActivePage := TabSheetExpr;
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.btnFunctionCancelClick(Sender: TObject);
begin
  FFuncResult := 2;
end;

procedure TRMFormExpressionBuilder.lstDatasetsClick(Sender: TObject);
begin
  lstFields.Items.Clear;
  if lstDataSets.ItemIndex >= 0 then
  begin
    if FReport <> nil then
      FReport.Dictionary.GetDataSetFields(lstDataSets.Items[lstDataSets.ItemIndex],
        lstFields.Items)
    else
      RMDesigner.Report.Dictionary.GetDataSetFields(lstDataSets.Items[lstDataSets.ItemIndex],
        lstFields.Items);
  end
  else
    lstFields.Items.Clear;
end;

procedure TRMFormExpressionBuilder.AddOrClick(Sender: TObject);
begin
  InsertText(' ' + TSpeedButton(Sender).Caption + ' ');
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.lstFieldsDblClick(Sender: TObject);
begin
  if lstFields.ItemIndex >= 0 then
    btnDataFieldOK.Click;
end;

function TRMFormExpressionBuilder.CurDataSet: string;
begin
  Result := '';
  if lstVariableFolder.ItemIndex <> -1 then
    Result := lstVariableFolder.Items[lstVariableFolder.ItemIndex];
end;

procedure TRMFormExpressionBuilder.GetVariables;
begin
  if FReport <> nil then
    FReport.Dictionary.GetVariablesList(lstVariableFolder.Items[lstVariableFolder.ItemIndex],
      lstVariables.Items)
  else
    RMDesigner.Report.Dictionary.GetVariablesList(lstVariableFolder.Items[lstVariableFolder.ItemIndex],
      lstVariables.Items);
end;

procedure TRMFormExpressionBuilder.GetSpecValues;
var
  i: Integer;
begin
  with lstVariables.Items do
  begin
    Clear;
    for i := 0 to RMSpecCount - 1 do
    begin
      Add(RMLoadStr(SVar1 + i));
    end;
  end;
end;

procedure TRMFormExpressionBuilder.btnVariableOKClick(Sender: TObject);
begin
  if lstVariables.ItemIndex >= 0 then
  begin
    if CurDataSet <> RMLoadStr(SSystemVariables) then
    begin
      if lstVariables.ItemIndex <> -1 then
        FVal := lstVariables.Items[lstVariables.ItemIndex];
    end
    else
      FVal := RMSpecFuncs[lstVariables.ItemIndex];
    FLastVariableFolder := lstVariableFolder.Items[lstVariableFolder.ItemIndex];
    FVariableResult := 1;
  end;
end;

procedure TRMFormExpressionBuilder.btnVariableCancelClick(Sender: TObject);
begin
  FVariableResult := 2;
end;

procedure TRMFormExpressionBuilder.lstFuncDblClick(Sender: TObject);
begin
  if lstFunc.ItemIndex >= 0 then
    btnFunctionOK.Click;
end;

procedure TRMFormExpressionBuilder.btnFuncParamOkClick(Sender: TObject);
begin
  FFuncParamsResult := 1;
end;

procedure TRMFormExpressionBuilder.btnFuncArgCancelClick(Sender: TObject);
begin
  FFuncParamsResult := 2;
end;

procedure TRMFormExpressionBuilder.lstFuncClick(Sender: TObject);
begin
  SelectFunc(lstFunc.ItemIndex);
end;

procedure TRMFormExpressionBuilder.lstVariableFolderDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  s: string;
  liBmp: TBitmap;
begin
  with TListBox(Control) do
  begin
    s := Items[Index];
    if Control = lstDatasets then
      liBmp := FDataSetBMP
    else
      liBmp := FFieldBMP;

    if Control = lstVariableFolder then
      liBmp := FVariableFolderBMP
    else if Control = lstVariables then
      liBmp := FVariableBMP
    else if Control = lstFunc then
      liBmp := FFunctionBMP
    else if Control = lstDatasets then
      liBmp := FDataSetBMP
    else if Control = lstFields then
      liBmp := FFieldBMP;

    Canvas.FillRect(Rect);
    Canvas.BrushCopy(Bounds(Rect.Left + 2, Rect.Top, liBmp.Width, liBmp.Height),
      liBmp, Bounds(0, 0, liBmp.Width, liBmp.Height), liBmp.TransparentColor);
    Canvas.TextOut(Rect.Left + 4 + liBmp.Width, Rect.Top, s);
  end;
end;

procedure TRMFormExpressionBuilder.lstVariableFolderClick(Sender: TObject);
begin
  if CurDataSet = RMLoadStr(SSystemVariables) then
    GetSpecValues
  else
    GetVariables;
end;

procedure TRMFormExpressionBuilder.lstVariablesDblClick(Sender: TObject);
begin
  if lstVariables.ItemIndex >= 0 then
    btnVariableOK.Click;
end;

procedure TRMFormExpressionBuilder.TreeViewFunctionsChange(Sender: TObject;
  Node: TTreeNode);
begin
  GetFunctionList(Node.Text, lstFunc.Items);
  lstFunc.ItemIndex := 0;
  lstFuncClick(nil);
end;

procedure TRMFormExpressionBuilder.FormShow(Sender: TObject);

  procedure _FillFunctions;
  var
    i: integer;
    s: TStringList;
    TreeNode, ANode: TTreeNode;
  begin
    s := TStringList.Create;
    try
      GetFunctionFolder(s);

      TreeNode := TreeViewFunctions.Items.Add(nil, RMLoadStr(SAllCategories));
      TreeNode.ImageIndex := 0;
      TreeNode.SelectedIndex := 0;

      for i := 0 to s.Count - 1 do
      begin
        ANode := TreeViewFunctions.Items.AddChild(TreeNode, s[i]);
        ANode.ImageIndex := 1;
        ANode.SelectedIndex := 1;
      end;

      TreeViewFunctions.FullExpand;
      TreeViewFunctions.Selected := TreeViewFunctions.Items[0];
    finally
      s.Free;
    end;
  end;

  procedure _FillCategoryLB;
  var
    s: TStringList;
  begin
    s := TStringList.Create;
    if FReport <> nil then
      FReport.Dictionary.GetCategoryList(s)
    else
      RMDesigner.Report.Dictionary.GetCategoryList(s);
    s.Add(RMLoadStr(SSystemVariables));
    lstVariableFolder.Items.Assign(s);
    s.Free;
  end;

begin
  if FDataSet <> nil then
    lstDataSets.Items.Add(FDataSet.Owner.Name + '.' + FDataSet.Name)
  else
    RMDesigner.Report.Dictionary.GetDataSets(lstDatasets.Items);

  if lstDatasets.Items.IndexOf(RM_Dsg_LastDataSet) <> -1 then
    lstDatasets.ItemIndex := lstDatasets.Items.IndexOf(RM_Dsg_LastDataSet)
  else
    lstDatasets.ItemIndex := 0;
  lstDatasetsClick(nil);

  _FillCategoryLB;
  with lstVariableFolder do
  begin
    if Items.IndexOf(FLastVariableFolder) <> -1 then
      ItemIndex := Items.IndexOf(FLastVariableFolder)
    else
      ItemIndex := 0;
  end;

  lstVariableFolderClick(nil);
  _FillFunctions;
  edtExpression.SetFocus;
end;

procedure TRMFormExpressionBuilder.FormDestroy(Sender: TObject);
begin
  FFunctionBMP.Free;
  FDataSetBMP.Free;
  FFieldBMP.Free;
  FVariableFolderBMP.Free;
  FVariableBMP.Free;
end;

end.