qrexpbld.pas

delphi7报表打印控件源码 可以设计报表

    FunctionPage.BringToFront;
  end else
    Result := false;
  if not Result then
    Func := '';
  FunctionPage.Enabled := false;
end;

function TQRExpressionBuilder.GetParams(ParamList : string; var ParamResult : string) : boolean;
var
  I : integer;
begin
  FuncParamsPage.Enabled := true;
  FuncParamsPage.BringToFront;
  CopyFuncName.Caption := FuncName.Caption;
  CopyFuncDescription.Caption := FuncDescription.Caption;
  for I := 0 to length(ParamList) - 1 do
  begin
    with TLabel.Create(Self) do
    begin
      Parent := FuncParamSB;
      Left := 10;
      Top := I * 40;
      Tag := 1;
      case ParamList[I + 1] of
        'N' : Caption := SqrExpBldNumeric;
        'B' : Caption := SqrExpBldLogical;
        'S' : Caption := SqrExpBldText;
        'V' : Caption := SqrExpBldValue;
      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 ParamResult <> '' then
          ParamResult := ParamResult + ',';
        ParamResult := ParamResult + TEdit(FuncParamSB.Controls[I]).Text;
      end;
    end;
  end;
  while FuncParamSB.ControlCount > 0 do
    FuncParamSB.Controls[0].Free;
  FuncParamsPage.Enabled := false;
end;

procedure TQRExpressionBuilder.GetParamExprClick(Sender : TObject);
var
  I : integer;
  ParamExpr : string;
begin
  for I := 0 to FuncParamSB.ControlCount - 1 do
    if (FuncParamSB.Controls[I] is TEdit) and
      (TEdit(FuncParamSB.Controls[I]).Tag = TSpeedButton(Sender).Tag) then
      with TEdit(FuncParamSB.Controls[I]) do
      begin
        ParamExpr := Text;
        if GetExpression(Format(SqrExpBldEnterParam, [Tag + 1, FuncName.Caption]),
          ParamExpr, DataSetForm, Self, FLocalEnvironment) then
          Text := ParamExpr;
        FuncParamsPage.BringToFront;
        SetFocus;
        SelStart := 0;
        SelLength := Length(Text);
        Exit;
      end;
end;

procedure TQRExpressionBuilder.InsertFunctionBtnClick(Sender: TObject);
var
  AFunction : string;
begin
  MainPage.Enabled := false;
  if GetFunc(AFunction) then
  begin
    MainPage.Enabled := true;
    InsertText(AFunction);
  end else
    MainPage.Enabled := true;
  MainPage.BringToFront;
  Expr.SetFocus;
end;

procedure TQRExpressionBuilder.FuncParamOkBtnClick(Sender: TObject);
begin
  FFuncParamsResult := 1;
end;

procedure TQRExpressionBuilder.FuncArgCancelBtnClick(Sender: TObject);
begin
  FFuncParamsResult := 2;
end;

procedure TQRExpressionBuilder.FunctionCancelBtnClick(Sender: TObject);
begin
  FFuncResult := 2;
end;

procedure TQRExpressionBuilder.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  FFuncResult := 2;
  FFuncParamsResult := 2;
  FDataFieldResult := 2;
  if FExprResult <> 1 then FExprResult := 2;
  FVariableResult := 2;
  CanClose := true;
end;

function TQRExpressionBuilder.GetDatafield(var Field : string) : boolean;
begin
  FDatafieldResult := 0;
  DataFieldPage.Enabled := true;
  DataFieldPage.BringToFront;
  repeat
    Application.HandleMessage
  until FDatafieldResult <> 0;
  Result := FDatafieldResult = 1;
  if Result and (AvailableDataSets.ItemIndex > -1) and (AvailableFields.ItemIndex > -1) then
    Field := AvailableDatasets.Items[AvailableDataSets.ItemIndex] + '.' + AvailableFields.Items[AvailableFields.ItemIndex]
  else
    Field := '';
  DataFieldPage.Enabled := false;
end;

function TQRExpressionBuilder.GetVariable(var Variable : string) : boolean;
begin
  FVariableResult := 0;
  VariablePage.Enabled := true;
  VariablePage.BringToFront;
  repeat
    Application.HandleMessage
  until FVariableResult <> 0;
  Result := FVariableResult = 1;
  if Result then
    Variable := AvailableVariables.Items[AvailableVariables.ItemIndex]
  else
    Variable := '';
  VariablePage.Enabled := false;
end;

procedure TQRExpressionBuilder.InsertText(AText : string);
begin
  Expr.SelText := AText;
  Expr.SelStart := Expr.SelStart + Expr.SelLength;
  Expr.SelLength := 0;
  Expr.SetFocus;
end;

