aflookup.pas

来自「delphi编程控件」· PAS 代码 · 共 1,439 行 · 第 1/3 页

begin
  if (FListField <> nil) and (FListField.DataType = ftString) then
    case Key of
      #8, #27: FSearchText := '';
      #32..#255:
        begin
          TickCount := GetTickCount;
          if TickCount - SearchTickCount > 2000 then FSearchText := '';
          SearchTickCount := TickCount;
          if Length(FSearchText) < 32 then
          begin
            S := FSearchText + Key;

            if FListLink.DataSet.Locate(FListField.FieldName, S,
              [loCaseInsensitive, loPartialKey]) then
            begin
              SelectKeyValue(FKeyField.Value);
              FSearchText := S;
            end;
          end;
        end;
    end;
end;

procedure TAutoCustomLookup.SelectKeyValue(const Value: Variant);
begin
  SetKeyValue(Value);
  Repaint;
  Click;
end;

procedure TAutoCustomLookup.SetKeyFieldName(const Value: string);
begin
  if FKeyFieldName <> Value then
  begin
    FKeyFieldName := Value;
    ListLinkActiveChanged;
  end;
end;

procedure TAutoCustomLookup.SetItems(Value: TStrings);
begin
  Items.Assign(Value);
end;

procedure TAutoCustomLookup.SetItemIndex(Value : Integer);
begin
  if(Value >= Items.Count) then
    Value := -1;
  if(IsValueItems <> Value) then begin
     IsValueItems := Value;
     FKeyValue := GetItemsValue(Value);
     KeyValueChanged;
  end;
end;

procedure TAutoCustomLookup.SetItemsColor(Value: TColor);
begin
  FItemsColor := Value;
  Paint;
end;

procedure TAutoCustomLookup.SetKeyValue(const Value: Variant);
begin
  if not VarEquals(FKeyValue, Value) then
  begin
    FKeyValue := Value;
    KeyValueChanged;
  end;
end;

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

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

procedure TAutoCustomLookup.WMGetDlgCode(var Message: TMessage);
begin
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

procedure TAutoCustomLookup.WMKillFocus(var Message: TMessage);
begin
  FFocused := False;
  Invalidate;
end;

procedure TAutoCustomLookup.WMSetFocus(var Message: TMessage);
begin
  FFocused := True;
  Invalidate;
end;

{ TAutoCustomLookupList }

constructor TAutoCustomLookupList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 121;
  FBorderStyle := bsSingle;
  RowCount := 7;
end;

procedure TAutoCustomLookupList.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    if FBorderStyle = bsSingle then
      if NewStyleControls and Ctl3D then
        ExStyle := ExStyle or WS_EX_CLIENTEDGE
      else
        Style := Style or WS_BORDER;
end;

procedure TAutoCustomLookupList.CreateWnd;
begin
  inherited CreateWnd;
  UpdateScrollBar;
end;

function TAutoCustomLookupList.GetKeyIndex(Delta : Integer): Boolean;
var
  FieldValue: Variant;
  i : Integer;
begin
  Result := True;
  if not VarIsNull(FKeyValue) then begin
    if(IsValueItems >= 0) then begin
      KeyValue := GetItemsValue(IsValueItems);
      if(Delta < 0) then begin
        if(IsValueItems + Delta < 0) then
          IsValueItems := 0
        else IsValueItems := IsValueItems + Delta;
      end;
      if(Delta > 0) then begin
        if(IsValueItems + Delta >= Items.Count) then begin
          Delta := Delta - Items.Count + IsValueItems;
          FListLink.DataSet.First;
          FListLink.DataSet.MoveBy(Delta);
          IsValueItems := -1;          
          exit;
        end
        else IsValueItems := IsValueItems + Delta;
      end;
    end;
    if(IsValueItems >= 0) then exit;

    for i := 0 to FRecordCount - 1 do    begin
      FListLink.ActiveRecord := i;
      FieldValue := FKeyField.Value;
      FListLink.ActiveRecord := FRecordIndex;
      if VarEquals(FieldValue, FKeyValue) then break;
    end;
    if(i = FRecordCount) then begin
      Result := False;
      exit;
    end;
    if(Delta < 0) then begin
      FListLink.DataSet.Prior;
      if(FListLink.DataSet.BOF) And (FItems.Count > 0 )then begin
        IsValueItems := FItems.Count -1;
        KeyValue := GetItemsValue(IsValueItems);
        exit;
      end;  
    end;
    FListLink.DataSet.MoveBy(i - FRecordIndex + Delta);
  end;
end;

procedure TAutoCustomLookupList.KeyDown(var Key: Word; Shift: TShiftState);
Var
  Delta : Integer;
begin
  inherited KeyDown(Key, Shift);
  begin
    Delta := 0;
    case Key of
      VK_UP, VK_LEFT: Delta := -1;
      VK_DOWN, VK_RIGHT: Delta := 1;
      VK_PRIOR: Delta := 1 - FRealRowCount;
      VK_NEXT: Delta := FRealRowCount - 1;
      VK_HOME: Delta := -Maxint;
      VK_END: Delta := Maxint;
    end;
    if Delta <> 0 then
    begin
      FSearchText := '';
      if Delta = -Maxint then begin
        FListLink.DataSet.First;
        IsValueItems := -1;
      end
      else
        if Delta = Maxint then begin
          FListLink.DataSet.Last;
          IsValueItems := -1;
        end
        else begin
          if Not GetKeyIndex(Delta) then begin
            KeyValueChanged;
          end;
        end;
      SelectCurrent;
    end;
  end;
