dblookupgridseh.pas

最新的 DBGRIDEH4.0

end;

procedure TDBLookupGridEh.GetDatasetFieldList(FieldList: TList);
var i: Integer;
begin
  for i := 0 to ListFields.Count - 1 do
    FieldList.Add(ListFields[i]);
end;

function TDBLookupGridEh.GetAutoFitColWidths: Boolean;
begin
  Result := FLGAutoFitColWidths;
end;

procedure TDBLookupGridEh.SetAutoFitColWidths(const Value: Boolean);
begin
  if AutoFitColWidths <> Value then
  begin
    FLGAutoFitColWidths := Value;
    HorzScrollBar.Visible := not FLGAutoFitColWidths;
    RowCount := RowCount; 
    UpdateScrollBar;
    UpdateColumnsList;
  end;
end;

function TDBLookupGridEh.GetColumnsWidthToFit: Integer;
var i: Integer;
begin
  Result := 0;
  for i := 0 to Columns.Count - 1 do
  begin
    if Columns[i].Visible then
      if AutoFitColWidths
        then Inc(Result, TColumnEhCracker(Columns[i]). {DefaultWidth} FInitWidth)
        else Inc(Result, Columns[i].Width);
    if dgColLines in inherited Options then Inc(Result, GridLineWidth);
  end;
end;

procedure TDBLookupGridEh.SetOptions(const Value: TDBLookupGridEhOptions);
var
  NewGridOptions, NewNoGridOptions: TDBGridOptions;
  NewGridOptionsEh, NewNoGridOptionsEh: TDBGridEhOptions;
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    NewGridOptions := [];
    NewNoGridOptions := [];
    if dlgColumnResizeEh in FOptions
      then NewGridOptions := NewGridOptions + [dgColumnResize]
      else NewNoGridOptions := NewNoGridOptions + [dgColumnResize];
    if dlgColLinesEh in FOptions
      then NewGridOptions := NewGridOptions + [dgColLines]
      else NewNoGridOptions := NewNoGridOptions + [dgColLines];
    if dlgRowLinesEh in FOptions
      then NewGridOptions := NewGridOptions + [dgRowLines]
      else NewNoGridOptions := NewNoGridOptions + [dgRowLines];

    inherited Options := inherited Options + NewGridOptions - NewNoGridOptions;

    NewGridOptionsEh := [];
    NewNoGridOptionsEh := [];
    if dlgAutoSortMarkingEh in FOptions
      then NewGridOptionsEh := NewGridOptionsEh + [dghAutoSortMarking]
      else NewNoGridOptionsEh := NewNoGridOptionsEh + [dghAutoSortMarking];
    if dlgMultiSortMarkingEh in FOptions
      then NewGridOptionsEh := NewGridOptionsEh + [dghMultiSortMarking]
      else NewNoGridOptionsEh := NewNoGridOptionsEh + [dghMultiSortMarking];

    inherited OptionsEh := inherited OptionsEh + NewGridOptionsEh - NewNoGridOptionsEh;
  end;
end;

function TDBLookupGridEh.CreateColumns: TDBGridColumnsEh;
begin
  Result := TDBGridColumnsEh.Create(Self, TDBLookupGridColumnEh);
end;

function TDBLookupGridEh.CreateColumnDefValues: TColumnDefValuesEh;
begin
  Result := TDBLookupGridColumnDefValuesEh.Create(Self);
end;

{CM messages processing}

procedure TDBLookupGridEh.CMRecreateWnd(var Message: TMessage);
begin
  if FInternalWidthSetting
    then Exit
    else Inherited;
end;

{WM messages processing}

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

procedure TDBLookupGridEh.WMKillFocus(var Message: TWMKillFocus);
begin
  FHasFocus := False;
  inherited;
  Invalidate;
end;

procedure TDBLookupGridEh.WMSetFocus(var Message: TWMSetFocus);
begin
  SearchText := '';
  FHasFocus := True;
  inherited;
  Invalidate;
end;

procedure TDBLookupGridEh.WMSetCursor(var Msg: TWMSetCursor);
var
  Cell: TGridCoord;
begin
  Cell := MouseCoord(HitTest.X, HitTest.Y);
  if SpecRow.Visible and (TopDataOffset - 1 = Cell.Y) then
    Exit;
  inherited;
