rmd_qrydesigner.pas

这是一个功能强大

        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;
    if ((LnkX = 4) and (LnkY = 1)) or ((LnkX = 1) and (LnkY = 2)) then
    begin
      pntArray[1].X := Width;
      pntArray[1].Y := Hand div 2;
      pntArray[2].X := Width - Hand;
      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
    pntArray[1].X := 0;
    pntArray[1].Y := Hand div 2;
    pntArray[2].X := Hand - 5;
    pntArray[2].Y := Hand div 2;
    pntArray[3].X := Hand - 5;
    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;
  Canvas.PolyLine(pntArray);
  Canvas.Brush := Parent.Brush;
  DeleteObject(Rgn);
  ArrCnt := 4;
  Rgn := CreatePolygonRgn(ArrRgn, ArrCnt, ALTERNATE);
end;

procedure TRMQBLink._Click(X, Y: integer);
var
  pnt: TPoint;
begin
  pnt.X := X;
  pnt.Y := Y;
  pnt := ClientToScreen(pnt);
  FPopMenu.Popup(pnt.X, pnt.Y);
end;

procedure TRMQBLink.CMHitTest(var Message: TCMHitTest);
begin
  if PtInRegion(Rgn, Message.XPos, Message.YPos) then
    Message.Result := 1;
end;

function TRMQBLink.ControlAtPos(const Pos: TPoint): TControl;
var
  I: integer;
  scrnP, P: TPoint;
begin
  scrnP := ClientToScreen(Pos);
  for I := Parent.ControlCount - 1 downto 0 do
  begin
    Result := Parent.Controls[I];
    if (Result is TRMQBLink) and (Result <> Self) then
    begin
      with Result do
      begin
        P := Result.ScreenToClient(scrnP);
        if Perform(CM_HITTEST, 0, integer(PointToSmallPoint(P))) <> 0 then
          Exit;
      end;
    end;
  end;
  Result := nil;
end;

procedure TRMQBLink.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_RBUTTONDOWN) or (Message.Msg = WM_LBUTTONDOWN) then
  begin
    if not PtInRegion(Rgn, TWMMouse(Message).XPos, TWMMouse(Message).YPos) then
      ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos))
    else
      _Click(TWMMouse(Message).XPos, TWMMouse(Message).YPos);
  end;
  inherited WndProc(Message);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMQBArea}

procedure TRMQBArea.CreateParams(var Params: TCreateParams);
begin
  inherited;
  OnDragOver := _DragOver;
  OnDragDrop := _DragDrop;
end;

procedure TRMQBArea.SetOptions(Sender: TObject);
var
  AForm: TRMDFormQBLink;
  ALink: TRMQBLink;
begin
  if TPopupMenu(Sender).Owner is TRMQBLink then
  begin
    ALink := TRMQBLink(TPopupMenu(Sender).Owner);
    AForm := TRMDFormQBLink.Create(Application);
    AForm.txtTable1.Caption := ALink.tbl1.FTableName;
    AForm.txtCol1.Caption := ALink.fldNam1;
    AForm.txtTable2.Caption := ALink.tbl2.FTableName;
    AForm.txtCol2.Caption := ALink.fldNam2;
    AForm.RadioOpt.ItemIndex := ALink.FLinkOpt;
    AForm.RadioType.ItemIndex := ALink.FLinkType;
    if AForm.ShowModal = mrOk then
    begin
      ALink.FLinkOpt := AForm.RadioOpt.ItemIndex;
      ALink.FLinkType := AForm.RadioType.ItemIndex;
    end;
    AForm.Free;
  end;
end;

procedure TRMQBArea.InsertTable(X, Y: Integer);
var
  NewTable: TRMQBTable;
begin
  if FindTable(FForm.lsbTables.Items[FForm.lsbTables.ItemIndex]) <> nil then
  begin
    ShowMessage('This table is already inserted.');
    Exit;
  end;

  NewTable := TRMQBTable.Create(Self);
  NewTable.Parent := Self;
  try
    NewTable.Activate(FForm.lsbTables.Items[FForm.lsbTables.ItemIndex], X, Y);
  except
    NewTable.Free;
  end;
end;

