⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rmd_qrydesigner.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    s := s + FWheres[i];
    if (length(s) > 60) or (i = FWheres.Count - 1) then
    begin
      FForm.SQLMemo.Lines.Add(s);
      s := '    ';
    end;
  end;

  for i := 0 to FGroups.Count - 1 do // GROUP BY
  begin
    if i = 0 then
      s := 'GROUP BY '
    else
      s := s + ', ';
    s := s + FGroups[i];
    if (length(s) > 60) or (i = FGroups.Count - 1) then
    begin
      FForm.SQLMemo.Lines.Add(s);
      s := '    ';
    end;
  end;

  for i := 0 to FSorts.Count - 1 do // ORDER BY
  begin
    if i = 0 then
      s := 'ORDER BY '
    else
      s := s + ', ';
    s := s + FSorts[i];
    if (length(s) > 60) or (i = FSorts.Count - 1) then
    begin
      FForm.SQLMemo.Lines.Add(s);
      s := '    ';
    end;
  end;
end;

procedure TRMSQL.geTables;
var
  i: integer;
  Link: TRMQBLink;
  tbl1, tbl2: string;
  sl: TStringList;
begin
  FTables.Clear;
  FTableAlias.Clear;
  sl := TStringList.Create;
  try
    for i := 0 to FForm.QBArea.ControlCount - 1 do // search tables for joins
    begin
      if FForm.QBArea.Controls[i] is TRMQBLink then
      begin
        Link := TRMQBLink(FForm.QBArea.Controls[i]);
        if Link.FLinkType > 0 then
        begin
          tbl1 := LowerCase(Link.Tbl1.FTableAlias);
          tbl2 := LowerCase(Link.Tbl2.FTableAlias);
          FTables.Add(LowerCase(Link.Tbl1.FTableName) + ' ' + tbl1
            + sOuterJoin[Link.FLinkType] + LowerCase(Link.Tbl2.FTableName) + ' ' + tbl2 + ' ON '
            + tbl1 + '.' + LowerCase(Link.FldNam1) + sLinkOpt[Link.FLinkOpt]
            + tbl2 + '.' + LowerCase(Link.FldNam2));
          FTableAlias.Add('');

          if sl.IndexOf(Link.Tbl1.FTableName) < 0 then
            sl.Add(Link.Tbl1.FTableName);
          if sl.IndexOf(Link.Tbl2.FTableName) < 0 then
            sl.Add(Link.Tbl2.FTableName);
        end;
      end;
    end;

    for i := 0 to FForm.QBArea.ControlCount - 1 do
    begin
      if FForm.QBArea.Controls[i] is TRMQBTable then
      begin
        if sl.IndexOf(TRMQBTable(FForm.QBArea.Controls[i]).FTableName) < 0 then
        begin
          sl.Add(TRMQBTable(FForm.QBArea.Controls[i]).FTableName);
          FTables.Add(TRMQBTable(FForm.QBArea.Controls[i]).FTableName);
          FTableAlias.Add(TRMQBTable(FForm.QBArea.Controls[i]).FTableAlias);
        end;
      end;
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMSQL.geColumns;
var
  i: integer;
  str: string;
begin
  FColumns.Clear;
  for i := 0 to FForm.FFieldListView.Items.Count - 1 do
  begin
    str := FForm.FFieldListView.Items[i].SubItems[0];
    if Pos('.', str) > 0 then
      str := Copy(str, Pos('.', str) + 1, 99999);
    if str <> FForm.FFieldListView.Items[i].Caption then
      str := ' ' + FForm.FFieldListView.Items[i].Caption
    else
      str := '';
    str := MakeFieldAlias(FForm.FFieldListView.Items[i].SubItems[0]) + str;
    FColumns.Add(str);
  end;

  for i := 0 to FForm.FCalcListView.Items.Count - 1 do
  begin
    if AnsiCompareText(FForm.FCalcListView.Items[i].SubItems[2], sFunc_1[0]) = 0 then
      FColumns.Add(sFunc[0] + '(' + FForm.FCalcListView.Items[i].SubItems[0] + ') ' + FForm.FCalcListView.Items[i].Caption)
    else if AnsiCompareText(FForm.FCalcListView.Items[i].SubItems[2], sFunc_1[1]) = 0 then
      FColumns.Add(sFunc[1] + '(' + FForm.FCalcListView.Items[i].SubItems[0] + ') ' + FForm.FCalcListView.Items[i].Caption)
    else if AnsiCompareText(FForm.FCalcListView.Items[i].SubItems[2], sFunc_1[2]) = 0 then
      FColumns.Add(sFunc[2] + '(' + FForm.FCalcListView.Items[i].SubItems[0] + ') ' + FForm.FCalcListView.Items[i].Caption)
    else if AnsiCompareText(FForm.FCalcListView.Items[i].SubItems[2], sFunc_1[3]) = 0 then
      FColumns.Add(sFunc[3] + '(' + FForm.FCalcListView.Items[i].SubItems[0] + ') ' + FForm.FCalcListView.Items[i].Caption)
    else if AnsiCompareText(FForm.FCalcListView.Items[i].SubItems[2], sFunc_1[4]) = 0 then
      FColumns.Add(sFunc[4] + '(' + FForm.FCalcListView.Items[i].SubItems[0] + ') ' + FForm.FCalcListView.Items[i].Caption)
    else
      FColumns.Add(FForm.FCalcListView.Items[i].SubItems[0] + ' ' + FForm.FCalcListView.Items[i].Caption);
  end;