procedure TQRExpressionBuilder.AddSomeClick(Sender: TObject);
begin
  InsertText(' ' + TSpeedButton(Sender).Caption + ' ');
end;

procedure TQRExpressionBuilder.PickDatasets;
begin
  AvailableDataSets.Items := AllDataSets(DatasetForm, true);
  AvailableDataSets.ItemIndex := 0;
  AvailableDataSetsClick(self);
end;

procedure TQRExpressionBuilder.PickVariables;
var
  I : integer;
begin
  AvailableVariables.Items.Clear;
  if LocalEnvironment <> nil then
    for I := 0 to LocalEnvironment.Count - 1 do
      AvailableVariables.Items.Add(LocalEnvironment[I]);
  for I := 0 to QRGlobalEnvironment.Count - 1 do
    AvailableVariables.Items.Add(QRGlobalEnvironment[I]);
  AvailableVariables.ItemIndex := 0;
  AvailableVariablesClick(Self);
end;

procedure TQRExpressionBuilder.FormActivate(Sender: TObject);
begin
  PickDataSets;
  PickVariables;
  Expr.SetFocus;
end;

procedure TQRExpressionBuilder.AvailableDatasetsClick(Sender: TObject);
var
  I : integer;
begin
  AvailableFields.Items.Clear;
  if AvailableDataSets.Items.Count > 0 then
    with TDataSet(AvailableDataSets.Items.Objects[AvailableDataSets.ItemIndex]) do
    begin
      for I := 0 to FieldCount - 1 do
        AvailableFields.Items.Add(Fields[I].FieldName);
    end;
end;

procedure TQRExpressionBuilder.OKClick(Sender: TObject);
begin
  FExprResult := 1;
end;

procedure TQRExpressionBuilder.CancelClick(Sender: TObject);
begin
  FExprResult := 2;
end;

procedure TQRExpressionBuilder.ClearClick(Sender: TObject);
begin
  Expr.Text := '';
end;

procedure TQRExpressionBuilder.ValidateBtnClick(Sender: TObject);
var
  I : integer;
  AResult : TQREvResult;
  TextResult : string;
begin
  QRGlobalEnvironment.Prepare;
  if LocalEnvironment <> nil then
    LocalEnvironment.Prepare;
  with TQREvaluator.Create do
  try
    DataSets := TList.Create;
    Environment := LocalEnvironment;
    for I := 0 to AvailableDataSets.Items.Count - 1 do
      DataSets.Add(TDataSet(AvailableDataSets.Items.Objects[I]));
    AResult := Calculate(TrimExpr(Expr.Text));
    TextResult := '';
    case AResult.Kind of
      resInt : TextResult := IntToStr(AResult.IntResult);
      resDouble : TextResult := FloatToStr(AResult.DblResult);
      resString : TextResult := AResult.StrResult;
      resBool : if AResult.booResult then
                  TextResult := 'True'
                else
                  TextResult := 'False';
    end;
    if TextResult = '' then
      ShowMessage(SqrExpBldError + AResult.strResult)
    else
      ShowMessage(SqrExpBldNoError + TextResult);
      DataSets.Free;
  finally
    free;
  end;
  if LocalEnvironment <> nil then LocalEnvironment.Unprepare;
  QRGlobalEnvironment.Unprepare;
end;

procedure TQRExpressionBuilder.InsertVariableBtnClick(Sender: TObject);
var
  AVariable : string;
begin
  MainPage.Enabled := false;
  if GetVariable(AVariable) then
  begin
    MainPage.Enabled := true;
    InsertText(AVariable);
  end else
    MainPage.Enabled := true;
  MainPage.BringToFront;
end;

procedure TQRExpressionBuilder.VariableOKBtnClick(Sender: TObject);
begin
  FVariableResult := 1;
end;

procedure TQRExpressionBuilder.VariableCancelBtnClick(Sender: TObject);
begin
  FVariableResult := 2;
end;

procedure TQRExpressionBuilder.AvailableVariablesClick(Sender: TObject);
var
  VarName : string;
begin
  VarName := AvailableVariables.Items[AvailableVariables.ItemIndex];
  if (LocalEnvironment <> nil) and (LocalEnvironment.IndexOf(VarName) >= 0) then
  begin
    with TQREvEmbeddedFunction(TQREvElementWrapper(LocalEnvironment.Element(VarName)).EmbeddedFunction) do
      VariableValue.Caption := Expression;
  end else
    with TQREvEmbeddedFunction(TQREvElementWrapper(QRGlobalEnvironment.Element(VarName)).EmbeddedFunction) do
      VariableValue.Caption := Expression;
end;


procedure TQRExpressionBuilder.ModifyVariablesClick(Sender: TObject);
begin
  EditEnvironment(LocalEnvironment, true, self);
end;

end.