dblookupgridseh.pas

自己做的用delphi开发的学生成绩管理系统。

begin
  if SpecRow.Visible and (TopDataOffset - 1 = ARow)
    then Result := False
    else Result := inherited CellHave3DRect(ACol, ARow, ARect, AState);
end;

function TDBLookupGridEh.DataRect: TRect;
begin
  Result := BoxRect(IndicatorOffset, iif(SpecRow.Visible, TopDataOffset - 1, TopDataOffset), ColCount - 1,
    iif(FooterRowCount > 0, RowCount - FooterRowCount - 2, RowCount));
end;

procedure TDBLookupGridEh.DefineFieldMap;
var
  I: Integer;
begin
  if Columns.State = csCustomized then
  begin { Build the column/field map from the column attributes }
    DataLink.SparseMap := True;
    for I := 0 to Columns.Count - 1 do
      DataLink.AddMapping(Columns[I].FieldName);
  end else { Build the column/field map from the field list order }
  begin
    DataLink.SparseMap := False;
    for I := 0 to ListFields.Count - 1 do
      with TField(ListFields[I]) do Datalink.AddMapping(FieldName);
  end;
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: TMessage);
begin
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

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

procedure TDBLookupGridEh.WMSetFocus(var Message: TMessage);
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;
  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 := ((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;

{ 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
  FSizeGrip.Free;
  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.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;
  try
    inherited MouseDown(Button, Shift, X, Y);
  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) 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: TMessage);
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);
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;

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.