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

📄 dblookupeh.pas

📁 考勤管理是企业内部管理的重要环节和基础
💻 PAS
📖 第 1 页 / 共 4 页
字号:
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;

function AlignDropDownWindow(MasterWin,DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
var P: TPoint;
    Y: Integer;
    WorkArea: TRect;
begin
  P := MasterWin.Parent.ClientToScreen(Point(MasterWin.Left, MasterWin.Top));
  Y := P.Y + MasterWin.Height;
  SystemParametersInfo(SPI_GETWORKAREA,0,Pointer(@WorkArea),0);

  if ((Y + DropDownWin.Height > WorkArea.Bottom) and (P.Y - DropDownWin.Height >= WorkArea.Top)) or
     ((P.Y - DropDownWin.Height < WorkArea.Top) and (WorkArea.Bottom - Y < P.Y - WorkArea.Top))
    then
  begin
    if P.Y - DropDownWin.Height < WorkArea.Top then
      DropDownWin.Height := P.Y - WorkArea.Top;
    Y := P.Y - DropDownWin.Height;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToTop),0);
  end else
  begin
    if Y + DropDownWin.Height > WorkArea.Bottom then
      DropDownWin.Height := WorkArea.Bottom - Y;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToBottom),0);
  end;

  case Align of
    daRight: Dec(P.X, DropDownWin.Width - MasterWin.Width);
    daCenter: Dec(P.X, (DropDownWin.Width - MasterWin.Width) div 2);
  end;

  if (DropDownWin.Width > WorkArea.Right - WorkArea.Left) then
    DropDownWin.Width := WorkArea.Right - WorkArea.Left;
  if (P.X + DropDownWin.Width > WorkArea.Right) then
  begin
    P.X := WorkArea.Right - DropDownWin.Width;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0);
  end
  else if P.X < 0 then
  begin
    P.X := 0;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);
  end else if Align = daRight then
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0)
  else
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);

  Result := Point(P.X,Y);
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.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;
    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);
    FDroppedDown := False;
    inherited CloseUp(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 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]) 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 = 17) 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

⌨️ 快捷键说明

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