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

📄 dblookupeh.pas

📁 自己做的用delphi开发的学生成绩管理系统。
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  CheckNotLookup;
  //FListLink.DataSource := Value;
  FListSource := Value;
  UpdateListLinkDataSource;
  if csDesigning in ComponentState then //for columns editor
  begin
    FDataList.ListSource := Value;
    if Value <> nil then
      TWinControlCracker(Value).Notification(FDataList, opRemove);
      //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, Integer(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, Integer(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
  TDBLookupListBoxCracker = 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
    TDBLookupListBoxCracker(FDataList).KeyDown(Key, Shift);
    Key := 0;
  end;
  if (Key = VK_DELETE) and (Style = csDropDownListEh) 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
  if FListVisible and (Key = VK_CONTROL) then
    TWinControlCracker(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);
begin
  with TWMMouse(Message) do
    case Msg of
      WM_LBUTTONDBLCLK, WM_LBUTTONDOWN, WM_LBUTTONUP,

⌨️ 快捷键说明

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