end;

procedure TRMSQL.geGroups;
var
  i: integer;
begin
  FSorts.Clear;
  for i := 0 to FForm.lstGroupRight.Items.Count - 1 do
  begin
    FGroups.Add(MakeFieldAlias(FForm.lstGroupRight.Items[i]));
  end;
end;

procedure TRMSQL.geSorts;
var
  i: integer;
  str: string;
begin
  FSorts.Clear;
  for i := 0 to FForm.lsvSortRight.Items.Count - 1 do
  begin
    str := MakeFieldAlias(FForm.lsvSortRight.Items[i].Caption);
    if Length(FForm.lsvSortRight.Items[i].SubItems[0]) > 0 then
      str := str + ' DESC';
    FSorts.Add(str);
  end;
end;

procedure TRMSQL.geWheres;
var
  i: integer;
  str: string;
  Link: TRMQBLink;
begin
  FWheres.Clear;
  for i := 0 to FForm.QBArea.ControlCount - 1 do
  begin
    if FForm.QBArea.Controls[i] is TRMQBLink then
    begin
      Link := TRMQBLink(FForm.QBArea.Controls[i]);
      if Link.FLinkType = 0 then
      begin
        str := MakeFieldAlias(Link.tbl1.FTableAlias + '.' + Link.fldNam1) + sLinkOpt[Link.FLinkOpt] +
          MakeFieldAlias(Link.tbl2.FTableAlias + '.' + Link.fldNam2);
        FWheres.Add(LowerCase(str));
      end;
    end;
  end;
end;

procedure CalcEditControlPosition(aListView: TListView; aControl: TControl; aItem: TListItem; aFieldPosition: Integer);
var
  i: Integer;
  Offset: Integer;
  Left: Integer;
  Width: Integer;
  ControlEdge: Integer;
  ListViewEdge: Integer;
begin
  if (aItem = nil) then
  begin
    aControl.Visible := False;
    Exit;
  end;

  Offset := (aListView.Columns.Count - aFieldPosition) + 1;
  Left := 0;
  for i := 0 to aListView.Columns.Count - Offset do
    Left := Left + aListView.Columns[i].Width;

  ControlEdge := Left + aListView.Columns[aFieldPosition].Width;
  ListViewEdge := (aListView.Left + aListView.Width);
  Width := aListView.Columns[aFieldPosition].Width;
  Left := Left + aItem.Left;
  if ControlEdge > ListViewEdge then
    Width := (Width - (ControlEdge - ListViewEdge)) - 2;
  if Width < 12 then
    aControl.Visible := False
  else
  begin
    aControl.Visible := True;
    if aControl is TComboBox then
    begin
      aControl.Left := Left + 1;
      aControl.Top := aItem.Top;
      aControl.Width := Width - 2;
    end
    else if aControl is TEdit then
    begin
      aControl.Left := Left + 1;
      aControl.Top := aItem.Top;
      aControl.Width := Width - 2;
    end
    else if aControl is TCheckBox then
    begin
      aControl.Left := Left + 1;
      aControl.Top := aItem.Top + 2;
      aControl.Width := Width - 3;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMListView}

procedure TRMListView.WMHScroll(var Message: TWMVScroll);
begin
  inherited;
  DoHorizontalScroll;
  DoScroll;
end;

procedure TRMListView.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  DoVerticalScroll;
  DoScroll;
end;

procedure TRMListView.DoVerticalScroll;
begin
  if Assigned(FOnVerticalScroll) then
    FOnVerticalScroll(Self);
end;

procedure TRMListView.DoHorizontalScroll;
begin
  if Assigned(FOnHorizontalScroll) then
    FOnHorizontalScroll(Self);
end;

procedure TRMListView.DoScroll;
begin
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

procedure TRMListView.WMNotify(var Message: TWMNotify);
begin
  inherited;
  if (ViewStyle <> vsReport) then
    Exit;
  with Message.NMHdr^ do
    case code of
      HDN_ITEMCHANGING:
        with PHDNotify(Pointer(Message.NMHdr))^, PItem^ do
        begin
          if (Mask and HDI_WIDTH) <> 0 then
          begin
            Column[Item].Width := cxy;
            DoColumnResize(Column[Item]);
          end;
        end;
    end;
