📄 rmd_qrydesigner.pas
字号:
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 + -