end;

procedure TDBLookupGridEh.WMSize(var Message: TWMSize);
begin
  if FInternalWidthSetting then
    inherited
  else
  begin
    FInternalWidthSetting := True;
    if FLGAutoFitColWidths then
      FAutoFitColWidths := True;
    try
      inherited;
    finally
      FInternalWidthSetting := False;
      FAutoFitColWidths := False;
    end;
  end;
end;

procedure TDBLookupGridEh.WMVScroll(var Message: TWMVScroll);
var
  SI: TScrollInfo;
  OldRecNo: Integer;
  OldActiveRec: Integer;
begin
  SearchText := '';
  if not ListLink.Active then
    Exit;
  if MemTableSupport then
  begin
    inherited
  end else
    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:
          begin
            case Pos of
              0: First;
              1: MoveBy(-FRecordIndex - FRecordCount + 1);
              2: Exit;
              3: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
              4: Last;
            end;
          end;
        SB_BOTTOM: Last;
        SB_TOP: First;
        SB_THUMBTRACK:
          if IsSequenced then
          begin
            SI.cbSize := SizeOf(SI);
            SI.fMask := SIF_TRACKPOS;
            GetScrollInfo(Self.Handle, SB_VERT, SI);
            OldActiveRec := ListLink.ActiveRecord;
            ListLink.ActiveRecord := 0;
            OldRecNo := RecNo - 1;
            if SI.nTrackPos < OldRecNo then
              MoveBy(SI.nTrackPos - OldRecNo)
            else if SI.nTrackPos > OldRecNo then
              MoveBy(SI.nTrackPos - OldRecNo + ListLink.RecordCount - 1)
            else
              ListLink.ActiveRecord := OldActiveRec;
          end;
      end;
end;

function TDBLookupGridEh.CompatibleVarValue(AFieldsArr: TFieldsArrEh; AVlaue: Variant): Boolean;
begin
  Result := True

// Ignore checking because TVariantField, TVarBytesField can have VarArray value.  
{  Result := ((Length(AFieldsArr) = 1) and not VarIsArray(AVlaue)) or
            ((Length(AFieldsArr) > 1) and VarIsArray(AVlaue) and
             ( VarArrayHighBound(AVlaue, 1) - VarArrayLowBound(AVlaue, 1) = Length(AFieldsArr)-1 )
            );}
end;

function TDBLookupGridEh.GetSubTitleRows: Integer;
begin
  Result := inherited GetSubTitleRows;
  if (SpecRow <> nil) and SpecRow.Visible then
    Result := Result + 1;
end;

procedure TDBLookupGridEh.CMHintShow(var Message: TCMHintShow);
{$IFDEF CIL}
var
  AHintInfo: THintInfo;
{$ENDIF}
begin
{$IFDEF CIL}
  if Message.OriginalMessage.LParam = 0 then Exit;
  AHintInfo := Message.HintInfo;
  AHintInfo.HintStr := Hint;
  Message.HintInfo := AHintInfo;
{$ELSE}
  Message.HintInfo^.HintStr := Hint;
{$ENDIF}
  inherited;
end;

{ TPopupDataGridEh }

constructor TPopupDataGridEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
  FPopup := True;
  FSizeGrip := TSizeGripEh.Create(Self);
  with FSizeGrip do
  begin
    Parent := Self;
    TriangleWindow := True;
  end;
  ShowHint := True;
end;

destructor TPopupDataGridEh.Destroy;
begin
  FreeAndNil(FSizeGrip);
  inherited Destroy;
end;

function TPopupDataGridEh.CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if NewWidth < GetSystemMetrics(SM_CXVSCROLL) then
    NewWidth := GetSystemMetrics(SM_CXVSCROLL);
  if NewHeight < GetSystemMetrics(SM_CYVSCROLL) then
    NewHeight := GetSystemMetrics(SM_CYVSCROLL);
end;

procedure TPopupDataGridEh.CMSetSizeGripChangePosition(var Message: TMessage);
begin
  FSizeGrip.ChangePosition(TSizeGripChangePosition(Message.WParam));
end;

