tntjvdblookup.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

  begin
    FSearchText := '';
    if not FPopup then
    begin
      if CanFocus then
        SetFocus;
      if not FFocused then
        Exit;
    end;
    if CanModify then
      if ssDouble in Shift then
      begin
        if FRecordIndex = Y div GetTextHeight then
          DblClick;
      end
      else
      begin
        MouseCapture := True;
        FTracking := True;
        SelectItemAt(X, Y);
      end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TTntJvDBLookupList.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 TTntJvDBLookupList.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FTracking then
  begin
    StopTracking;
    SelectItemAt(X, Y);
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TTntJvDBLookupList.DrawItemText(Canvas: TCanvas; Rect: TRect;
  Selected, IsEmpty: Boolean);
var
  J, W, X, ATop, TextWidth, LastFieldIndex: Integer;
  S: WideString;
  Field: TField;
  R: TRect;
  AAlignment: TAlignment;
begin
  TextWidth := Canvas.TextWidth('M');
  LastFieldIndex := FListFields.Count - 1;
  R := Rect;
  R.Right := R.Left;
  S := '';
  ATop := (R.Bottom + R.Top - Canvas.TextHeight('Xy')) div 2;
  if FListStyle = lsFixed then
    for J := 0 to LastFieldIndex do
    begin
      Field := FListFields[J];
      if J < LastFieldIndex then
        W := Field.DisplayWidth * TextWidth + 4
      else
        W := ClientWidth - R.Right;
      if IsEmpty then
      begin
        if J = 0 then
        begin
          S := DisplayEmpty;
        end
        else
          S := '';
      end
      else
        S := GetWideDisplayText(Field);
      X := 2;
      AAlignment := Field.Alignment;
      if UseRightToLeftAlignment then
        ChangeBiDiModeAlignment(AAlignment);
      case AAlignment of
        taRightJustify:
          X := W - WideCanvasTextWidth(Canvas, S) - 3;
        taCenter:
          X := (W - WideCanvasTextWidth(Canvas, S)) div 2;
      end;
      R.Left := R.Right;
      R.Right := R.Right + W;
      if SysLocale.MiddleEast and UseRightToLeftReading then
        Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
      else
        Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
      WideCanvasTextRect(Canvas, R, R.Left + X, ATop, 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
  else
    if not IsEmpty then
      S := DoFormatLine;
  if FListStyle = lsDelimited then
  begin
    if IsEmpty then
      S := DisplayEmpty;
    R.Left := Rect.Left;
    R.Right := Rect.Right;
    if SysLocale.MiddleEast and UseRightToLeftReading then
      Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
    else
      Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
    WideCanvasTextRect(Canvas, R, R.Left + 2, ATop, S);
  end;
end;

procedure TTntJvDBLookupList.Paint;
var
  I, J, TextHeight, TextMargin: Integer;
  Image: TGraphic;
  Bmp: TBitmap;
  R, ImageRect: TRect;
  Selected: Boolean;
begin
  Bmp := TBitmap.Create;
  try
    Canvas.Font := Font;
    TextHeight := GetTextHeight;
    if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
      Canvas.Pen.Color := clBtnFace
    else
      Canvas.Pen.Color := clBtnShadow;
    for I := 0 to FRowCount - 1 do
    begin
      J := I - Ord(EmptyRowVisible);
      Canvas.Font.Color := Font.Color;
      Canvas.Brush.Color := Color;
      Selected := not FKeySelected and (I = 0) and not EmptyRowVisible;
      R.Top := I * TextHeight;
      R.Bottom := R.Top + TextHeight;
      if I < FRecordCount + Ord(EmptyRowVisible) then
      begin
        if (I = 0) and (J = -1) then
        begin
          if ValueIsEmpty(FValue) then
          begin
            Canvas.Font.Color := clHighlightText;
            Canvas.Brush.Color := clHighlight;
            Selected := True;
          end
          else
            Canvas.Brush.Color := EmptyItemColor;
          R.Left := 0;
          R.Right := ClientWidth;
          Image := GetPicture(False, True, TextMargin);
          if TextMargin > 0 then
          begin
            with Bmp do
            begin
              Canvas.Font := Self.Canvas.Font;
              Canvas.Brush := Self.Canvas.Brush;
              Canvas.Pen := Self.Canvas.Pen;
              Width := RectWidth(R);
              Height := RectHeight(R);
            end;
            ImageRect := Bounds(0, 0, TextMargin, RectHeight(R));
            Bmp.Canvas.FillRect(ImageRect);
            if Image <> nil then
              DrawPicture(Bmp.Canvas, ImageRect, Image);
            DrawItemText(Bmp.Canvas, Bounds(TextMargin, 0, RectWidth(R) - TextMargin,
              RectHeight(R)), Selected, True);
            Canvas.Draw(R.Left, R.Top, Bmp);
          end
          else
            DrawItemText(Canvas, R, Selected, True);
        end
        else
        begin
          FLookupLink.ActiveRecord := J;
          if not ValueIsEmpty(FValue) and (GetAsWideString(FKeyField) = FValue) then
          begin
            Canvas.Font.Color := clHighlightText;
            Canvas.Brush.Color := clHighlight;
            Selected := True;
          end;
          R.Left := 0;
          R.Right := ClientWidth;
          Image := GetPicture(False, False, TextMargin);
          if TextMargin > 0 then
          begin
            with Bmp do
            begin
              Canvas.Font := Self.Canvas.Font;
              Canvas.Brush := Self.Canvas.Brush;
              Canvas.Pen := Self.Canvas.Pen;
              Width := RectWidth(R);
              Height := RectHeight(R);
            end;
            ImageRect := Bounds(0, 0, TextMargin, RectHeight(R));
            Bmp.Canvas.FillRect(ImageRect);
            if Image <> nil then
              DrawPicture(Bmp.Canvas, ImageRect, Image);
            DrawItemText(Bmp.Canvas, Bounds(TextMargin, 0, RectWidth(R) - TextMargin,
              RectHeight(R)), Selected, False);
            Canvas.Draw(R.Left, R.Top, Bmp);
          end
          else
            DrawItemText(Canvas, R, Selected, False);
        end;
      end;
      R.Left := 0;
      R.Right := ClientWidth;
      if J >= FRecordCount then
        Canvas.FillRect(R);
      if Selected and (FFocused or FPopup) then
        Canvas.DrawFocusRect(R);
    end;
  finally
    Bmp.Free;
  end;
  if FRecordCount <> 0 then
    FLookupLink.ActiveRecord := FRecordIndex;
end;

procedure TTntJvDBLookupList.SelectCurrent;
begin
  FLockPosition := True;
  try
    if FSelectEmpty then
      ResetField
    else
      SelectKeyValue(GetAsWideString(FKeyField));
  finally
    FSelectEmpty := False;
    FLockPosition := False;
  end;
end;

procedure TTntJvDBLookupList.SelectItemAt(X, Y: Integer);
var
  Delta: Integer;
begin
  if Y < 0 then
    Y := 0;
  if Y >= ClientHeight then
    Y := ClientHeight - 1;
  Delta := Y div GetTextHeight;
  if (Delta = 0) and EmptyRowVisible then
    FSelectEmpty := True
  else
  begin
    Delta := Delta - FRecordIndex;
    if EmptyRowVisible then
      Dec(Delta);
    FLookupLink.DataSet.MoveBy(Delta);
  end;
  SelectCurrent;
end;

procedure TTntJvDBLookupList.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
    if not (csReading in ComponentState) then
    begin
      Height := Height;
      RowCount := RowCount;
    end;
  end;
end;

procedure TTntJvDBLookupList.UpdateDisplayEmpty(const Value: WideString);
begin
  UpdateBufferCount(RowCount - Ord(Value <> ''));
end;

procedure TTntJvDBLookupList.UpdateBufferCount(Rows: Integer);
begin
  if FLookupLink.BufferCount <> Rows then
  begin
    FLookupLink.BufferCount := Rows;
    ListLinkDataChanged;
  end;
end;

procedure TTntJvDBLookupList.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  BorderSize, TextHeight, Rows: Integer;
begin
  BorderSize := GetBorderSize;
  TextHeight := GetTextHeight;
  Rows := (AHeight - BorderSize) div TextHeight;
  if Rows < 1 then
    Rows := 1;
  FRowCount := Rows;
  UpdateBufferCount(Rows - Ord(EmptyRowVisible));
  if not (csReading in ComponentState) then
    AHeight := Rows * TextHeight + BorderSize;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TTntJvDBLookupList.SetRowCount(Value: Integer);
begin
  if Value < 1 then
    Value := 1;
  if Value > 50 then
    Value := 50;
  Height := Value * GetTextHeight + GetBorderSize;
end;

procedure TTntJvDBLookupList.StopTimer;
begin
  if FTimerActive then
  begin
    // (rom) why not a TTimer?
    KillTimer(Handle, 1);
    FTimerActive := False;
  end;
end;

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

procedure TTntJvDBLookupList.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 FLookupLink.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 TTntJvDBLookupList.UpdateScrollBar;
var
  Pos, Max: Integer;
  ScrollInfo: TScrollInfo;
begin
  Pos := 0;
  Max := 0;

  { Note: If used by JvDBLookupCombo:

    FRowCount    = JvDBLookupCombo.DropDownCount
    FRecordCount = #records in link buffer (<> #records in table)
  }
  { Check whether the list is completely filled.. }
  if (FRecordCount >= (FRowCount - Ord(EmptyRowVisible))) and FLookupLink.Active then
  begin
    { ..if so, display a scrollbar }
    Max := 4;
    if not FLookupLink.DataSet.Bof then
      if not FLookupLink.DataSet.Eof then
        Pos := 2
      else
        Pos := 4;
  end;
  ScrollInfo.cbSize := SizeOf(TScrollInfo);
  ScrollInfo.fMask := SIF_POS or SIF_RANGE;
  if not GetScrollInfo(Handle, SB_VERT, ScrollInfo) or
    (ScrollInfo.nPos <> Pos) or (ScrollInfo.nMax <> Max) then
  begin
    ScrollInfo.nMin := 0;
    ScrollInfo.nMax := Max;
    ScrollInfo.nPos := Pos;
    SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
  end;
end;

procedure TTntJvDBLookupList.CMCtl3DChanged(var Msg: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
  begin
    RecreateWnd;
    if not (csReading in ComponentState) then
      RowCount := RowCount;
  end;
  inherited;
end;

procedure TTntJvDBLookupList.FontChanged;
begin
  inherited FontChanged;
  if not (csReading in ComponentState) then
    Height := Height;
end;

procedure TTntJvDBLookupList.WMCancelMode(var Msg: TMessage);
begin
  StopTracking;
  inherited;
end;

procedure TTntJvDBLookupList.WMTimer(var Msg: TMessage);
begin
  TimerScroll;
end;

procedure TTntJvDBLookupList.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  if csDesigning in ComponentState then