end;

procedure TAutoCustomLookupList.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  ProcessSearchKey(Key);
end;

procedure TAutoCustomLookupList.KeyValueChanged;
begin
  if FListActive and not FLockPosition then
    if not LocateKey then FListLink.DataSet.First;
end;

procedure TAutoCustomLookupList.ListLinkActiveChanged;
begin
  try
    inherited;
  finally
    if FListActive then KeyValueChanged else ListLinkDataChanged;
  end;
end;

procedure TAutoCustomLookupList.ListLinkDataChanged;
begin
  if FListActive then
  begin
    FRecordIndex := FListLink.ActiveRecord;
    FRecordCount := FListLink.RecordCount;
    FKeySelected := not VarIsNull(FKeyValue) or
      not FListLink.DataSet.BOF;
  end else
  begin
    FRecordIndex := 0;
    FRecordCount := 0;
    FKeySelected := False;
  end;
  if HandleAllocated then
  begin
    UpdateScrollBar;
    Invalidate;
  end;
end;

procedure TAutoCustomLookupList.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Button = mbLeft then begin
    FSearchText := '';
    if not FPopup then
    begin
      SetFocus;
      if not FFocused then Exit;
    end;
    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 TAutoCustomLookupList.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 TAutoCustomLookupList.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 TAutoCustomLookupList.Paint;
var
  I, II,  J, W, X, TextWidth, TextHeight, LastFieldIndex: Integer;
  S: string;
  R: TRect;
  Selected: Boolean;
  Field: TField;
begin
  FrealRowCount := FRowCount - Items.Count;
  if FCaption then
    Dec(FrealRowCount);
  if FListLink.BufferCount <> FRealRowCount then
  begin
    FListLink.BufferCount := FRealRowCount;
    ListLinkDataChanged;
  end;
  Canvas.Font := Font;
  TextWidth := Canvas.TextWidth('0');
  TextHeight := Canvas.TextHeight('0');
  LastFieldIndex := FListFields.Count - 1;
  if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
    Canvas.Pen.Color := clBtnFace
  else Canvas.Pen.Color := clBtnShadow;

  II := 0;
  if(FCaption) then begin
    Inc(II);
    Canvas.Brush.Color := clBtnFace;

    R.Top := 1;
    R.Bottom := TextHeight - 1;
    R.Right := 1;
    for J := 0 to LastFieldIndex do begin
       Field := FListFields[J];
        if J < LastFieldIndex then
          W := Field.DisplayWidth * TextWidth + 4
        else W := ClientWidth - R.Right;
        S := Field.DisplayLabel;
        X := (W - Canvas.TextWidth(S)) div 2;
        R.Left := R.Right + 2*J;
        R.Right := R.Right + W;
        //    ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
        //      ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
        Canvas.TextRect(R, R.Left + X, R.Top, S);
        InflateRect(R, 1, 1);
        DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
        DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_TOPLEFT);
        InflateRect(R, -1, -1);
    end;
  end;

  for I := II to FRowCount - 1 do
  begin
    Canvas.Font.Color := Font.Color;
    if(I >= FItems.Count) then
      Canvas.Brush.Color := Color
    else Canvas.Brush.Color := FItemsColor;
    Selected := not FKeySelected and (I = II);
    R.Top := I * TextHeight;
    R.Bottom := R.Top + TextHeight;

    if I  < FRecordCount + FItems.Count then
    begin
      if I >= FItems.Count then begin
        FListLink.ActiveRecord := I - FItems.Count;
        if not VarIsNull(FKeyValue) and VarEquals(FKeyField.Value, FKeyValue) then begin
          Canvas.Font.Color := clHighlightText;
          Canvas.Brush.Color := clHighlight;
          Selected := True;
        end;
      end
      else if IsValueItems = I then begin
          Canvas.Font.Color := clHighlightText;
          Canvas.Brush.Color := clHighlight;
          Selected := True;
        end;
      R.Right := 0;
      if I >= FItems.Count 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;

          S := Field.DisplayText;
          X := 2;
          case Field.Alignment 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
      else begin
        W := ClientWidth - R.Right;
        S := GetItemsLabel(I);
        X := 2;
        case FItemsAlignment 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);
      end;  
    end;
    R.Left := 0;
    R.Right := ClientWidth;
    if I - FItems.Count >= FRecordCount then Canvas.FillRect(R);
    if Selected and FFocused  then Canvas.DrawFocusRect(R);
  end;
  if FRecordCount <> 0 then FListLink.ActiveRecord := FRecordIndex;
end;

procedure TAutoCustomLookupList.SelectCurrent;
begin
  FLockPosition := True;
  if(IsValueItems > -1) then begin
    SelectKeyValue(GetItemsValue(IsValueItems));
    exit;
  end;
  try
    SelectKeyValue(FKeyField.Value);
  finally
    FLockPosition := False;
  end;
end;

procedure TAutoCustomLookupList.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 < Items.Count) then
    IsValueItems := Delta
  else  begin
    Delta :=  Delta - FRecordIndex - Items.Count;
    IsValueItems := -1;
    FListLink.DataSet.MoveBy(Delta);
  end;
  SelectCurrent;
end;

procedure TAutoCustomLookupList.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
    RowCount := RowCount;
  end;
end;

procedure TAutoCustomLookupList.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;
  inherited SetBounds(ALeft, ATop, AWidth, Rows * TextHeight + BorderSize);
end;

procedure TAutoCustomLookupList.SetRowCount(Value: Integer);
begin