function TRMQBArea.InsertLink(_tbl1, _tbl2: TRMQBTable; _fldN1, _fldN2: Integer): TRMQBLink;
begin
  Result := TRMQBLink.Create(Self);
  with Result do
  begin
    Parent := Self;
    tbl1 := _tbl1;
    tbl2 := _tbl2;
    fldN1 := _fldN1;
    fldN2 := _fldN2;
    fldNam1 := tbl1.FLbx.Items[fldN1];
    fldNam2 := tbl2.FLbx.Items[fldN2];
  end;
  if FindLink(Result) then
  begin
    ShowMessage('These tables are already linked.');
    Result.Free;
    Result := nil;
    Exit;
  end;
  with Result do
  begin
    tbl1.FLbx.Checked[fldN1] := TRUE;
    tbl2.FLbx.Checked[fldN2] := TRUE;
    OnDragOver := _DragOver;
    OnDragDrop := _DragDrop;
  end;
  ReboundLink(Result);
  Result.Visible := True;
end;

function TRMQBArea.FindTable(TableName: string): TRMQBTable;
var
  i: integer;
  TempTable: TRMQBTable;
begin
  Result := nil;
  for i := ControlCount - 1 downto 0 do
  begin
    if Controls[i] is TRMQBTable then
    begin
      TempTable := TRMQBTable(Controls[i]);
      if TempTable.FTableName = TableName then
      begin
        Result := TempTable;
        Exit;
      end;
    end;
  end;
end;

function TRMQBArea.FindLink(Link: TRMQBLink): boolean;
var
  i: integer;
  TempLink: TRMQBLink;
begin
  Result := false;
  for i := ControlCount - 1 downto 0 do
  begin
    if Controls[i] is TRMQBLink then
    begin
      TempLink := TRMQBLink(Controls[i]);
      if TempLink <> Link then
      begin
        if (((TempLink.tbl1 = Link.tbl1) and (TempLink.fldN1 = Link.fldN1)) and
          ((TempLink.tbl2 = Link.tbl2) and (TempLink.fldN2 = Link.fldN2))) or
          (((TempLink.tbl1 = Link.tbl2) and (TempLink.fldN1 = Link.fldN2)) and
          ((TempLink.tbl2 = Link.tbl1) and (TempLink.fldN2 = Link.fldN1))) then
        begin
          Result := true;
          Exit;
        end;
      end;
    end;
  end;
end;

function TRMQBArea.FindOtherLink(Link: TRMQBLink; Tbl: TRMQBTable; FldN: integer): boolean;
var
  i: integer;
  OtherLink: TRMQBLink;
begin
  Result := false;
  for i := ControlCount - 1 downto 0 do
  begin
    if Controls[i] is TRMQBLink then
    begin
      OtherLink := TRMQBLink(Controls[i]);
      if OtherLink <> Link then
      begin
        if ((OtherLink.tbl1 = Tbl) and (OtherLink.fldN1 = FldN)) or
          ((OtherLink.tbl2 = Tbl) and (OtherLink.fldN2 = FldN)) then
        begin
          Result := true;
          Exit;
        end;
      end;
    end;
  end;
end;

procedure TRMQBArea.ReboundLink(Link: TRMQBLink);
var
  X1, X2,
    Y1, Y2: integer;
begin
  Link.FPopMenu.Items[0].Caption := Link.tbl1.FTableName + ' :: ' + Link.tbl2.FTableName;
  with Link do
  begin
    if Tbl1 = Tbl2 then
    begin
      X1 := Tbl1.Left + Tbl1.Width;
      X2 := Tbl1.Left + Tbl1.Width + Hand;
    end
    else
    begin
      if Tbl1.Left < Tbl2.Left then
      begin
        if Tbl1.Left + Tbl1.Width + Hand < Tbl2.Left then
        begin //A
          X1 := Tbl1.Left + Tbl1.Width;
          X2 := Tbl2.Left;
          LnkX := 1;
        end
        else
        begin //B
          if Tbl1.Left + Tbl1.Width > Tbl2.Left + Tbl2.Width then
          begin
            X1 := Tbl2.Left + Tbl2.Width;
            X2 := Tbl1.Left + Tbl1.Width + Hand;
            LnkX := 3;
          end
          else
          begin
            X1 := Tbl1.Left + Tbl1.Width;
            X2 := Tbl2.Left + Tbl2.Width + Hand;
            LnkX := 2;
          end;
        end;
      end
      else
      begin
        if Tbl2.Left + Tbl2.Width + Hand > Tbl1.Left then
        begin //C
          if Tbl2.Left + Tbl2.Width > Tbl1.Left + Tbl1.Width then
          begin
            X1 := Tbl1.Left + Tbl1.Width;
            X2 := Tbl2.Left + Tbl2.Width + Hand;
            LnkX := 2;
          end
          else
          begin
            X1 := Tbl2.Left + Tbl2.Width;
            X2 := Tbl1.Left + Tbl1.Width + Hand;
            LnkX := 3;
          end;
        end
        else
        begin //D
          X1 := Tbl2.Left + Tbl2.Width;
          X2 := Tbl1.Left;
          LnkX := 4;
        end;
      end;
    end;

    Y1 := Tbl1.GetRowY(FldN1);
    Y2 := Tbl2.GetRowY(FldN2);
    if Y1 < Y2 then
    begin //M
      Y1 := Tbl1.GetRowY(FldN1) - Hand div 2;
      Y2 := Tbl2.GetRowY(FldN2) + Hand div 2;
      LnkY := 1;
    end
    else
    begin //N
      Y2 := Tbl1.GetRowY(FldN1) + Hand div 2;
      Y1 := Tbl2.GetRowY(FldN2) - Hand div 2;
      LnkY := 2;
    end;
    SetBounds(X1, Y1, X2 - X1, Y2 - Y1);
  end;
