rmd_qrydesigner.pas

这是一个功能强大

  RMSetStrProp(SaveDialog1, 'Filter', rmRes + 3092);
  RMSetStrProp(padModifySQL, 'Caption', rmRes + 3093);
  RMSetStrProp(btnModifySQL, 'Caption', rmRes + 3093);

  btnOK.Hint := RMLoadStr(SOK);
  btnCancel.Hint := RMLoadStr(SCancel);
end;

procedure TRMDQueryDesignerForm.ClearAll;
var
  i: integer;
begin
  FFieldListView.Items.Clear;
  FCalcListView.Items.Clear;
  lstGroupLeft.Items.Clear;
  lstGroupRight.Items.Clear;
  lstSortLeft.Items.Clear;
  lsvSortRight.Items.Clear;
  for i := QBArea.ControlCount - 1 downto 0 do
    QBArea.Controls[i].Free;
end;

procedure TRMDQueryDesignerForm.SaveVisualSQL;
var
  i, j: integer;
  s: string;
  TempTable: TRMQBTable;
  TempLink: TRMQBLink;
begin
  FQuery.VisualSQL.Clear;
  if not FQuery.UseSQLBuilder then Exit;

  FQuery.VisualSQL.Add('[Tables]'); // save tables
  for i := 0 to QBArea.ControlCount - 1 do
  begin
    if QBArea.Controls[i] is TRMQBTable then
    begin
      TempTable := TRMQBTable(QBArea.Controls[i]);
      s := Format('%s,%d,%d', [TempTable.FTableName, TempTable.Top + QBArea.VertScrollBar.ScrollPos,
        TempTable.Left + QBArea.HorzScrollBar.ScrollPos]);
      for j := 0 to TempTable.FLbx.Items.Count - 1 do
      begin
        if TempTable.FLbx.Checked[j] then
          s := s + ',1'
        else
          s := s + ',0';
      end;
      FQuery.VisualSQL.Add(s + ';');
    end;
  end;

  FQuery.VisualSQL.Add('[Links]'); // save links
  for i := 0 to QBArea.ControlCount - 1 do
  begin
    if QBArea.Controls[i] is TRMQBLink then
    begin
      TempLink := TRMQBLink(QBArea.Controls[i]);
      s := Format('%s,%d,%s,%d,%d,%d', [TempLink.Tbl1.FTableName, TempLink.FldN1,
        TempLink.Tbl2.FTableName, TempLink.FldN2, TempLink.FLinkOpt, TempLink.FLinkType]);
      FQuery.VisualSQL.Add(s + ';');
    end;
  end;

  FQuery.VisualSQL.Add('[Fields]'); // save fields
  for i := 0 to FFieldListView.Items.Count - 1 do
  begin
    s := FFieldListView.Items[i].Caption + ',' + FFieldListView.Items[i].SubItems[0];
    FQuery.VisualSQL.Add(s + ';');
  end;

  FQuery.VisualSQL.Add('[Calc Fields]'); // save calc fields
  for i := 0 to FCalcListView.Items.Count - 1 do
  begin
    s := Format('%s,%s,%s,%s,%s', [FCalcListView.Items[i].Caption, FCalcListView.Items[i].SubItems[0],
      FCalcListView.Items[i].SubItems[1], FCalcListView.Items[i].SubItems[2], FCalcListView.Items[i].SubItems[3]]);
    FQuery.VisualSQL.Add(s + ';');
  end;

  FQuery.VisualSQL.Add('[Groups]'); // save groups
  for i := 0 to lstGroupRight.Items.Count - 1 do
  begin
    FQuery.VisualSQL.Add(lstGroupRight.Items[i] + ';');
  end;

  FQuery.VisualSQL.Add('[Sorts]'); // save sorts
  for i := 0 to lsvSortRight.Items.Count - 1 do
  begin
    s := lsvSortRight.Items[i].Caption + ',' + lsvSortRight.Items[i].SubItems[0];
    FQuery.VisualSQL.Add(s + ';');
  end;
end;

procedure TRMDQueryDesignerForm.DecodeVisualSQL;
var
  i, ii, j: integer;
  s, ss: string;
  NewTable: TRMQBTable;
  TableName: string;
  X, Y: integer;
  NewLink: TRMQBLink;
  Table1, Table2: TRMQBTable;
  FieldN1, FieldN2: integer;

  function GetNextVal(var s: string): string;
  var
    p: integer;
  begin
    Result := EmptyStr;
    p := Pos(',', s);
    if p = 0 then
    begin
      p := Pos(';', s);
      if p = 0 then
        Exit;
    end;
    Result := System.Copy(s, 1, p - 1);
    System.Delete(s, 1, p);
  end;

