rmd_qrydesigner.pas

这是一个功能强大

  end;
  with Columns.Add do
  begin
    Caption := 'Function';
    Width := 100;
  end;
  with Columns.Add do
  begin
    Caption := 'Expression';
    Width := 120;
  end;
end;

procedure TRMQBCalcListView._AddItem(Sender: TObject; aItemIndex: integer);
var
  tmp: TRMQBTable;
begin
  tmp := TRMQBTable(Sender);
  with FForm.FCalcListView.Items.Add do
  begin
    Caption := tmp.FLbx.Items[aItemIndex];
    SubItems.Add(tmp.FTableAlias + '.' + tmp.FLbx.Items[aItemIndex]);
    SubItems.Add(tmp.FTableAlias);
    SubItems.Add(sFunc_1[0]);
    SubItems.Add('');
  end;
end;

procedure TRMQBCalcListView._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 TRMQBCalcListView._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;

procedure TRMQBCalcListView.DisplayEditControls(aVisible: Boolean);
begin
  FForm.cmbCalc.Visible := aVisible;
  FForm.edtExpr.Visible := aVisible;
  FForm.edtExpr.Enabled := FForm.cmbCalc.ItemIndex = 5;
end;

procedure TRMQBCalcListView.SelectedSelectItemEvent(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
  if (Item = nil) or not Selected then
    DisplayEditControls(False)
  else
  begin
    CalcEditControlPosition(FForm.FCalcListView, FForm.cmbCalc, Item, 3);
    CalcEditControlPosition(FForm.FCalcListView, FForm.edtExpr, Item, 4);
    FForm.cmbCalc.ItemIndex := FForm.cmbCalc.Items.IndexOf(Item.SubItems[2]);
    FForm.edtExpr.Text := Item.SubItems[3];
    DisplayEditControls(TRUE);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBLbx}

constructor TRMQBLbx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLoading := false;
end;

procedure TRMQBLbx.ClickCheck;
begin
  inherited;
  if FLoading then Exit;
  if Checked[ItemIndex] then
  begin
    if FForm.pgcDesigner.ActivePage = FForm.TabSheetFields then
    begin
      FForm.FFieldListView._AddItem(Self.Parent, ItemIndex);
    end;
  end
  else
  begin
    FForm.FFieldListView.DeleteItem(Self.Parent, ItemIndex);
  end;
end;

function TRMQBLbx.GetItemY(Item: integer): integer;
begin
  Result := Item * ItemHeight + ItemHeight div 2 + 1;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBTable}

constructor TRMQBTable.Create(AOwner: TComponent);
var
  MenuItem: TMenuItem;
begin
  inherited Create(AOwner);
  Visible := FALSE;
  FPopupMenu := TPopupMenu.Create(Self);
  {$IFDEF COMPILER5_UP}
  FPopupMenu.AutoHotkeys := maManual;
  FPopupMenu.AutoLineReduction := maManual;
  {$ENDIF}

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := 'Unlink';
  MenuItem.OnClick := _UnlinkBtn;
  FPopupMenu.Items.Add(MenuItem);

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := 'Remove Table';
  MenuItem.OnClick := _CloseBtn;
  FPopupMenu.Items.Add(MenuItem);

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := '-';
  FPopupMenu.Items.Add(MenuItem);

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := 'Edit Table Alias';
  MenuItem.OnClick := _EditTableAlias;
  FPopupMenu.Items.Add(MenuItem);

  ShowHint := True;
  BorderWidth := 4;
  OnMouseDown := _MouseDown;
  OnMouseMove := _MouseMove;
  OnMouseUp := _MouseUp;
  OnResize := _Resize;
  PopupMenu := FPopupMenu;

  FLbx := TRMQBLbx.Create(Self);
  FLbx.Parent := Self;
  FLbx.Style := lbOwnerDrawFixed;
  FLbx.Align := alBottom;
  FLbX.Top := 24;
  FLbx.DragMode := dmAutomatic;
  FLbx.PopupMenu := FPopupMenu;
  FLbx.OnDragOver := _DragOver;
  FLbx.OnDragDrop := _DragDrop;

  FEdtTableAlias := TEdit.Create(Self);
  with FEdtTableAlias do
  begin
    Parent := Self;
    Left := 20;
    Top := 2;
    Width := 17;
    Visible := FALSE;
    OnExit := _AfterEditTableAlias;
    OnKeyPress := _EditTableAliasKeyPress;
  end;
end;

destructor TRMQBTable.Destroy;
begin
  inherited Destroy;
end;

procedure TRMQBTable.Paint;
begin
  inherited Paint;
  Canvas.TextOut((Width - Canvas.TextWidth(FTableAlias)) div 2, 6, FTableAlias)
end;

function TRMQBTable.GetRowY(FldN: integer): integer;
var
  pnt: TPoint;
begin
  pnt.X := FLbx.Left;
  pnt.Y := FLbx.Top + FLbx.GetItemY(FldN);
  pnt := Parent.ScreenToClient(ClientToScreen(pnt));
  Result := pnt.Y;
end;

