dblookupgridseh.pas

考勤管理是企业内部管理的重要环节和基础

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;

procedure TDBLookupGridEh.UpdateRowCount;
begin
  if FInternalHeightSetting then Exit;
  FInternalHeightSetting := True;
  try
    //Height := RowCount * GetDataRowHeight + GetBorderSize + TitleRowHeight + FSpecRowHeight;
  //if HandleAllocated then UpdateScrollBar;
    inherited UpdateRowCount;
  finally
    FInternalHeightSetting := False;
  end;
  //FRowCount := DataRowCount;
  ListLinkDataChanged;
end;

type TColumnEhCracker = class(TColumnEh) end;

procedure TDBLookupGridEh.ColWidthsChanged;
var i,w :Integer;
begin
  w := 0;
  inherited ColWidthsChanged;
  if FInternalWidthSetting = True then Exit;
  if HandleAllocated and (FGridState = gsColSizing) and AutoFitColWidths then
  begin
    for i := 0 to ColCount-1 do
    begin
      Inc(w,ColWidths[i]);
      if dgColLines in inherited Options then Inc(w, GridLineWidth);
    end;
    FInternalWidthSetting := True;
    //FAutoFitColWidths := False;
    try
      ClientWidth := w;
      for i := 0 to Columns.Count-1 do
        TColumnEhCracker(Columns[i]).FInitWidth := Columns[i].Width;
    finally
      FInternalWidthSetting := False;
      //FAutoFitColWidths := True;
    end;
  end;
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.UpdateColumnsList;
var i: Integer;
//    NeedUpdateList: Boolean;
begin
{  NeedUpdateList := (Columns.Count <> ListFields.Count);
  if not NeedUpdateList then
    for i := 0 to ListFields.Count-1 do
      if AnsiCompareText(Columns[i].FieldName,TField(FListFields[i]).FieldName) <> 0 then
      begin
        NeedUpdateList := True;
        Break;
      end;
  if NeedUpdateList and (ListFields.Count > 0) then
  begin
    Columns.BeginUpdate;
    try
      Columns.Clear;
      for i := 0 to ListFields.Count-1 do
      begin
        Columns.Add.FieldName := TField(FListFields[i]).FieldName;
        //Columns[i].Width := Columns[i].Width; //Set width as stored;
      end;
    finally
      Columns.EndUpdate;
    end;
  end;}
  if FLGAutoFitColWidths then
    inherited AutoFitColWidths := True;
  for i := 0 to Columns.Count-1 do
    TColumnEhCracker(Columns[i]).FInitWidth := Columns[i].Width;
  inherited AutoFitColWidths := False;
  RowCount := RowCount;
end;

function TDBLookupGridEh.GetUseMultiTitle: Boolean;
begin
  Result := inherited UseMultiTitle;
end;

procedure TDBLookupGridEh.SetUseMultiTitle(const Value: Boolean);
begin
  inherited UseMultiTitle := Value;
  RowCount := RowCount;
end;

{procedure TDBLookupGridEh.RowHeightsChanged;
begin
  if FInternalHeightSetting then Exit;
  inherited RowHeightsChanged;
  Height := RowCount * GetDataRowHeight + GetBorderSize + TitleRowHeight + FSpecRowHeight;
end;}

function TDBLookupGridEh.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if ListLink.DataSet <> nil then
  begin
    ListLink.DataSet.MoveBy(FRecordCount - FRecordIndex);
    Result := True;
  end;
end;

function TDBLookupGridEh.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if ListLink.DataSet <> nil then
  begin
    ListLink.DataSet.MoveBy(-FRecordIndex - 1);
    Result := True;
  end;
end;

procedure TDBLookupGridEh.CreateWnd;
begin
  inherited CreateWnd;
  RowCount := RowCount;
end;

function TDBLookupGridEh.CalcTitleOffset: Integer;
begin
  Result := inherited CalcTitleOffset;
  if SpecRow.Visible then Result := Result + 1;
end;

procedure TDBLookupGridEh.DrawSubTitleCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var //Field: TField;
    S: String;
    AAlignment: TAlignment;
    DrawColumn: TDBLookupGridColumnEh;
begin
  Dec(ACol, IndicatorOffset);
  Dec(ACol, IndicatorOffset);
  DrawColumn := TDBLookupGridColumnEh(Columns[ACol]);
  Canvas.Font := SpecRow.Font;
  S := DrawColumn.SpecCell.Text; // SpecRow.CellText[ACol];
  AAlignment := DrawColumn.Alignment;
  if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  Canvas.Brush.Color := DrawColumn.SpecCell.Color; //SpecRow.Color;
  if SpecRow.Selected then
  begin
    Canvas.Font.Color := clHighlightText;
    Canvas.Brush.Color := clHighlight;
  end;
  WriteCellText(Canvas, ARect, True, 2, 1, S, AAlignment, tlTop, False, False,0,0);
  if SpecRow.Selected then
  begin
    Canvas.Font.Color := clWindowText;
    Canvas.Brush.Color := clWindow;
    DrawFocusRect(Canvas.Handle, BoxRect(FixedCols, ARow, ColCount, ARow));
  end;
end;

function TDBLookupGridEh.CellHave3DRect(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState): Boolean;
begin
  if SpecRow.Visible and (TitleOffset-1 = ARow)
    then Result := False
    else Result := inherited CellHave3DRect(ACol, ARow, ARect, AState);
end;

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

function TDBLookupGridEh.DataRect: TRect;
begin                       
  Result := BoxRect(IndicatorOffset, iif(SpecRow.Visible,TitleOffset-1,TitleOffset), 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;
    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;

{ 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 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;
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 (TitleOffset-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;
begin
 //  inherited;
end;

procedure TPopupDataGridEh.WMNCCalcSize(var Message: TWMNCCalcSize);
var OldBorderWidth: Integer;
begin
  OldBorderWidth := FBorderWidth;
  FBorderWidth := 0;
  inherited;
  FBorderWidth := OldBorderWidth;
end;

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

end.