begin
  ClearAll;
  j := -1;
  for i := 0 to FQuery.VisualSQL.Count - 1 do
  begin
    if FQuery.VisualSQL[i] = '[Tables]' then
    begin
      j := i + 1;
      Break;
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read tables
    begin
      if FQuery.VisualSQL[i] = '[Links]' then
      begin
        j := i + 1;
        Break;
      end;
      s := FQuery.VisualSQL[i];
      TableName := GetNextVal(s);
      Y := StrToInt(GetNextVal(s));
      X := StrToInt(GetNextVal(s));
      NewTable := TRMQBTable.Create(QBArea);
      NewTable.Parent := QBArea;
      try
        NewTable.Activate(TableName, X, Y);
        NewTable.FLbx.FLoading := true;
        for ii := 0 to NewTable.FLbx.Items.Count - 1 do
        begin
          ss := GetNextVal(s);
          if ss <> EmptyStr then
          begin
            NewTable.FLbx.Checked[ii] := boolean(StrToInt(ss));
          end;
        end;
        NewTable.FLbx.FLoading := false;
      except
        NewTable.Free;
      end;
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read links
    begin
      if FQuery.VisualSQL[i] = '[Fields]' then
      begin
        j := i + 1;
        Break;
      end;
      s := FQuery.VisualSQL[i];
      Table1 := QBArea.FindTable(GetNextVal(s));
      FieldN1 := StrToInt(GetNextVal(s));
      Table2 := QBArea.FindTable(GetNextVal(s));
      FieldN2 := StrToInt(GetNextVal(s));
      NewLink := QBArea.InsertLink(Table1, Table2, FieldN1, FieldN2);
      NewLink.FLinkOpt := StrToInt(GetNextVal(s));
      NewLink.FLinkType := StrToInt(GetNextVal(s));
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read fields
    begin
      if FQuery.VisualSQL[i] = '[Calc Fields]' then
      begin
        j := i + 1;
        Break;
      end;
      s := FQuery.VisualSQL[i];
      with FFieldListView.Items.Add do
      begin
        Caption := GetNextVal(s);
        SubItems.Add(GetNextVal(s));
      end;
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read calc fields
    begin
      if FQuery.VisualSQL[i] = '[Groups]' then
      begin
        j := i + 1;
        Break;
      end;
      s := FQuery.VisualSQL[i];
      with FCalcListView.Items.Add do
      begin
        Caption := GetNextVal(s);
        SubItems.Add(GetNextVal(s));
        SubItems.Add(GetNextVal(s));
        SubItems.Add(GetNextVal(s));
        SubItems.Add(GetNextVal(s));
      end;
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read group
    begin
      if FQuery.VisualSQL[i] = '[Sorts]' then
      begin
        j := i + 1;
        Break;
      end;
      s := FQuery.VisualSQL[i];
      lstGroupRight.Items.Add(GetNextVal(s));
    end;
  end;

  if j >= 0 then
  begin
    for i := j to FQuery.VisualSQL.Count - 1 do // read sorts
    begin
      s := FQuery.VisualSQL[i];
      with lsvSortRight.Items.Add do
      begin
        Caption := GetNextVal(s);
        SubItems.Add(GetNextVal(s));
      end;
    end;
  end;
end;

procedure TRMDQueryDesignerForm.SetEditSQLAsText;
begin
  if FQuery.UseSQLBuilder then
  begin
    TabSheetFields.TabVisible := TRUE;
    TabSheetCalc.TabVisible := TRUE;
    TabSheetGroup.TabVisible := TRUE;
    TabSheetSort.TabVisible := TRUE;
    SQLMemo.PopupMenu := pmnSQLMemo;
    SQLMemo.Color := clBtnFace;
  end
  else
  begin
    TabSheetFields.TabVisible := FALSE;
    TabSheetCalc.TabVisible := FALSE;
    TabSheetGroup.TabVisible := FALSE;
    TabSheetSort.TabVisible := FALSE;
    SQLMemo.PopupMenu := nil;
    SQLMemo.Color := clWindow;
  end;
  SQLMemo.ReadOnly := FQuery.UseSQLBuilder;
end;

procedure TRMDQueryDesignerForm.SetQuery(Value: TRMDQuery);
begin
  FQuery := Value;
  FSaveSQL := FQuery.SQL;
  FSaveDatabase := FQuery.DatabaseName;
  FSaveEditSQLAsText := FQuery.UseSQLBuilder;
  FSaveVisualSQL.Assign(FQuery.VisualSQL);
  cmbDatabase.Enabled := False; //Value.CanChangeDatabase;
  if (FQuery.SQL <> '') and (FQuery.VisualSQL.Text = '') then
    FQuery.UseSQLBuilder := False;

  THackRMDQuery(FQuery).GetDatabases(cmbDatabase.Items);
  cmbDatabase.ItemIndex := cmbDatabase.Items.IndexOf(FQuery.DatabaseName);
  if cmbDatabase.ItemIndex < 0 then
    cmbDatabase.ItemIndex := 0;
  cmbDatabaseChange(nil);

  SetEditSQLAsText;
  if FQuery.UseSQLBuilder then
    DecodeVisualSQL
  else
    SQLMemo.Lines.Text := Value.SQL;
