rm_dlgexpr.pas

进销存·完整的·有数据库的·非常完整·只得参考

        '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 := '';
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);

  procedure FillFunctions;
  var
    i: integer;
    s: TStringList;
    TreeNode, ANode: TTreeNode;
  begin
    s := TStringList.Create;
    try
      GetCategoryList(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;
    CurReport.Dictionary.GetCategoryList(s);
    s.Add(RMLoadStr(SSystemVariables));
    CategoryLB.Items.Assign(s);
    s.Free;
  end;

begin
  Localize;
  PageControl1.ActivePage := TabSheetExpr;
  Expr := TWordWrapEdit.Create(Self);
  with Expr do
  begin
    Parent := TabSheetExpr;
    AutoSize := false;
    Top := 32;
    Left := 20;
    Width := 397;
    Height := 136;
  end;

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

  FillCategoryLB;
  with CategoryLB do
  begin
    if Items.IndexOf(LastCategory) <> -1 then
      ItemIndex := Items.IndexOf(LastCategory)
    else
      ItemIndex := 0;
  end;
  CategoryLBClick(nil);

  FillFunctions;
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
  Expr.Text := '';
end;

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

procedure TRMFormExpressionBuilder.btnDataFieldOKClick(Sender: TObject);
begin
  if lstDatasets.ItemIndex >= 0 then
  begin
    LastDB := 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 Pos('(', AFunction) <> 0 then
      InsertText(AFunction)
    else
      InsertText(AddBrackets(AFunction));
  end;
  PageControl1.ActivePage := TabSheetExpr;
  Expr.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
    InsertText(AddBrackets(AVariable));
  PageControl1.ActivePage := TabSheetExpr;
  Expr.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
    CurReport.Dictionary.GetFieldList(lstDatasets.Items[lstDatasets.ItemIndex], lstFields.Items);
  end;
end;

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

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

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

procedure TRMFormExpressionBuilder.GetVariables;
begin
  CurReport.Dictionary.GetVariablesList(CategoryLB.Items[CategoryLB.ItemIndex],
    VarLB.Items);
end;

procedure TRMFormExpressionBuilder.GetSpecValues;
var
  i: Integer;
begin
  with VarLB.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 VarLB.ItemIndex >= 0 then
  begin
    if CurDataSet <> RMLoadStr(SSystemVariables) then
    begin
      if VarLB.ItemIndex <> -1 then
        FVal := VarLB.Items[VarLB.ItemIndex];
    end
    else
      FVal := RMSpecFuncs[VarLB.ItemIndex];
    LastCategory := CategoryLB.Items[CategoryLB.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.CategoryLBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  Image: TImage;
  r: TRect;
begin
  r := ARect;
  r.Right := r.Left + 18;
  r.Bottom := r.Top + 16;
  OffsetRect(r, 2, 0);
  with TListBox(Control) do
  begin
    Canvas.FillRect(ARect);
    if Control = CategoryLB then
      Image := Image1
    else if Control = VarLB then
      Image := Image2
    else if Control = lstDatasets then
      Image := Image3
    else if Control = lstFields then
      Image := Image4
    else if Control = lstFunc then
      Image := Image5
    else
      Image := Image1;

    Canvas.BrushCopy(r, Image.Picture.Bitmap, Rect(0, 0, 18, 16),
      Image.Picture.Bitmap.TransparentColor);
    Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  end;
end;

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

procedure TRMFormExpressionBuilder.VarLBDblClick(Sender: TObject);
begin
  if VarLB.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);
begin
  Expr.SetFocus;
end;

procedure TRMFormExpressionBuilder.VarLBClick(Sender: TObject);
begin
  if (CurDataSet = RMLoadStr(SSystemVariables)) and (VarLB.ItemIndex >= 0) then
  begin
  end;
end;

end.