end;

procedure TRMQBArea.ReboundLinks4Table(ATable: TRMQBTable);
var
  i: integer;
  Link: TRMQBLink;
begin
  for i := 0 to ControlCount - 1 do
  begin
    if Controls[i] is TRMQBLink then
    begin
      Link := TRMQBLink(Controls[i]);
      if (Link.Tbl1 = ATable) or (Link.Tbl2 = ATable) then
        ReboundLink(Link);
    end;
  end;
end;

procedure TRMQBArea.Unlink(Sender: TObject);
var
  Link: TRMQBLink;
begin
  if TPopupMenu(Sender).Owner is TRMQBLink then
  begin
    Link := TRMQBLink(TPopupMenu(Sender).Owner);
    RemoveControl(Link);
    if not FindOtherLink(Link, Link.tbl1, Link.fldN1) then
    begin
      Link.tbl1.FLbx.Checked[Link.fldN1] := FALSE;
    end;
    if not FindOtherLink(Link, Link.tbl2, Link.fldN2) then
    begin
      Link.tbl2.FLbx.Checked[Link.fldN2] := FALSE;
    end;
    Link.Free;
  end;
end;

procedure TRMQBArea.UnlinkTable(ATable: TRMQBTable);
var
  i: integer;
  TempLink: TRMQBLink;
begin
  for i := ControlCount - 1 downto 0 do
  begin
    if Controls[i] is TRMQBLink then
    begin
      TempLink := TRMQBLink(Controls[i]);
      if (TempLink.Tbl1 = ATable) or (TempLink.Tbl2 = ATable) then
      begin
        RemoveControl(TempLink);
        if not FindOtherLink(TempLink, TempLink.tbl1, TempLink.fldN1) then
        begin
          TempLink.tbl1.FLbx.Checked[TempLink.fldN1] := FALSE;
        end;
        if not FindOtherLink(TempLink, TempLink.tbl2, TempLink.fldN2) then
        begin
          TempLink.tbl2.FLbx.Checked[TempLink.fldN2] := FALSE;
        end;
        TempLink.Free;
      end;
    end;
  end;
end;

procedure TRMQBArea._DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if (Source = FForm.lsbTables) then
    Accept := true;
end;

procedure TRMQBArea._DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if not (Sender is TRMQBArea) then
  begin
    X := X + TControl(Sender).Left;
    Y := Y + TControl(Sender).Top;
  end;
  if Source = FForm.lsbTables then
    InsertTable(X, Y);
end;

type
  THackRMDQuery = class(TRMDQuery)
  end;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  {TRMQueryPropForm}

procedure TRMDQueryDesignerForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  //  Caption := FQuery.DataSet.Name + ' ' + RMLoadStr(SParams);
  RMSetStrProp(TabSheetFields, 'Caption', rmRes + 3080);
  RMSetStrProp(TabSheetCalc, 'Caption', rmRes + 3081);
  RMSetStrProp(TabSheetGroup, 'Caption', rmRes + 3082);
  RMSetStrProp(TabSheetSort, 'Caption', rmRes + 3083);
  RMSetStrProp(Label7, 'Caption', rmRes + 3084);
  RMSetStrProp(FieldsB, 'Caption', rmRes + 3085);
  RMSetStrProp(ParamsB, 'Caption', rmRes + 3086);
  RMSetStrProp(btnNew, 'Hint', rmRes + 3087);
  RMSetStrProp(btnLoadFromFile, 'Hint', rmRes + 3088);
  RMSetStrProp(btnSaveToFile, 'Hint', rmRes + 3089);
  RMSetStrProp(lsvSortRight.Columns[0], 'Caption', rmRes + 3090);
  RMSetStrProp(lsvSortRight.Columns[1], 'Caption', rmRes + 3091);
  RMSetStrProp(OpenDialog1, 'Filter', rmRes + 3092);