end;

procedure TRMDQueryDesignerForm.ApplySettings;
begin
  Query.DatabaseName := cmbDatabase.Text;
  Query.SQL := SQLMemo.Lines.Text;
  SaveVisualSQL;
end;

procedure TRMDQueryDesignerForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if ModalResult = mrCancel then
  begin
    Query.SQL := FSaveSQL;
    Query.DatabaseName := FSaveDatabase;
    Query.VisualSQL.Assign(FSaveVisualSQL);
    Query.UseSQLBuilder := FSaveEditSQLAsText;
  end;
end;

procedure TRMDQueryDesignerForm.FormDestroy(Sender: TObject);
begin
  FSaveVisualSQL.Free;
end;

procedure TRMDQueryDesignerForm.FieldsBClick(Sender: TObject);
var
  FieldsEditorForm: TRMDFieldsEditorForm;
begin
  ApplySettings;
  FieldsEditorForm := TRMDFieldsEditorForm.Create(nil);
  with FieldsEditorForm do
  begin
    Dataset := Query.DataSet;
    ShowModal;
    Free;
  end;
end;

procedure TRMDQueryDesignerForm.ParamsBClick(Sender: TObject);
var
  ParamsForm: TRMDParamsForm;
begin
  ApplySettings;
  //  if Assigned(Query.OnSQLTextChanged) then Query.OnSQLTextChanged(nil);
  if Query.ParamCount = 0 then
    Exit;
  ParamsForm := TRMDParamsForm.Create(nil);
  with ParamsForm do
  begin
    Query := Self.Query;
    Caption := Query.Name + ' ' + RMLoadStr(SParams);
    ShowModal;
    Free;
  end;
end;

procedure TRMDQueryDesignerForm.FormCreate(Sender: TObject);
begin
  Localize;

  {$IFDEF USE_SYNEDIT}
  FSynSQLSyn := TSynSQLSyn.Create(Self);
  {$ENDIF}
  SQLMemo := TRMSynEditor.Create(Self);
  with SQLMemo do
  begin
    Parent := tabSheetSQL;
    {$IFDEF USE_SYNEDIT}
    Highlighter := FSynSQLSyn;
    Gutter.ShowLineNumbers := True;
    {$ENDIF}
    SetHighLighter(rmhlSQL);
    ScrollBars := ssBoth;
    Font.Name := 'Courier New';
    Font.Size := 10;
    Align := alClient;
    Font.Charset := DEFAULT_CHARSET;
    SetGutterWidth(20);
    SetGroupUndo(True);
    SetUndoAfterSave(False);
  end;

  FForm := Self;
  pgcDesigner.ActivePage := TabSheetFields;
  FSaveVisualSQL := TStringList.Create;

  QBArea := TRMQBArea.Create(Self);
  QBArea.Parent := Panel2;
  QBArea.Align := alClient;

  FFieldListView := TRMQBFieldListView.Create(Self);
  FFieldListView.Parent := TabSheetFields;
  FFieldListView.Align := alClient;
  FFieldListView.SmallImages := ImageList1;

  FCalcListView := TRMQBCalcListView.Create(Self);
  FCalcListView.Parent := TabSheetCalc;
  FCalcListView.Align := alClient;
  FCalcListView.SmallImages := ImageList1;
  cmbCalc.BringToFront;
  edtExpr.BringToFront;
end;

procedure TRMDQueryDesignerForm.lsbTablesDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  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);
    Canvas.BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clGreen);
    Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  end;
end;

procedure TRMDQueryDesignerForm.cmbCalcChange(Sender: TObject);
begin
  if cmbCalc.ItemIndex >= 0 then
  begin
    FCalcListView.Selected.SubItems[2] := cmbCalc.Items[cmbCalc.ItemIndex];
  end;
end;

procedure TRMDQueryDesignerForm.edtExprKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    FCalcListView.Selected.SubItems[3] := edtExpr.Text;
end;

procedure TRMDQueryDesignerForm.edtExprExit(Sender: TObject);
begin
  FCalcListView.Selected.SubItems[3] := edtExpr.Text;
end;

procedure TRMDQueryDesignerForm.pgcDesignerChange(Sender: TObject);
var
  tmp: TRMSQL;
  i: integer;
begin
  if pgcDesigner.ActivePage = tabSheetGroup then
  begin
    lstGroupLeft.Items.Clear;
    for i := 0 to FFieldListView.Items.Count - 1 do
      lstGroupLeft.Items.Add(FFieldListView.Items[i].SubItems[0]);
    for i := 0 to FCalcListView.Items.Count - 1 do
      lstGroupLeft.Items.Add(FCalcListView.Items[i].Caption);
  end
  else if pgcDesigner.ActivePage = tabSheetSort then
  begin
    lstSortLeft.Items.Clear;
    for i := 0 to FFieldListView.Items.Count - 1 do