procedure TRMQBTable._CloseBtn(Sender: TObject);
begin
  TRMQBArea(Parent).UnlinkTable(Self);
  Free;
end;

procedure TRMQBTable._EditTableAlias(Sender: TObject);
begin
  FEdtTableAlias.Text := FTableAlias;
  FEdtTableAlias.Modified := FALSE;
  FEdtTableAlias.Visible := TRUE;
  FEdtTableAlias.SetFocus;
end;

procedure TRMQBTable._AfterEditTableAlias(Sender: TObject);
var
  i: integer;

  function ReplaceStr(const aSource, aSubStr, aSubStr1: string): string;
  var
    aPos: integer;
  begin
    Result := aSource;
    aPos := Pos(aSubStr + '.', Result);
    while aPos > 0 do
    begin
      System.Delete(Result, aPos, Length(aSubStr));
      System.Insert(aSubStr1, Result, aPos);
      aPos := Pos(aSubStr + '.', Result);
    end;
  end;

begin
  if FEdtTableAlias.Modified and (Length(FEdtTableAlias.Text) > 0) then
  begin
    for i := 0 to FForm.FFieldListView.Items.Count - 1 do
      FForm.FFieldListView.Items[i].SubItems[0] := ReplaceStr(FForm.FFieldListView.Items[i].SubItems[0], FTableAlias, FEdtTableAlias.Text);
    for i := 0 to FForm.FCalcListView.Items.Count - 1 do
      FForm.FCalcListView.Items[i].SubItems[0] := ReplaceStr(FForm.FCalcListView.Items[i].SubItems[0], FTableAlias, FEdtTableAlias.Text);
    for i := 0 to FForm.lstGroupRight.Items.Count - 1 do
      FForm.lstGroupRight.Items[i] := ReplaceStr(FForm.lstGroupRight.Items[i], FTableAlias, FEdtTableAlias.Text);
    for i := 0 to FForm.lsvSortRight.Items.Count - 1 do
      FForm.lsvSortRight.Items[i].Caption := ReplaceStr(FForm.lsvSortRight.Items[i].Caption, FTableAlias, FEdtTableAlias.Text);

    FTableAlias := FEdtTableAlias.Text;
    FEdtTableAlias.Modified := FALSE;
  end;
  FEdtTableAlias.Visible := FALSE;
end;

procedure TRMQBTable._EditTableAliasKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    Key := #0;
    _AfterEditTableAlias(nil);
  end;
end;

procedure TRMQBTable._Resize(Sender: TObject);
begin
  FEdtTableAlias.Width := Width - FEdtTableAlias.Left - 4;
end;

type
  THackQuery = class(TRMDQuery)
  end;

procedure TRMQBTable.Activate(const ATableName: string; X, Y: Integer);
begin
  Hint := ATableName;
  FTableName := ATableName;
  if Pos('.', ATableName) > 0 then
    FTableAlias := Copy(ATableName, 1, Pos('.', ATableName) - 1)
  else
    FTableAlias := ATableName;

  FLbx.Items.Clear;
  FLbx.Items.BeginUpdate;
  THackQuery(FForm.FQuery).GetTableFieldNames(FForm.cmbDatabase.Text, FTableName, FLbx.Items);
  FLbx.Items.Insert(0, '*');
  FLbx.Items.EndUpdate;

  Top := Y;
  Left := X;
  FLbx.Height := FLbx.ItemHeight * FLbx.Items.Count + 4;
  Height := FLbx.Height + 4 + 22;
  Visible := true;
end;

procedure TRMQBTable._UnlinkBtn(Sender: TObject);
begin
  TRMQBArea(Parent).UnlinkTable(Self);
end;

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

procedure TRMQBTable._DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  nRow: integer;
  hRow: integer;
begin
  if Source = Self.FLbx then
    exit;
  if Source is TCustomListBox then
  begin
    if TWinControl(Source).Parent is TRMQBTable then
    begin
      hRow := FLbx.ItemHeight;
      if hRow <> 0 then
        nRow := Y div hRow
      else
        nRow := 0;
      if nRow > FLbx.Items.Count - 1 then
        nRow := FLbx.Items.Count - 1;
      if Source <> FLbx then
        TRMQBArea(Parent).InsertLink(TRMQBTable(TWinControl(Source).Parent), Self,
          TRMQBTable(TWinControl(Source).Parent).FLbx.ItemIndex, nRow)
      else
      begin
        if nRow <> FLbx.ItemIndex then
          TRMQBArea(Parent).InsertLink(Self, Self, FLbx.ItemIndex, nRow);
      end;
    end
    else if Source = FForm.lsbTables then
    begin
      X := X + Left + TWinControl(Sender).Left;
      Y := Y + Top + TWinControl(Sender).Top;
      TRMQBArea(Parent).InsertTable(X, Y);
    end;
  end
end;

procedure TRMQBTable._MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  BringToFront;
  if Button = mbLeft then
  begin
    SetCapture(Self.Handle);
    FCapturing := TRUE;
    FMouseDownSpot.X := x;
    FMouseDownSpot.Y := Y;
  end;
end;