end;

procedure TRMListView.DoColumnResize(aColumn: TListColumn);
begin
  if Assigned(FOnColumnResize) then
    FOnColumnResize(Self, aColumn);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBListView}

constructor TRMQBListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ViewStyle := vsReport;
  ColumnClick := FALSE;

  OnColumnResize := SelectedColumnResizeEvent;
  {$IFNDEF COMPILER3_UP}
  OnResize := SelectedResizeEvent;
  {$ENDIF}
  OnScroll := SelectedScrollEvent;
  OnClick := SelectedClickEvent;
  OnDblClick := SelectedDblClickEvent;
  {$IFDEF COMPILER4_UP}
  OnSelectItem := SelectedSelectItemEvent;
  {$ENDIF}
end;

procedure TRMQBListView.DisplayEditControls(aVisible: Boolean);
begin
end;

procedure TRMQBListView.SelectedSelectItemEvent(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
end;

procedure TRMQBListView.SelectedScrollEvent(Sender: TObject);
begin
  DisplayEditControls(False);
end;

procedure TRMQBListView.SelectedResizeEvent(Sender: TObject);
begin
end;

procedure TRMQBListView.SelectedColumnResizeEvent(aListView: TListView; aColumn: TListColumn);
begin
  SelectedSelectItemEvent(Self, Self.Selected, True);
end;

procedure TRMQBListView.SelectedClickEvent(Sender: TObject);
var
  Point: TPoint;
  ListItem: TListItem;
begin
  GetCursorPos(Point);
  Point := ScreenToClient(Point);
  ListItem := GetItemAt(2, Point.Y);
  Selected := ListItem;
  {$IFDEF Delphi3Only}
  //SelectedSelectItemEvent(Sender, ListItem, True);
  {$ENDIF}
end;

procedure TRMQBListView.SelectedDblClickEvent(Sender: TObject);
begin
  if Selected <> nil then
    Items.Delete(Selected.Index);

  {$IFDEF Delphi3Only}
  //SelectedSelectItemEvent(Self, nil, False);
  {$ENDIF}
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBFieldListView}

constructor TRMQBFieldListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  OnDragOver := _DoDragOver;
  OnDragDrop := _DoDragDrop;

  with Columns.Add do
  begin
    Caption := 'Field Alias';
    Width := 100;
  end;
  with Columns.Add do
  begin
    Caption := 'Field SQL Alias';
    Width := 180;
  end;
end;

procedure TRMQBFieldListView._AddItem(Sender: TObject; aItemIndex: integer);
var
  tmp: TRMQBTable;
  str: string;
  i: integer;
begin
  tmp := TRMQBTable(Sender);
  str := tmp.FTableAlias + '.' + tmp.FLbx.Items[aItemIndex];
  for i := 0 to FForm.FFieldListView.Items.Count - 1 do
  begin
    if str = FForm.FFieldListView.Items[i].SubItems[0] then
      Exit;
  end;

  with FForm.FFieldListView.Items.Add do
  begin
    Caption := tmp.FLbx.Items[aItemIndex];
    SubItems.Add(str);
  end;
end;

procedure TRMQBFieldListView.DeleteItem(Sender: TObject; aItemIndex: integer);
var
  tmp: TRMQBTable;
  i: integer;
  str: string;
begin
  tmp := TRMQBTable(Sender);
  str := tmp.FTableAlias + '.' + tmp.FLbx.Items[aItemIndex];
  for i := 0 to FForm.FFieldListView.Items.Count - 1 do
  begin
    if str = FForm.FFieldListView.Items[i].SubItems[0] then
    begin
      FForm.FFieldListView.Items.Delete(i);
      Break;
    end;
  end;
end;

procedure TRMQBFieldListView._DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Source is TCheckListBox) and (TWinControl(Source).Parent is TRMQBTable) then
    Accept := TRUE;
end;

procedure TRMQBFieldListView._DoDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if not (Source is TCheckListBox) then
    exit;
  _AddItem(TWinControl(Source).Parent, TRMQBTable(TWinControl(Source).Parent).FLbx.ItemIndex);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBCalcListView}

constructor TRMQBCalcListView.Create(AOwner: TComponent);
var
  i: integer;
begin
  inherited Create(AOwner);
  OnDragOver := _DoDragOver;
  OnDragDrop := _DoDragDrop;
  for i := Low(sFunc_1) to High(sFunc_1) do
    FForm.cmbCalc.Items.Add(sFunc_1[i]);

  with Columns.Add do
  begin
    Caption := 'Field Alias';
    Width := 100;
  end;
  with Columns.Add do
  begin
    Caption := 'Field SQL Alias';
    Width := 180;
  end;
  with Columns.Add do
  begin
    Caption := 'Table';
    Width := 100;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -