📄 dblookupeh.pas
字号:
type
TWinControlCracker = class(TWinControl) end;
procedure TCustomDBLookupComboboxEh.SetListSource(Value: TDataSource);
begin
CheckNotLookup;
//FListLink.DataSource := Value;
FListSource := Value;
UpdateListLinkDataSource;
if csDesigning in ComponentState then //for columns editor
begin
FDataList.ListSource := Value;
if Value <> nil then
{$IFDEF CIL}
SendNotification(Value, FDataList, opRemove);
{$ELSE}
TWinControlCracker(Value).Notification(FDataList, opRemove);
{$ENDIF}
//Value.RemoveFreeNotification(FDataList);
end;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TCustomDBLookupComboboxEh.SetLookupMode(Value: Boolean);
begin
if FLookupMode <> Value then
if Value then
begin
FMasterFields := GetFieldsProperty(FDataFields[0].DataSet, Self, FDataFields[0].KeyFields);
FLookupSource.DataSet := FDataFields[0].LookupDataSet;
FKeyFieldName := FDataFields[0].LookupKeyFields;
FLookupMode := True;
// FListLink.DataSource := FLookupSource;
FListLink.DataSource := UsedListSource;
if csDesigning in ComponentState then //for columns editor
FDataList.ListSource := FLookupSource;
end else
begin
FListLink.DataSource := nil;
if csDesigning in ComponentState then //for columns editor
FDataList.ListSource := nil;
FLookupMode := False;
FKeyFieldName := '';
FLookupSource.DataSet := nil;
FMasterFields := FDataFields;
end;
end;
procedure TCustomDBLookupComboboxEh.WMKillFocus(var Message: TWMKillFocus);
begin
if FListVisible and not (Message.FocusedWnd = FDataList.Handle) then
CloseUp(False);
inherited;
end;
{procedure TCustomDBLookupComboboxEh.ListMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
CloseUp(PtInRect(FDataList.ClientRect, Point(X, Y)));
end;}
procedure TCustomDBLookupComboboxEh.ListMouseCloseUp(Sender: TObject; Accept: Boolean);
begin
CloseUp(Accept);
end;
procedure TCustomDBLookupComboboxEh.DropDown;
var
P: TPoint;
I: Integer;
S: String;
ADropDownAlign: TDropDownAlign;
begin
if not FListVisible and ListActive then
begin
if not FFocused then SetFocus;
if Assigned(FOnDropDown) then FOnDropDown(Self);
FDataList.KeyValue := Null;
FDataList.SpecRow := DropDownBox.SpecRow;
FDataList.Color := Color;
FDataList.Font := Font;
FDataList.ShowTitles := FDropDownBox.ShowTitles;
FDataList.UseMultiTitle := FDropDownBox.UseMultiTitle;
FDataList.ReadOnly := not CanModify(False);
if ListLink.DataSet.IsSequenced and
(ListLink.DataSet.RecordCount > 0) and
(FDropDownBox.Rows > ListLink.DataSet.RecordCount) then
FDataList.RowCount := ListLink.DataSet.RecordCount else
FDataList.RowCount := FDropDownBox.Rows;
FDataList.KeyField := FKeyFieldName;
for I := 0 to ListFields.Count - 1 do
S := S + TField(ListFields[I]).FieldName + ';';
FDataList.ListField := S;
FDataList.ListFieldIndex := ListFields.IndexOf(FListField);
FDataList.AutoFitColWidths := False;
FDataList.ListSource := ListLink.DataSource;
if (FDropDownBox.Width = -1) then
FDataList.ClientWidth := FDataList.GetColumnsWidthToFit
else if FDropDownBox.Width > 0 then
FDataList.Width := FDropDownBox.Width
else
FDataList.Width := Width;
if (FDataList.Width < Width) then
FDataList.Width := Width;
//FDataList.Columns.State := csCustomized;
FDataList.AutoFitColWidths := FDropDownBox.AutoFitColWidths;
FDataList.KeyValue := KeyValue;
FDataList.ReadOnly := not CanModify(False);
FListColumnMothed := False;
DataList.OnColumnMoved := ListColumnMoved;
ADropDownAlign := FDropDownBox.Align;
{ This alignment is for the ListField, not the control }
if DBUseRightToLeftAlignment(Self, FListField) then
begin
if ADropDownAlign = daLeft then
ADropDownAlign := daRight
else if ADropDownAlign = daRight then
ADropDownAlign := daLeft;
end;
{case ADropDownAlign of
daRight: Dec(P.X, FDataList.Width - Width);
daCenter: Dec(P.X, (FDataList.Width - Width) div 2);
end;}
P := AlignDropDownWindow(Self, FDataList, ADropDownAlign);
SetWindowPos(FDataList.Handle, HWND_TOP {MOST}, P.X, P.Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FDataList.Visible := True; //???
FDataList.SizeGrip.Visible := FDropDownBox.Sizable;
FDataList.RowCount := FDataList.RowCount; //To update row count for horz scroll bar
// FDataList.UpdateScrollBar;
FListVisible := True;
Repaint;
FDataList.SizeGripResized := False;
inherited DropDown;
FDroppedDown := True;
end;
// else CloseUp(False);
end;
procedure TCustomDBLookupComboboxEh.CloseUp(Accept: Boolean);
var
ListValue: Variant;
begin
if FListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
//SetFocus;
ListValue := FDataList.KeyValue;
SetWindowPos(FDataList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FDataList.Visible := False; //???
FListVisible := False;
if FDataList.SizeGripResized then
begin
DropDownBox.Rows := FDataList.RowCount;
DropDownBox.Width := FDataList.Width;
end;
DataList.OnColumnMoved := nil;
FDataList.AutoFitColWidths := False;
FDataList.ListSource := nil;
if FListColumnMothed then
begin
if FDataList.Columns.State = csDefault then
begin
ListFieldIndex := FDataList.ListFieldIndex;
ListField := FDataList.ListField;
end;
DropDownBox.SpecRow.CellsText := FDataList.SpecRow.CellsText;
end;
Invalidate;
FDroppedDown := False;
inherited CloseUp(Accept);
if Accept and CanModify(True) then
begin
SetKeyValue(ListValue); //??? SelectKeyValue(ListValue);
if DropDownBox.SpecRow.Visible then
if DropDownBox.SpecRow.LocateKey(FKeyValue) or
(DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
then
SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex]);
SelectAll;
end;
if (Style = csDropDownEh) and HandleAllocated then SelectAll;
{else if FEditTextFromDataList then
begin
FEditTextFromDataList := False;
SetEditText(FEditTextOldValue);
SelectAll;
end};
if Assigned(FOnCloseUp) then FOnCloseUp(Self, Accept);
end;
end;
procedure TCustomDBLookupComboboxEh.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (Style = csDropDownListEh) then Windows.SetCursor(LoadCursor(0, idc_Arrow))
else inherited;
end;
function TCustomDBLookupComboboxEh.TraceMouseMoveForPopupListbox(Sender: TObject;
Shift: TShiftState; X, Y: Integer): Boolean;
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
Result := False;
if FListVisible and (GetCaptureControl = Sender) then
begin
ListPos := FDataList.ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y)));
if PtInRect(FDataList.DataRect, ListPos) then
begin
TControl(Sender).Perform(WM_CANCELMODE, 0, 0);
MousePos := PointToSmallPoint(ListPos);
SendMessage(FDataList.Handle, WM_LBUTTONDOWN, 0, SmallPointToInteger(MousePos));
Result := True;
end;
end;
end;
procedure TCustomDBLookupComboboxEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and (Style = csDropDownListEh) and not (ssDouble in Shift) and
not PtInRect(ButtonRect, Point(X, Y)) and ButtonEnabled and not FDroppedDown then
begin
FNoClickCloseUp := True;
DropDown;
end;
end;
procedure TCustomDBLookupComboboxEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if TraceMouseMoveForPopupListbox(Self, Shift, X, Y) then
Exit;
inherited MouseMove(Shift, X, Y);
end;
procedure TCustomDBLookupComboboxEh.EditButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FListVisible and (GetCaptureControl = Sender) and
(Sender = FEditButtonControlList[0].EditButtonControl) then
begin
ListPos := FDataList.ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y)));
if PtInRect(FDataList.DataRect, ListPos) then
begin
TControl(Sender).Perform(WM_CANCELMODE, 0, 0);
MousePos := PointToSmallPoint(ListPos);
SendMessage(FDataList.Handle, WM_LBUTTONDOWN, 0, SmallPointToInteger(MousePos));
end;
end;
end;
procedure TCustomDBLookupComboboxEh.Click;
begin
inherited Click;
if ButtonEnabled and FDroppedDown and not FNoClickCloseUp and
(Style = csDropDownListEh)
then CloseUp(False);
FNoClickCloseUp := False;
end;
procedure TCustomDBLookupComboboxEh.CMCancelMode(var Message: TCMCancelMode);
function CheckDataListChilds: Boolean;
var i: Integer;
begin
Result := False;
if FDataList <> nil then
for i := 0 to FDataList.ControlCount - 1 do
if FDataList.Controls[I] = Message.Sender then
begin
Result := True;
Exit;
end;
end;
begin
if (Message.Sender <> Self) and not ContainsControl(Message.Sender) and
(Message.Sender <> FDataList) and not CheckDataListChilds
{and (Message.Sender <> FEditSpeedButton)}then
CloseUp(False);
end;
procedure TCustomDBLookupComboboxEh.InternalSetText(AText: String);
begin
if FKeyTextIndependent then
SetEditText(AText)
else
begin
if Style = csDropDownEh then SetEditText(AText);
LocateStr(AText, False);
end;
end;
procedure TCustomDBLookupComboboxEh.InternalSetValue(AValue: Variant);
begin
SetKeyValue(AValue);
end;
procedure TCustomDBLookupComboboxEh.SetEditText(Value: String);
begin
FInternalTextSetting := True;
try
inherited InternalSetText(Value);
finally
FInternalTextSetting := False;
end;
end;
procedure TCustomDBLookupComboboxEh.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin
if (Message.CharCode in [VK_RETURN, VK_ESCAPE]) and FListVisible then
begin
//CloseUp(Message.CharCode = VK_RETURN);
Message.Result := 1;
end else
inherited;
end;
//type
// TDBLookupListBoxCra cker = class(TDBLookupGridEh) end;
procedure TCustomDBLookupComboboxEh.KeyDown(var Key: Word; Shift: TShiftState);
function MasterFieldsRequired: Boolean;
var i: Integer;
begin
Result := False;
for i := 0 to Length(FMasterFields) - 1 do
if FMasterFields[i].Required then
begin
Result := True;
Exit;
end;
end;
begin
inherited KeyDown(Key, Shift);
if ListActive and DropDownBox.SpecRow.Visible and
(DropDownBox.SpecRow.ShortCut = ShortCut(Key, Shift)) then
begin
SetKeyValue(DropDownBox.SpecRow.Value);
SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex]);
SelectAll;
Key := 0;
end;
if ListActive and ((Key = VK_UP) or (Key = VK_DOWN)) then
{if ssAlt in Shift then
begin
if FListVisible then CloseUp(True) else DropDown;
Key := 0;
end else}
if CanModify(True) then
if not FListVisible then
begin
SelectNextValue(Key = VK_UP);
Key := 0;
end;
if (Key <> 0) and FListVisible and ((Key in [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_CONTROL]) or
((Key in [VK_HOME, VK_END]) and (ssCtrl in Shift))) then
begin
FDataList.KeyDown(Key, Shift);
Key := 0;
end;
if (Key = VK_DELETE) and (Style = csDropDownListEh) and CanModify(True) then
begin
if (SelLength = Length(Text)) and (Length(FMasterFields) > 0) or not MasterFieldsRequired then
begin
SetKeyValue(Null);
SetEditText('');
end;
Key := 0;
end;
end;
procedure TCustomDBLookupComboboxEh.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited KeyUp(Key, Shift);
if FListVisible and (Key = VK_CONTROL) then
FDataList.KeyUp(Key, Shift);
end;
procedure TCustomDBLookupComboboxEh.KeyPress(var Key: Char);
begin
if FListVisible and (Key in [#13, #27]) then
begin
CloseUp(Key = #13);
Key := #0;
end;
inherited KeyPress(Key);
case Key of
#8:
if (Style = csDropDownListEh) then
begin
ProcessSearchStr(Key);
Key := #0;
end;
{#13:
begin
Key := #0;
FDataLink.UpdateRecord;
SelectAll;
end;}
#32..#255:
begin
if DropDownBox.AutoDrop and not FListVisible and FListActive then DropDown;
if (Style = csDropDownListEh) then
begin
ProcessSearchStr(GetCompleteKeyPress);
Key := #0;
end;
end;
end;
end;
procedure TCustomDBLookupComboboxEh.DataListKeyValueChanged(Sender: TObject);
begin
end;
procedure TCustomDBLookupComboboxEh.DefaultHandler(var Message);
var
Msg: TMessage;
begin
VarToMessage(Message, Msg);
{$IFDEF CIL}
with TWMMouse.Create(Msg) do
{$ELSE}
with TWMMouse(Message) do
{$ENDIF}
case Msg of
WM_LBUTTONDBLCLK, WM_LBUTTONDOWN, WM_LBUTTONUP,
WM_MBUTTONDBLCLK, WM_MBUTTONDOWN, WM_MBUTTONUP,
WM_RBUTTONDBLCLK, WM_RBUTTONDOWN, WM_RBUTTONUP:
if (Style = csDropDownListEh) or PtInRect(ButtonRect, Point(XPos, YPos)) then
begin
if Msg = WM_RBUTTONUP then
Perform(WM_CONTEXTMENU, Handle,
SmallPointToInteger(PointToSmallPoint(ClientToScreen(Point(XPos, YPos))))
);
Exit;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -