dxbarextdbitems.pas

胜天进销存源码,国产优秀的进销存

  if ListLink.BufferCount <> Rows then
  begin
    ListLink.BufferCount := Rows;
    ListLinkDataChanged;
  end;
end;

procedure TdxBarPopupLookupControl.WMTimer(var Message: TMessage);
begin
  TimerScroll;
end;

procedure TdxBarPopupLookupControl.WMVScroll(var Message: TWMVScroll);
var
  SI: TScrollInfo;
begin
  with Message, ListLink.DataSet do
    case ScrollCode of
      SB_LINEUP: MoveBy(-FRecordIndex - 1);
      SB_LINEDOWN: MoveBy(FRecordCount - FRecordIndex);
      SB_PAGEUP: MoveBy(-FRecordIndex - FRecordCount + 1);
      SB_PAGEDOWN: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
      SB_THUMBPOSITION:
        if IsSequenced then
        begin
          SI.cbSize := sizeof(SI);
          SI.fMask := SIF_ALL;
          GetScrollInfo(Self.Handle, SB_VERT, SI);
          if SI.nTrackPos <= 1 then First
          else if SI.nTrackPos >= RecordCount then Last
          else RecNo := SI.nTrackPos;
        end
        else
          case Pos of
            0: First;
            1: MoveBy(-FRecordIndex - FRecordCount + 1);
            2: Exit;
            3: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
            4: Last;
          end;
      SB_BOTTOM: Last;
      SB_TOP: First;
    end;
end;

procedure TdxBarPopupLookupControl.WMWindowPosChanging(var Message : TWMWINDOWPOSCHANGING);
var
  BorderSize, TextHeight, Rows, AHeight: Integer;
begin
  if IsPopup then
  begin
    BorderSize := 2 + Byte(FCombo.AllowResizing) * dxDropDownNCHeight;
    TextHeight := GetTextHeight;
    with Message.WindowPos^ do
      AHeight := cy;
    Rows := (AHeight - BorderSize) div TextHeight;
    if Rows < 1 then Rows := 1;
    with Message.WindowPos^ do
      if ComboTop < y + cy then
        cy :=  Rows * TextHeight + BorderSize
      else
      if (AHeight <> 0) then begin
        cy := Rows * TextHeight + BorderSize;
        y := y + AHeight - cy;
      end;
  end;
  inherited;
end;

procedure TdxBarPopupLookupControl.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FMouseAboveCloseButton then
  begin
    FMouseAboveCloseButton := False;
    if HandleAllocated then SendMessage(Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TdxBarPopupLookupControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    if IsPopup then
      ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST
    else
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;

procedure TdxBarPopupLookupControl.CreateWnd;
begin
  inherited CreateWnd;
  if IsPopup then
  begin
    Windows.SetParent(Handle, 0);
    CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
    FHScrollWidth := GetSystemMetrics(SM_CYHSCROLL);
    FVScrollWidth := GetSystemMetrics(SM_CXVSCROLL);
    FCloseBtnDown := False;
    FCloseBtnPaint := False;
  end;
  UpdateScrollBar;
end;

procedure TdxBarPopupLookupControl.DblClick;
begin
  inherited;
  if not IsPopup then
    FCombo.FForm.ModalResult := mrOk;
end;

procedure TdxBarPopupLookupControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if (FListLink <> nil) and (AComponent = ListSource) then ListSource := nil;
end;

procedure TdxBarPopupLookupControl.KeyDown(var Key: Word; Shift: TShiftState);
var
  Delta: Integer;
begin
  inherited KeyDown(Key, Shift);
  if not FListActive then Exit;
  Delta := 0;
  case Key of
    VK_UP, VK_LEFT: Delta := -1;
    VK_DOWN, VK_RIGHT: Delta := 1;
    VK_PRIOR: Delta := 1 - FRowCount;
    VK_NEXT: Delta := FRowCount - 1;
    VK_HOME: Delta := -Maxint;
    VK_END: Delta := Maxint;
  end;
  if Delta <> 0 then
  begin
    if Delta = -Maxint then
      ListLink.DataSet.First
    else
      if Delta = Maxint then
        ListLink.DataSet.Last
      else
        ListLink.DataSet.MoveBy(Delta);
    SelectCurrent;
  end;
end;

procedure TdxBarPopupLookupControl.ListLinkDataChanged;
begin
  if FListActive then
  begin
    FRecordIndex := ListLink.ActiveRecord;
    FRecordCount := ListLink.RecordCount;
  end else
  begin
    FRecordIndex := 0;
    FRecordCount := 0;
  end;
  if HandleAllocated then
  begin
    UpdateScrollBar;
    Invalidate;
  end;
end;

procedure TdxBarPopupLookupControl.MouseDown(Button: TMouseButton; Shift: TShiftState;  X, Y: Integer);
begin
  if (Button = mbLeft) and
    Assigned(ListLink.DataSet) {and ListLink.DataSet.CanModify} then
    if ssDouble in Shift then
      if FRecordIndex = Y div GetTextHeight then
        DblClick
      else
    else
    begin
      MouseCapture := True;
      FTracking := True;
      SelectItemAt(X, Y);
    end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TdxBarPopupLookupControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FTracking then
  begin
    SelectItemAt(X, Y);
    FMousePos := Y;
    TimerScroll;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TdxBarPopupLookupControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FTracking then
  begin
    StopTracking;
    SelectItemAt(X, Y);
    if (FCombo <> nil) and ListLink.Active and IsPopup then
    begin
      if Y < 0 then Y := 0;
      if Y >= ClientHeight then Y := ClientHeight - 1;
      Y := Y div GetTextHeight;
      if Y >= ListLink.RecordCount then Exit;
      with FCombo do
        try
          if FKeyField <> nil then FKeyValue := FKeyField.Value;
          KeyValueChanged;
        finally
          if (CurItemLink <> nil) and (CurItemLink.RealItemLink <> nil) then
            CurItemLink.RealItemLink.BringToTopInRecentList(True);
          try
            BarManager.HideAll;
          except
          end;
        end;
    end;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TdxBarPopupLookupControl.Paint;
var
  I, J, W, X, TextWidth, TextHeight, LastFieldIndex, SelectedRecord: Integer;
  Selected : Boolean;
  S: string;
  R: TRect;
  Field: TField;
  AAlignment: TAlignment;
begin
  if not FListActive then
  begin
    Canvas.FillRect(ClientRect);
    Exit;
  end;

  Canvas.Font := Font;
  TextWidth := Canvas.TextWidth('0');
  TextHeight := Canvas.TextHeight('0');
  LastFieldIndex := ListFields.Count - 1;
  if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
    Canvas.Pen.Color := clBtnFace else
    Canvas.Pen.Color := clBtnShadow;
  SelectedRecord := ListLink.ActiveRecord;
  for I := 0 to FRowCount - 1 do
  begin
    Canvas.Font.Color := Font.Color;
    Canvas.Brush.Color := Color;
    R.Top := I * TextHeight;
    R.Bottom := R.Top + TextHeight;
    Selected := False;
    if I < FRecordCount then
    begin
      ListLink.ActiveRecord := I;
      if (SelectedRecord = I) then
      begin
        Canvas.Font.Color := clHighlightText;
        Canvas.Brush.Color := clHighlight;
        Selected := True;
      end;
      R.Right := 0;
      for J := 0 to LastFieldIndex do
      begin
        Field := ListFields[J];
        if J < LastFieldIndex then
          W := Field.DisplayWidth * TextWidth + 4 else
          W := ClientWidth - R.Right;
        S := Field.DisplayText;
        X := 2;
        AAlignment := Field.Alignment;
        case AAlignment of
          taRightJustify: X := W - Canvas.TextWidth(S) - 3;
          taCenter: X := (W - Canvas.TextWidth(S)) div 2;
        end;
        R.Left := R.Right;
        R.Right := R.Right + W;
        Canvas.TextRect(R, R.Left + X, R.Top, S);
        if J < LastFieldIndex then
        begin
          Canvas.MoveTo(R.Right, R.Top);
          Canvas.LineTo(R.Right, R.Bottom);
          Inc(R.Right);
          if R.Right >= ClientWidth then Break;
        end;
      end;
    end;
    R.Left := 0;
    R.Right := ClientWidth;
    if I >= FRecordCount then Canvas.FillRect(R);
    if Selected then
      Canvas.DrawFocusRect(R);
  end;
  R.Top := R.Bottom;
  R.Bottom := ClientHeight;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(R);
  if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
end;

function TdxBarPopupLookupControl.GetTextHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;
end;

procedure TdxBarPopupLookupControl.UpdateListFields;
var
  DataSet: TDataSet;
begin
  FListField := nil;
  FListFields.Clear;
  FListActive := False;
  if FListLink.Active then
  begin
    DataSet := FListLink.DataSet;
    try
      DataSet.GetFieldList(FListFields, FListFieldName);
    except
      raise;
    end;
    if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then
      FListField := FListFields[FListFieldIndex]
    else
      if (FListFields.Count > 0) then
        FListField := FListFields[0];
    FListActive := FListField <> nil;
  end;
end;

function TdxBarPopupLookupControl.GetListSource: TDataSource;
begin
  Result := FListLink.DataSource;
end;

function TdxBarPopupLookupControl.GetPainter: TdxBarPainter;
begin
  if IsPopup then
    Result := FCombo.CurItemLink.Control.Painter
  else
    Result := FCombo.BarManager.DefaultPainter;
end;

procedure TdxBarPopupLookupControl.SetListFieldName(const Value: string);
begin
  if FListFieldName <> Value then
  begin
    FListFieldName := Value;
    UpdateListFields;
  end;
end;

procedure TdxBarPopupLookupControl.SetListSource(Value: TDataSource);
begin
  FListLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TdxBarPopupLookupControl.SelectCurrent;
begin
  if FCombo <> nil then
  begin
    FCombo.EditText := FListField.DisplayText;
    FCombo.ResetFindStr;
    SendMessage(FCombo.GetEditHandle, EM_SETSEL, 0, Length(FCombo.EditText));
  end;
end;

procedure TdxBarPopupLookupControl.SelectItemAt(X, Y: Integer);
var
  Delta: Integer;
begin
  if not FCombo.FListActive then Exit;
  if Y < 0 then Y := 0;
  if Y >= ClientHeight then Y := ClientHeight - 1;
  Delta := Y div GetTextHeight - FRecordIndex;
  ListLink.DataSet.MoveBy(Delta);
  SelectCurrent;
end;

procedure TdxBarPopupLookupControl.SetRowCount(Value: Integer);
begin
  if Value < 1 then Value := 1;
  if Value > 100 then Value := 100;
  Height := Value * GetTextHeight + 2 +
    Byte(IsPopup and FCombo.AllowResizing) * dxDropDownNCHeight;
end;

procedure TdxBarPopupLookupControl.StopTimer;
begin
  if FTimerActive then
  begin
    KillTimer(Handle, 1);
    FTimerActive := False;
  end;
end;

procedure TdxBarPopupLookupControl.StopTracking;
begin
  if FTracking then
  begin
    StopTimer;
    FTracking := False;
    MouseCapture := False;
  end;
end;

procedure TdxBarPopupLookupControl.TimerScroll;
var
  Delta, Distance, Interval: Integer;
begin
  Delta := 0;
  Distance := 0;
  if FMousePos < 0 then
  begin
    Delta := -1;
    Distance := -FMousePos;
  end;
  if FMousePos >= ClientHeight then
  begin
    Delta := 1;
    Distance := FMousePos - ClientHeight + 1;
  end;
  if Delta = 0 then StopTimer else
  begin
    if ListLink.DataSet.MoveBy(Delta) <> 0 then SelectCurrent;
    Interval := 200 - Distance * 15;
    if Interval < 0 then Interval := 0;
    SetTimer(Handle, 1, Interval, nil);
    FTimerActive := True;
  end;
end;

procedure TdxBarPopupLookupControl.UpdateScrollBar;
var
  SIOld, SINew: TScrollInfo;
begin
  if FListLink.Active and HandleAllocated then
    with ListLink.DataSet do
    begin
      SIOld.cbSize := sizeof(SIOld);
      SIOld.fMask := SIF_ALL;
      GetScrollInfo(Self.Handle, SB_VERT, SIOld);
      SINew := SIOld;
      if IsSequenced then
      begin
        SINew.nMin := 1;
        SINew.nPage := FRowCount;
        SINew.nMax := Integer(DWORD(RecordCount) + SINew.nPage - 1);
        if State in [dsInactive, dsBrowse, dsEdit] then
          SINew.nPos := RecNo;
      end
      else
      begin
        SINew.nMin := 0;
        SINew.nPage := 0;
        SINew.nMax := 4;
        if BOF then SINew.nPos := 0
        else if EOF then SINew.nPos := 4
        else SINew.nPos := 2;
      end;
      if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
        (SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
        SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
    end;
end;

initialization
  dxBarRegisterItem(TdxBarLookupCombo, TdxBarLookupComboControl, True);

end.