procedure TRMQBTable._MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if FCapturing then
  begin
    Left := Left - (FMouseDownSpot.x - x);
    Top := Top - (FMouseDownSpot.y - y);
  end;
end;

procedure TRMQBTable._MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FCapturing then
  begin
    ReleaseCapture;
    FCapturing := false;
  end;
  TRMQBArea(Parent).ReboundLinks4Table(Self);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBLink}

constructor TRMQBLink.Create(AOwner: TComponent);
var
  mnuArr: array[1..4] of TMenuItem;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 105;
  Height := 105;
  Rgn := CreateRectRgn(0, 0, Hand, Hand);
  mnuArr[1] := NewItem('', 0, false, false, nil, 0, 'mnuLinkName');
  mnuArr[2] := NewLine;
  mnuArr[3] := NewItem('Link options', 0, false, true, TRMQBArea(AOwner).SetOptions, 0, 'mnuOptions');
  mnuArr[4] := NewItem('Unlink', 0, false, true, TRMQBArea(AOwner).Unlink, 0, 'mnuUnlink');
  FPopMenu := NewPopupMenu(Self, 'mnu', paLeft, false, mnuArr);
  FPopMenu.PopupComponent := Self;
end;

destructor TRMQBLink.Destroy;
begin
  DeleteObject(Rgn);
  inherited Destroy;
end;

procedure TRMQBLink.Paint;
var
  ArrRgn, pntArray: array[1..4] of TPoint;
  ArrCnt: integer;
begin
  if tbl1 <> tbl2 then
  begin
    if ((LnkX = 1) and (LnkY = 1)) or ((LnkX = 4) and (LnkY = 2)) then
    begin
      pntArray[1].X := 0;
      pntArray[1].Y := Hand div 2;
      pntArray[2].X := Hand;
      pntArray[2].Y := Hand div 2;
      pntArray[3].X := Width - Hand;
      pntArray[3].Y := Height - Hand div 2;
      pntArray[4].X := Width;
      pntArray[4].Y := Height - Hand div 2;
      ArrRgn[1].X := pntArray[2].X + 5;
      ArrRgn[1].Y := pntArray[2].Y - 5;
      ArrRgn[2].X := pntArray[2].X - 5;
      ArrRgn[2].Y := pntArray[2].Y + 5;
      ArrRgn[3].X := pntArray[3].X - 5;
      ArrRgn[3].Y := pntArray[3].Y + 5;
      ArrRgn[4].X := pntArray[3].X + 5;
      ArrRgn[4].Y := pntArray[3].Y - 5;
    end;
    if Width > Hand + Hand2 then
    begin
      if ((LnkX = 2) and (LnkY = 1)) or ((LnkX = 3) and (LnkY = 2)) then
      begin
        pntArray[1].X := 0;
        pntArray[1].Y := Hand div 2;
        pntArray[2].X := Hand;
        pntArray[2].Y := Hand div 2;
        pntArray[3].X := Width - 5;
        pntArray[3].Y := Height - Hand div 2;
        pntArray[4].X := Width - Hand;
        pntArray[4].Y := Height - Hand div 2;
        ArrRgn[1].X := pntArray[2].X + 5;
        ArrRgn[1].Y := pntArray[2].Y - 5;
        ArrRgn[2].X := pntArray[2].X - 5;
        ArrRgn[2].Y := pntArray[2].Y + 5;
        ArrRgn[3].X := pntArray[3].X - 5;
        ArrRgn[3].Y := pntArray[3].Y + 5;
        ArrRgn[4].X := pntArray[3].X + 5;
        ArrRgn[4].Y := pntArray[3].Y - 5;
      end;
      if ((LnkX = 3) and (LnkY = 1)) or ((LnkX = 2) and (LnkY = 2)) then
      begin
        pntArray[1].X := Width - Hand;
        pntArray[1].Y := Hand div 2;
        pntArray[2].X := Width - 5;
        pntArray[2].Y := Hand div 2;
        pntArray[3].X := Hand;
        pntArray[3].Y := Height - Hand div 2;
        pntArray[4].X := 0;
        pntArray[4].Y := Height - Hand div 2;
        ArrRgn[1].X := pntArray[2].X - 5;
        ArrRgn[1].Y := pntArray[2].Y - 5;
        ArrRgn[2].X := pntArray[2].X + 5;
        ArrRgn[2].Y := pntArray[2].Y + 5;
        ArrRgn[3].X := pntArray[3].X + 5;
        ArrRgn[3].Y := pntArray[3].Y + 5;
        ArrRgn[4].X := pntArray[3].X - 5;
        ArrRgn[4].Y := pntArray[3].Y - 5;
      end;
    end
    else
    begin
      if ((LnkX = 2) and (LnkY = 1)) or ((LnkX = 3) and (LnkY = 2)) or
        ((LnkX = 3) and (LnkY = 1)) or ((LnkX = 2) and (LnkY = 2)) then
      begin
        pntArray[1].X := 0;
        pntArray[1].Y := Hand div 2;
        pntArray[2].X := Width - Hand2;
        pntArray[2].Y := Hand div 2;
        pntArray[3].X := Width - Hand2;
        pntArray[3].Y := Height - Hand div 2;