procedure TPopupDataGridEh.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP or WS_CLIPCHILDREN;
    if not Ctl3D then
      Style := Style or WS_BORDER;
    //if ScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
    ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
    WindowClass.Style := CS_SAVEBITS or CS_HREDRAW;
  end;
  UpdateBorderWidth;
end;

procedure TPopupDataGridEh.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FUserKeyValueChanged := True;
  try
    inherited KeyDown(Key, Shift);
  finally
    FUserKeyValueChanged := False;
  end;
end;

procedure TPopupDataGridEh.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
end;

procedure TPopupDataGridEh.KeyValueChanged;
begin
  inherited KeyValueChanged;
  if Assigned(OnUserKeyValueChange) and FUserKeyValueChanged then
    OnUserKeyValueChange(Self);
end;

procedure TPopupDataGridEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FUserKeyValueChanged := True;
  FKeySelection := True;
  try
    inherited MouseDown(Button, Shift, X, Y);
    if CellTreeElementMouseDown(X, Y, True) then
      FKeySelection := False;
  finally
    FUserKeyValueChanged := False;
  end;
end;

procedure TPopupDataGridEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  FUserKeyValueChanged := True;
  try
    inherited MouseMove(Shift, X, Y);
    if ([ssLeft, ssRight, ssMiddle] * Shift = []) and not ReadOnly then
      SelectItemAt(X, Y);
  finally
    FUserKeyValueChanged := False;
  end;
end;

procedure TPopupDataGridEh.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Cell: TGridCoord;
  ADataBox: TGridRect;
  AGridState: TGridState;
begin
//  FUserKeyValueChanged := True;
  try
    AGridState := FGridState;
    inherited MouseUp(Button, Shift, X, Y);
    if not (AGridState = gsNormal) or not FKeySelection then Exit;
    if not PtInRect(Rect(0, 0, Width, Height), Point(X, Y)) then
      OnMouseCloseUp(Self, False)
    else
    begin
      Cell := MouseCoord(X, Y);
      ADataBox := DataBox;
      if ((Cell.X >= ADataBox.Left) and (Cell.X <= ADataBox.Right) and
        (Cell.Y >= ADataBox.Top) and (Cell.Y <= ADataBox.Bottom)) or
        (SpecRow.Visible and (TopDataOffset - 1 = Cell.Y)) then
        OnMouseCloseUp(Self, True)
    end
  finally
//    FUserKeyValueChanged := False;
  end;
end;

procedure TPopupDataGridEh.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
  //inherited;
end;

procedure TPopupDataGridEh.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TPopupDataGridEh.WMSize(var Message: TWMSize);
begin
  inherited;
  if FSizeGrip <> nil then FSizeGrip.UpdatePosition;
  FSizeGripResized := True;
end;

procedure TPopupDataGridEh.WMWindowPosChanging(var Message: TWMWindowPosChanging);
{$IFDEF CIL}
var
  r: TWindowPos;
begin
  r := Message.WindowPos;
  if ComponentState * [csReading, csDestroying] = [] then
    with r do
      if (flags and SWP_NOSIZE = 0) and not CheckNewSize(cx, cy) then
        flags := flags or SWP_NOSIZE;
  Message.WindowPos := r;
  inherited;
end;
{$ELSE}
begin
  if ComponentState * [csReading, csDestroying] = [] then
    with Message.WindowPos^ do
      if (flags and SWP_NOSIZE = 0) and not CheckNewSize(cx, cy) then
        flags := flags or SWP_NOSIZE;
  inherited;
end;
{$ENDIF}

procedure TPopupDataGridEh.DrawBorder;
var
  DC: HDC;
  R: TRect;
begin
  if Ctl3D = True then
  begin
    DC := GetWindowDC(Handle);
    try
      GetWindowRect(Handle, R);
      OffsetRect(R, -R.Left, -R.Top);
      DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
//      InflateRect(R, -1, -1);
//      DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
end;

function TPopupDataGridEh.CanFocus: Boolean;
begin
  Result := False;
end;

procedure TPopupDataGridEh.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  UpdateBorderWidth;
  RecreateWnd;
end;

procedure TPopupDataGridEh.UpdateBorderWidth;
begin
  if Ctl3D
    then FBorderWidth := 1//2
    else FBorderWidth := 0;
end;

end.