Delphi控件源码

开发平台：

Delphi

bsdbgrids.pas：源码内容

begin
with FGrid.Datalink.Datasource.Dataset do
begin
DisableControls;
try
for I := FList.Count-1 downto 0 do
begin
Bookmark := FList[I];
Delete;
FList.Delete(I);
end;
finally
EnableControls;
end;
end;
end;
function TbsBookmarkList.Refresh: Boolean;
var
I: Integer;
begin
Result := False;
with FGrid.DataLink.Datasource.Dataset do
try
CheckBrowseMode;
for I := FList.Count - 1 downto 0 do
if not BookmarkValid(TBookmark(FList[I])) then
begin
Result := True;
FList.Delete(I);
end;
finally
UpdateCursorPos;
if Result then FGrid.Invalidate;
end;
end;
procedure TbsBookmarkList.SetCurrentRowSelected(Value: Boolean);
var
Index: Integer;
Current: TBookmarkStr;
begin
Current := CurrentRow;
if (Length(Current) = 0) or (Find(Current, Index) = Value) then Exit;
if Value then
FList.Insert(Index, Current)
else
FList.Delete(Index);
FGrid.InvalidateRow(FGrid.Row);
end;
procedure TbsBookmarkList.StringsChanged(Sender: TObject);
begin
FCache := '';
FCacheIndex := -1;
end;
{ TbsSkinCustomDBGrid }
var
DrawBitmap: TBitmap;
UserCount: Integer;
procedure UsesBitmap;
begin
if UserCount = 0 then
DrawBitmap := TBitmap.Create;
Inc(UserCount);
end;
procedure ReleaseBitmap;
begin
Dec(UserCount);
if UserCount = 0 then DrawBitmap.Free;
end;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment; ARightToLeft: Boolean);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
var
B, R: TRect;
Hold, Left: Integer;
I: TColorRef;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
{ In BiDi, because we changed the window origin, the text that does not
change alignment, actually gets its alignment changed. }
if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
ChangeBiDiModeAlignment(Alignment);
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
DrawText(Handle, PChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;
constructor TbsSkinCustomDBGrid.Create(AOwner: TComponent);
var
Bmp: TBitmap;
begin
inherited Create(AOwner);
inherited DefaultDrawing := False;
FMouseWheelSupport := False;
FSkinMessage := nil;
FAcquireFocus := True;
Bmp := TBitmap.Create;
try
Bmp.LoadFromResourceName(HInstance, bmArrow);
FIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmEdit);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmInsert);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiDot);
FIndicators.AddMasked(Bmp, clWhite);
Bmp.LoadFromResourceName(HInstance, bmMultiArrow);
FIndicators.AddMasked(Bmp, clWhite);
finally
Bmp.Free;
end;
FTitleOffset := 1;
FIndicatorOffset := 1;
FUpdateFields := True;
FOptions := [dgEditing, dgTitles, dgIndicator, dgColumnResize,
dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
if SysLocale.PriLangID = LANG_KOREAN then
Include(FOptions, dgAlwaysShowEditor);
DesignOptionsBoost := [goColSizing];
VirtualView := True;
UsesBitmap;
inherited Options := [goFixedHorzLine, goFixedVertLine, goHorzLine,
goVertLine, goColSizing, goColMoving, goTabs, goEditing];
FColumns := CreateColumns;
FVisibleColumns := TList.Create;
inherited RowCount := 2;
inherited ColCount := 2;
FDataLink := TbsGridDataLink.Create(Self);
Color := clWindow;
ParentColor := False;
FTitleFont := TFont.Create;
FTitleFont.OnChange := TitleFontChanged;
FSaveCellExtents := False;
FUserChange := True;
FDefaultDrawing := True;
FBookmarks := TbsBookmarkList.Create(Self);
HideEditor;
FPickListBoxSkinDataName := 'listbox';
end;
destructor TbsSkinCustomDBGrid.Destroy;
begin
FColumns.Free;
FColumns := nil;
FVisibleColumns.Free;
FVisibleColumns := nil;
FDataLink.Free;
FDataLink := nil;
FIndicators.Free;
FTitleFont.Free;
FTitleFont := nil;
FBookmarks.Free;
FBookmarks := nil;
inherited Destroy;
ReleaseBitmap;
end;
procedure TbsSkinCustomDBGrid.ChangeSkinData;
begin
inherited;
InternalLayout;
end;
procedure TbsSkinCustomDBGrid.WMMouseWheel;
begin
if FMouseWheelSupport
then
begin
if DataSource.DataSet.Active
then
begin
if Message.WheelDelta > 0 then DataSource.DataSet.Prior
else
if Message.WheelDelta < -0 then DataSource.DataSet.Next;
end;
end
else
inherited;
end;
procedure TbsSkinCustomDBGrid.PickListBoxOnCheckButtonClick;
begin
if InplaceEditor.Visible
then
begin
TDBGridInplaceEdit(InplaceEditor).CloseUp(True);
end;
end;
procedure TbsSkinCustomDBGrid.SetHScrollBar;
begin
inherited;
if HScrollBar <> nil then HScrollBar.PageSize := 0;
end;
procedure TbsSkinCustomDBGrid.UpdateScrollPos;
begin
inherited UpdateScrollPos(False);
end;
procedure TbsSkinCustomDBGrid.UpdateScrollRange;
begin
inherited UpdateScrollRange(False);
end;
function TbsSkinCustomDBGrid.AcquireFocus: Boolean;
begin
Result := True;
if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
begin
SetFocus;
Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
end;
end;
function TbsSkinCustomDBGrid.RawToDataColumn(ACol: Integer): Integer;
begin
Result := ACol - FIndicatorOffset;
end;
function TbsSkinCustomDBGrid.DataToRawColumn(ACol: Integer): Integer;
begin
Result := ACol + FIndicatorOffset;
end;
function TbsSkinCustomDBGrid.AcquireLayoutLock: Boolean;
begin
Result := (FUpdateLock = 0) and (FLayoutLock = 0);
if Result then BeginLayout;
end;
procedure TbsSkinCustomDBGrid.BeginLayout;
begin
BeginUpdate;
if FLayoutLock = 0 then Columns.BeginUpdate;
Inc(FLayoutLock);
end;
procedure TbsSkinCustomDBGrid.BeginUpdate;
begin
Inc(FUpdateLock);
end;
procedure TbsSkinCustomDBGrid.CancelLayout;
begin
if FLayoutLock > 0 then
begin
if FLayoutLock = 1 then
Columns.EndUpdate;
Dec(FLayoutLock);
EndUpdate;
end;
end;
function TbsSkinCustomDBGrid.CanEditAcceptKey(Key: Char): Boolean;
begin
with Columns[SelectedIndex] do
Result := FDatalink.Active and Assigned(Field) and Field.IsValidChar(Key);
end;
function TbsSkinCustomDBGrid.CanEditModify: Boolean;
begin
Result := False;
if not ReadOnly and FDatalink.Active and not FDatalink.Readonly then
with Columns[SelectedIndex] do
if (not ReadOnly) and Assigned(Field) and Field.CanModify
and (not (Field.DataType in ftNonTextTypes) or Assigned(Field.OnSetText)) then
begin
FDatalink.Edit;
Result := FDatalink.Editing;
if Result then FDatalink.Modified;
end;
end;
function TbsSkinCustomDBGrid.CanEditShow: Boolean;
begin
Result := (LayoutLock = 0) and inherited CanEditShow;
end;
procedure TbsSkinCustomDBGrid.CellClick(Column: TbsColumn);
begin
if Assigned(FOnCellClick) then FOnCellClick(Column);
end;
procedure TbsSkinCustomDBGrid.ColEnter;
begin
UpdateIme;
if Assigned(FOnColEnter) then FOnColEnter(Self);
end;
procedure TbsSkinCustomDBGrid.ColExit;
begin
if Assigned(FOnColExit) then FOnColExit(Self);
end;
procedure TbsSkinCustomDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
FromIndex := RawToDataColumn(FromIndex);
ToIndex := RawToDataColumn(ToIndex);
Columns[FromIndex].Index := ToIndex;
if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
end;
procedure TbsSkinCustomDBGrid.ColWidthsChanged;
var
I: Integer;
begin
inherited ColWidthsChanged;
if (FDatalink.Active or (FColumns.State = csCustomized)) and
AcquireLayoutLock then
try
for I := FIndicatorOffset to ColCount - 1 do
FColumns[I - FIndicatorOffset].Width := ColWidths[I];
finally
EndLayout;
end;
end;
function TbsSkinCustomDBGrid.CreateColumns: TbsDBGridColumns;
begin
Result := TbsDBGridColumns.Create(Self, TbsColumn);
end;
function TbsSkinCustomDBGrid.CreateEditor: TbsSkinInplaceEdit;
begin
Result := TDBGridInplaceEdit.Create(Self);
end;
procedure TbsSkinCustomDBGrid.CreateWnd;
begin
BeginUpdate; { prevent updates in WMSize message that follows WMCreate }
try
inherited CreateWnd;
finally
EndUpdate;
end;
UpdateRowCount;
UpdateActive;
UpdateScrollBar;
FOriginalImeName := ImeName;
FOriginalImeMode := ImeMode;
end;
procedure TbsSkinCustomDBGrid.DataChanged;
begin
if not HandleAllocated then Exit;
UpdateRowCount;
UpdateScrollBar;
UpdateActive;
InvalidateEditor;
ValidateRect(Handle, nil);
Invalidate;
end;
procedure TbsSkinCustomDBGrid.DefaultHandler(var Msg);
var
P: TPopupMenu;
Cell: TGridCoord;
begin
inherited DefaultHandler(Msg);
if TMessage(Msg).Msg = wm_RButtonUp then
with TWMRButtonUp(Msg) do
begin
Cell := MouseCoord(XPos, YPos);
if (Cell.X < FIndicatorOffset) or (Cell.Y < 0) then Exit;
P := Columns[RawToDataColumn(Cell.X)].PopupMenu;
if (P <> nil) and P.AutoPopup then
begin
SendCancelMode(nil);
P.PopupComponent := Self;
with ClientToScreen(SmallPointToPoint(Pos)) do
P.Popup(X, Y);
Result := 1;
end;
end;
end;
procedure TbsSkinCustomDBGrid.DeferLayout;
var
M: TMsg;
begin
if HandleAllocated and
not PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_NoRemove) then
PostMessage(Handle, cm_DeferLayout, 0, 0);
CancelLayout;
end;
procedure TbsSkinCustomDBGrid.DefineFieldMap;
var
I: Integer;
begin
if FColumns.State = csCustomized then
begin { Build the column/field map from the column attributes }
DataLink.SparseMap := True;
for I := 0 to FColumns.Count-1 do
FDataLink.AddMapping(FColumns[I].FieldName);
end
else { Build the column/field map from the field list order }
begin
FDataLink.SparseMap := False;
with Datalink.Dataset do
for I := 0 to FieldList.Count - 1 do
with FieldList[I] do if Visible then Datalink.AddMapping(FullName);
end;
end;
function TbsSkinCustomDBGrid.UseRightToLeftAlignmentForField(const AField: TField;
Alignment: TAlignment): Boolean;
begin
Result := False;
if IsRightToLeft then
Result := OkToChangeFieldAlignment(AField, Alignment);
end;
procedure TbsSkinCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
var
Alignment: TAlignment;
Value: string;
begin
Alignment := taLeftJustify;
Value := '';
if Assigned(Field) then
begin
Alignment := Field.Alignment;
Value := Field.DisplayText;
end;
WriteText(Canvas, Rect, 2, 2, Value, Alignment,
UseRightToLeftAlignmentForField(Field, Alignment));
end;
procedure TbsSkinCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
DataCol: Integer; Column: TbsColumn; State: TGridDrawState);
var
Value: string;
begin
Value := '';
if Assigned(Column.Field) then
Value := Column.Field.DisplayText;
WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
end;
procedure TbsSkinCustomDBGrid.ReadColumns(Reader: TReader);
begin
Columns.Clear;
Reader.ReadValue;
Reader.ReadCollection(Columns);
end;
procedure TbsSkinCustomDBGrid.WriteColumns(Writer: TWriter);
begin
if Columns.State = csCustomized then
Writer.WriteCollection(Columns)
else // ancestor state is customized, ours is not
Writer.WriteCollection(nil);
end;
procedure TbsSkinCustomDBGrid.DefineProperties(Filer: TFiler);
var
StoreIt: Boolean;
vState: TbsDBGridColumnsState;
begin
vState := Columns.State;
if Filer.Ancestor = nil then
StoreIt := vState = csCustomized
else
if vState <> TbsSkinCustomDBGrid(Filer.Ancestor).Columns.State then
StoreIt := True
else
begin
{$IFDEF VER140}
StoreIt := (vState = csCustomized) and
(not CollectionsEqual(Columns, TbsSkinCustomDBGrid(Filer.Ancestor).Columns, Self, TbsSkinCustomDBGrid(Filer.Ancestor)));
{$ELSE}
{$IFDEF VER150}
StoreIt := (vState = csCustomized) and
(not CollectionsEqual(Columns, TbsSkinCustomDBGrid(Filer.Ancestor).Columns, Self, TbsSkinCustomDBGrid(Filer.Ancestor)));
{$ELSE}
StoreIt := (vState = csCustomized) and
(not CollectionsEqual(Columns, TbsSkinCustomDBGrid(Filer.Ancestor).Columns));
{$ENDIF}
{$ENDIF}
end;
Filer.DefineProperty('Columns', ReadColumns, WriteColumns, StoreIt);
end;
function TbsSkinCustomDBGrid.ColumnAtDepth(Col: TbsColumn; ADepth: Integer): TbsColumn;
begin
Result := Col;
while (Result <> nil) and (Result.Depth > ADepth) do
Result := Result.ParentColumn;
end;
function TbsSkinCustomDBGrid.CalcTitleRect(Col: TbsColumn; ARow: Integer;
var MasterCol: TbsColumn): TRect;
var
I,J: Integer;
InBiDiMode: Boolean;
DrawInfo: TbsGridDrawInfo;
begin
MasterCol := ColumnAtDepth(Col, ARow);
if MasterCol = nil then Exit;
I := DataToRawColumn(MasterCol.Index);
if I >= LeftCol then
J := MasterCol.Depth
else
begin
I := LeftCol;
if Col.Depth > ARow then
J := ARow
else
J := Col.Depth;
end;
Result := CellRect(I, J);
InBiDiMode := UseRightToLeftAlignment and
(Canvas.CanvasOrientation = coLeftToRight);
for I := Col.Index to Columns.Count-1 do
begin
if ColumnAtDepth(Columns[I], ARow) <> MasterCol then Break;
if not InBiDiMode then
begin
J := CellRect(DataToRawColumn(I), ARow).Right;
if J = 0 then Break;
Result.Right := Max(Result.Right, J);
end
else
begin
J := CellRect(DataToRawColumn(I), ARow).Left;
if J >= ClientWidth then Break;
Result.Left := J;
end;
end;
J := Col.Depth;
if (J <= ARow) and (J < FixedRows-1) then
begin
CalcFixedInfo(DrawInfo);
Result.Bottom := DrawInfo.Vert.FixedBoundary - DrawInfo.Vert.EffectiveLineWidth;
end;
end;
procedure TbsSkinCustomDBGrid.DrawCell;
begin
if FIndex <> -1
then
DrawSkinCell(ACol, ARow, ARect, AState)
else
DrawDefaultCell(ACol, ARow, ARect, AState);
end;
procedure TbsSkinCustomDBGrid.DrawSkinCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result := (dgMultiSelect in Options) and Datalink.Active and
FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);
end;
procedure DrawTitleCell(ACol, ARow: Integer; Column: TbsColumn; var AState: TGridDrawState);
var
B: TBitMap;
TextRct, TitleRect: TRect;
MasterCol: TbsColumn;
begin
TitleRect := CalcTitleRect(Column, ARow, MasterCol);
B := TBitMap.Create;
CreateHSkinImage(FixedCellLeftOffset, FixedCellRightOffset,
B, Picture, FixedCellRect, RectWidth(TitleRect), RectHeight(TitleRect));
with B.Canvas do
begin
Font.Name := FixedFontName;
Font.Height := FixedFontHeight;
Font.Color := FixedFontColor;
Font.Style := FixedFontStyle;
Brush.Style := bsClear;
end;
TextRct := FixedCellTextRect;
Inc(TextRct.Right, B.Width - RectWidth(FixedCellRect));
if MasterCol <> nil
then
with MasterCol.Title do
if Alignment = taLeftJustify
then
SPDrawText2(B.Canvas, Caption, TextRct)
else
WriteText(B.Canvas, TextRct, 0, 0,
Caption, Alignment, IsRightToLeft);
Canvas.Draw(TitleRect.Left, TitleRect.Top, B);
B.Free;
AState := AState - [gdFixed];
end;
procedure DrawIndicatorCell(Indicator: Integer);
var
B: TBitMap;
IX, IY: Integer;
IRect: TRect;
begin
B := TBitMap.Create;
CreateHSkinImage(FixedCellLeftOffset, FixedCellRightOffset,
B, Picture, FixedCellRect, RectWidth(ARect), RectHeight(ARect));
IRect := FixedCellTextRect;
Inc(IRect.Right, B.Width - RectWidth(FixedCellRect));
IX := IRect.Left + RectWidth(IRect) div 2 - FIndicators.Width div 2;
IY := IRect.Top + RectHeight(IRect) div 2 - FIndicators.Height div 2;
FIndicators.Draw(B.Canvas, IX, IY, Indicator, True);
Canvas.Draw(ARect.Left, ARect.Top, B);
B.Free;
end;
procedure DrawFixedCell;
var
B: TBitMap;
begin
B := TBitMap.Create;
CreateHSkinImage(FixedCellLeftOffset, FixedCellRightOffset,
B, Picture, FixedCellRect, RectWidth(ARect), RectHeight(ARect));
Canvas.Draw(ARect.Left, ARect.Top, B);
B.Free;
end;
procedure DrawSelectedCell(AText: String; ADrawColumn: TbsColumn);
var
B: TBitMap;
TextRct: TRect;
begin
B := TBitMap.Create;
CreateHSkinImage(CellLeftOffset, CellRightOffset,
B, Picture, SelectCellRect, RectWidth(ARect), RectHeight(ARect));
with B.Canvas do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := SelectFontColor;
Font.Style := FontStyle;
Brush.Style := bsClear;
end;
TextRct := CellTextRect;
Inc(TextRct.Right, B.Width - RectWidth(SelectCellRect));
if ADrawColumn.Alignment = taLeftJustify
then
SPDrawText2(B.Canvas, AText, TextRct)
else
WriteText(B.Canvas, TextRct, 0, 0, AText, ADrawColumn.Alignment,
UseRightToLeftAlignmentForField(ADrawColumn.Field, ADrawColumn.Alignment));
Canvas.Draw(ARect.Left, ARect.Top, B);
B.Free;
end;
procedure DrawFocusedCell(AText: String; ADrawColumn: TbsColumn);
var
B: TBitMap;
TextRct: TRect;
begin
B := TBitMap.Create;
CreateHSkinImage(CellLeftOffset, CellRightOffset,
B, Picture, FocusCellRect, RectWidth(ARect), RectHeight(ARect));
with B.Canvas do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FocusFontColor;
Font.Style := FontStyle;
Brush.Style := bsClear;
end;
TextRct := CellTextRect;
Inc(TextRct.Right, B.Width - RectWidth(SelectCellRect));
if ADrawColumn.Alignment = taLeftJustify
then
SPDrawText2(B.Canvas, AText, TextRct)
else
WriteText(B.Canvas, TextRct, 0, 0, AText, ADrawColumn.Alignment,
UseRightToLeftAlignmentForField(ADrawColumn.Field, ADrawColumn.Alignment));
Canvas.Draw(ARect.Left, ARect.Top, B);
B.Free;
end;
var
OldActive: Integer;
Indicator: Integer;
Value: string;
DrawColumn: TbsColumn;
MultiSelected: Boolean;
begin
Indicator := -1;
Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset);
if (gdFixed in AState) and (ACol < 0) then
begin
if Assigned(DataLink) and DataLink.Active then
begin
MultiSelected := False;
if ARow >= 0 then
begin
OldActive := FDataLink.ActiveRecord;
try
FDatalink.ActiveRecord := ARow;
MultiSelected := RowIsMultiselected;
finally
FDatalink.ActiveRecord := OldActive;
end;
end;
if (ARow = FDataLink.ActiveRecord) or MultiSelected then
begin
Indicator := 0;
if FDataLink.DataSet <> nil then
case FDataLink.DataSet.State of
dsEdit: Indicator := 1;
dsInsert: Indicator := 2;
dsBrowse:
if MultiSelected then
if (ARow <> FDatalink.ActiveRecord) then
Indicator := 3
else
Indicator := 4; // multiselected and current row
end;
DrawIndicatorCell(Indicator);
if ARow = FDatalink.ActiveRecord then
FSelRow := ARow + FTitleOffset;
end;
end;
end
else with Canvas do
begin
DrawColumn := Columns[ACol];
if not DrawColumn.Showing then Exit;
if not (gdFixed in AState) then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FontColor;
Font.Style := FontStyle;
Brush.Color := BGColor;
end;
if ARow < 0 then
DrawTitleCell(ACol, ARow + FTitleOffset, DrawColumn, AState)
else if (FDataLink = nil) or not FDataLink.Active then
FillRect(ARect)
else
begin
Value := '';
OldActive := FDataLink.ActiveRecord;
try
FDataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then
Value := DrawColumn.Field.DisplayText;
if FDefaultDrawing then
if Focused and ((gdFocused in AState) or
((gdSelected in AState) and (dgRowSelect in Options)))
then
DrawFocusedCell(Value, DrawColumn)
else
if gdSelected in AState
then
DrawSelectedCell(Value, DrawColumn)
else
WriteText(Canvas, ARect, 2, 2, Value, DrawColumn.Alignment,
UseRightToLeftAlignmentForField(DrawColumn.Field, DrawColumn.Alignment));
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
FDataLink.ActiveRecord := OldActive;
end;
end;
end;
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) and (Indicator = -1)
then
DrawFixedCell;
end;
procedure TbsSkinCustomDBGrid.DrawDefaultCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
FrameOffs: Byte;
function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result := (dgMultiSelect in Options) and Datalink.Active and
FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);
end;
procedure DrawTitleCell(ACol, ARow: Integer; Column: TbsColumn; var AState: TGridDrawState);
const
ScrollArrows: array [Boolean, Boolean] of Integer =
((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
var
MasterCol: TbsColumn;
TitleRect, TextRect, ButtonRect: TRect;
I: Integer;
InBiDiMode: Boolean;
begin
TitleRect := CalcTitleRect(Column, ARow, MasterCol);
if MasterCol = nil then
begin
Canvas.FillRect(ARect);
Exit;
end;
Canvas.Font := MasterCol.Title.Font;
Canvas.Brush.Color := MasterCol.Title.Color;
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(TitleRect, -1, -1);
TextRect := TitleRect;
I := GetSystemMetrics(SM_CXHSCROLL);
if ((TextRect.Right - TextRect.Left) > I) and MasterCol.Expandable then
begin
Dec(TextRect.Right, I);
ButtonRect := TitleRect;
ButtonRect.Left := TextRect.Right;
I := SaveDC(Canvas.Handle);
try
Canvas.FillRect(ButtonRect);
InflateRect(ButtonRect, -1, -1);
IntersectClipRect(Canvas.Handle, ButtonRect.Left,
ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
InflateRect(ButtonRect, 1, 1);
{ DrawFrameControl doesn't draw properly when orienatation has changed.
It draws as ExtTextOut does. }
InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
if InBiDiMode then { stretch the arrows box }
Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
finally
RestoreDC(Canvas.Handle, I);
end;
end;
with MasterCol.Title do
WriteText(Canvas, TextRect, FrameOffs, FrameOffs, Caption, Alignment,
IsRightToLeft);
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
begin
InflateRect(TitleRect, 1, 1);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
AState := AState - [gdFixed]; // prevent box drawing later
end;
var
OldActive: Integer;
Indicator: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: TbsColumn;
MultiSelected: Boolean;
ALeft: Integer;
begin
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset);
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
if (gdFixed in AState) and (ACol < 0) then
begin
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(ARect);
if Assigned(DataLink) and DataLink.Active then
begin
MultiSelected := False;
if ARow >= 0 then
begin
OldActive := FDataLink.ActiveRecord;
try
FDatalink.ActiveRecord := ARow;
MultiSelected := RowIsMultiselected;
finally
FDatalink.ActiveRecord := OldActive;
end;
end;
if (ARow = FDataLink.ActiveRecord) or MultiSelected then
begin
Indicator := 0;
if FDataLink.DataSet <> nil then
case FDataLink.DataSet.State of
dsEdit: Indicator := 1;
dsInsert: Indicator := 2;
dsBrowse:
if MultiSelected then
if (ARow <> FDatalink.ActiveRecord) then
Indicator := 3
else
Indicator := 4; // multiselected and current row
end;
ALeft := ARect.Right - FIndicators.Width - FrameOffs;
if Canvas.CanvasOrientation = coRightToLeft then Inc(ALeft);
FIndicators.Draw(Canvas, ALeft,
(ARect.Top + ARect.Bottom - FIndicators.Height) shr 1, Indicator, True);
if ARow = FDatalink.ActiveRecord then
FSelRow := ARow + FTitleOffset;
end;
end;
end
else with Canvas do
begin
DrawColumn := Columns[ACol];
if not DrawColumn.Showing then Exit;
if not (gdFixed in AState) then
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color
end;
if ARow < 0 then
DrawTitleCell(ACol, ARow + FTitleOffset, DrawColumn, AState)
else if (FDataLink = nil) or not FDataLink.Active then
FillRect(ARect)
else
begin
Value := '';
OldActive := FDataLink.ActiveRecord;
try
FDataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then
Value := DrawColumn.Field.DisplayText;
Highlight := HighlightCell(ACol, ARow, Value, AState);
if Highlight then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if not Enabled then
Font.Color := clGrayText;
// draw cell
if FDefaultDrawing then
WriteText(Canvas, ARect, 2, 2, Value, DrawColumn.Alignment,
UseRightToLeftAlignmentForField(DrawColumn.Field, DrawColumn.Alignment));
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
FDataLink.ActiveRecord := OldActive;
end;
if FDefaultDrawing and (gdSelected in AState)
and ((dgAlwaysShowSelection in Options) or Focused)
and not (csDesigning in ComponentState)
and not (dgRowSelect in Options)
and (UpdateLock = 0)
and (ValidParentForm(Self).ActiveControl = Self) then
Windows.DrawFocusRect(Handle, ARect);
end;
end;
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
InflateRect(ARect, 1, 1);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
end;
procedure TbsSkinCustomDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
begin
if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, Rect, Field, State);
end;
procedure TbsSkinCustomDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TbsColumn; State: TGridDrawState);
begin
if Assigned(OnDrawColumnCell) then
OnDrawColumnCell(Self, Rect, DataCol, Column, State);
end;
procedure TbsSkinCustomDBGrid.EditButtonClick;
begin
if Assigned(FOnEditButtonClick) then
FOnEditButtonClick(Self)
else
ShowPopupEditor(Columns[SelectedIndex]);
end;
procedure TbsSkinCustomDBGrid.EditingChanged;
begin
if dgIndicator in Options then InvalidateCell(0, FSelRow);
end;
procedure TbsSkinCustomDBGrid.EndLayout;
begin
if FLayoutLock > 0 then
begin
try
try
if FLayoutLock = 1 then
InternalLayout;
finally
if FLayoutLock = 1 then
FColumns.EndUpdate;
end;
finally
Dec(FLayoutLock);
EndUpdate;
end;
end;
end;
procedure TbsSkinCustomDBGrid.EndUpdate;
begin
if FUpdateLock > 0 then
Dec(FUpdateLock);
end;
function TbsSkinCustomDBGrid.GetColField(DataCol: Integer): TField;
begin
Result := nil;
if (DataCol >= 0) and FDatalink.Active and (DataCol < Columns.Count) then
Result := Columns[DataCol].Field;
end;
function TbsSkinCustomDBGrid.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TbsSkinCustomDBGrid.GetEditLimit: Integer;
begin
Result := 0;
if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString]) then
Result := SelectedField.Size;
end;
function TbsSkinCustomDBGrid.GetEditMask(ACol, ARow: Longint): string;
begin
Result := '';
if FDatalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
Result := Field.EditMask;
end;
function TbsSkinCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
Result := '';
if FDatalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
Result := Field.Text;
FEditText := Result;
end;
function TbsSkinCustomDBGrid.GetFieldCount: Integer;
begin
Result := FDatalink.FieldCount;
end;
function TbsSkinCustomDBGrid.GetFields(FieldIndex: Integer): TField;
begin
Result := FDatalink.Fields[FieldIndex];
end;
function TbsSkinCustomDBGrid.GetFieldValue(ACol: Integer): string;
var
Field: TField;
begin
Result := '';
Field := GetColField(ACol);
if Field <> nil then Result := Field.DisplayText;
end;
function TbsSkinCustomDBGrid.GetSelectedField: TField;
var
Index: Integer;
begin
Index := SelectedIndex;
if Index <> -1 then
Result := Columns[Index].Field
else
Result := nil;
end;
function TbsSkinCustomDBGrid.GetSelectedIndex: Integer;
begin
Result := RawToDataColumn(Col);
end;
function TbsSkinCustomDBGrid.HighlightCell(DataCol, DataRow: Integer;
const Value: string; AState: TGridDrawState): Boolean;
var
Index: Integer;
begin
Result := False;
if (dgMultiSelect in Options) and Datalink.Active then
Result := FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);
if not Result then
Result := (gdSelected in AState)
and ((dgAlwaysShowSelection in Options) or Focused)
{ updatelock eliminates flicker when tabbing between rows }
and ((UpdateLock = 0) or (dgRowSelect in Options));
end;
procedure TbsSkinCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
KeyDownEvent: TKeyEvent;
procedure ClearSelection;
begin
if (dgMultiSelect in Options) then
begin
FBookmarks.Clear;
FSelecting := False;
end;
end;
procedure DoSelection(Select: Boolean; Direction: Integer);
var
AddAfter: Boolean;
begin
AddAfter := False;
BeginUpdate;
try
if (dgMultiSelect in Options) and FDatalink.Active then
if Select and (ssShift in Shift) then
begin
if not FSelecting then
begin
FSelectionAnchor := FBookmarks.CurrentRow;
FBookmarks.CurrentRowSelected := True;
FSelecting := True;
AddAfter := True;
end
else
with FBookmarks do
begin
AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
if not AddAfter then
CurrentRowSelected := False;
end
end
else
ClearSelection;
FDatalink.MoveBy(Direction);
if AddAfter then FBookmarks.CurrentRowSelected := True;
finally
EndUpdate;
end;
end;
procedure NextRow(Select: Boolean);
begin
with FDatalink.Dataset do
begin
if (State = dsInsert) and not Modified and not FDatalink.FModified then
if FDataLink.EOF then Exit else Cancel
else
DoSelection(Select, 1);
if FDataLink.EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
Append;
end;
end;
procedure PriorRow(Select: Boolean);
begin
with FDatalink.Dataset do
if (State = dsInsert) and not Modified and FDataLink.EOF and
not FDatalink.FModified then
Cancel
else
DoSelection(Select, -1);
end;
procedure Tab(GoForward: Boolean);
var
ACol, Original: Integer;
begin
ACol := Col;
Original := ACol;
BeginUpdate; { Prevent highlight flicker on tab to next/prior row }
try
while True do
begin
if GoForward then
Inc(ACol) else
Dec(ACol);
if ACol >= ColCount then
begin
NextRow(False);
ACol := FIndicatorOffset;
end
else if ACol < FIndicatorOffset then
begin
PriorRow(False);
ACol := ColCount - FIndicatorOffset;
end;
if ACol = Original then Exit;
if TabStops[ACol] then
begin
MoveCol(ACol, 0);
Exit;
end;
end;
finally
EndUpdate;
end;
end;
function DeletePrompt: Boolean;
var
Msg: string;
begin
if (FBookmarks.Count > 1) then
Msg := SDeleteMultipleRecordsQuestion
else
Msg := SDeleteRecordQuestion;
if FSkinMessage <> nil
then
Result := not (dgConfirmDelete in Options) or
(FSkinMessage.MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) <> idCancel)
else
Result := not (dgConfirmDelete in Options) or
(MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) <> idCancel);
end;
const
RowMovementKeys = [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END];
begin
KeyDownEvent := OnKeyDown;
if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
if not FDatalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
if UseRightToLeftAlignment then
if Key = VK_LEFT then
Key := VK_RIGHT
else if Key = VK_RIGHT then
Key := VK_LEFT;
with FDatalink.DataSet do
if ssCtrl in Shift then
begin
if (Key in RowMovementKeys) then ClearSelection;
case Key of
VK_UP, VK_PRIOR: FDataLink.MoveBy(-FDatalink.ActiveRecord);
VK_DOWN, VK_NEXT: FDataLink.MoveBy(FDatalink.BufferCount - FDatalink.ActiveRecord - 1);
VK_LEFT: MoveCol(FIndicatorOffset, 1);
VK_RIGHT: MoveCol(ColCount - 1, -1);
VK_HOME: First;
VK_END: Last;
VK_DELETE:
if (not ReadOnly) and not IsEmpty
and CanModify and DeletePrompt then
if FBookmarks.Count > 0 then
FBookmarks.Delete
else
Delete;
end
end
else
case Key of
VK_UP: PriorRow(True);
VK_DOWN: NextRow(True);
VK_LEFT:
if dgRowSelect in Options then
PriorRow(False) else
MoveCol(Col - 1, -1);
VK_RIGHT:
if dgRowSelect in Options then
NextRow(False) else
MoveCol(Col + 1, 1);
VK_HOME:
if (ColCount = FIndicatorOffset+1)
or (dgRowSelect in Options) then
begin
ClearSelection;
First;
end
else
MoveCol(FIndicatorOffset, 1);
VK_END:
if (ColCount = FIndicatorOffset+1)
or (dgRowSelect in Options) then
begin
ClearSelection;
Last;
end
else
MoveCol(ColCount - 1, -1);
VK_NEXT:
begin
ClearSelection;
FDataLink.MoveBy(VisibleRowCount);
end;
VK_PRIOR:
begin
ClearSelection;
FDataLink.MoveBy(-VisibleRowCount);
end;
VK_INSERT:
if CanModify and (not ReadOnly) and (dgEditing in Options) then
begin
ClearSelection;
Insert;
end;
VK_TAB: if not (ssAlt in Shift) then Tab(not (ssShift in Shift));
VK_ESCAPE:
begin
if SysLocale.PriLangID = LANG_KOREAN then
FIsESCKey := True;
FDatalink.Reset;
ClearSelection;
if not (dgAlwaysShowEditor in Options) then HideEditor;
end;
VK_F2: EditorMode := True;
end;
end;
procedure TbsSkinCustomDBGrid.KeyPress(var Key: Char);
begin
FIsESCKey := False;
if not (dgAlwaysShowEditor in Options) and (Key = #13) then
FDatalink.UpdateData;
inherited KeyPress(Key);
end;
procedure TbsSkinCustomDBGrid.InternalLayout;
function FieldIsMapped(F: TField): Boolean;
var
X: Integer;
begin
Result := False;
if F = nil then Exit;
for X := 0 to FDatalink.FieldCount-1 do
if FDatalink.Fields[X] = F then
begin
Result := True;
Exit;
end;
end;
procedure CheckForPassthroughs; // check for Columns.State flip-flop
var
SeenPassthrough: Boolean;
I, J: Integer;
Column: TbsColumn;
begin
SeenPassthrough := False;
for I := 0 to FColumns.Count-1 do
if not FColumns[I].IsStored then
SeenPassthrough := True
else if SeenPassthrough then
begin // we have both persistent and non-persistent columns. Kill the latter
for J := FColumns.Count-1 downto 0 do
begin
Column := FColumns[J];
if not Column.IsStored then
Column.Free;
end;
Exit;
end;
end;
procedure ReseTbsColumnFieldBindings;
var
I, J, K: Integer;
Fld: TField;
Column: TbsColumn;
begin
if FColumns.State = csDefault then
begin
{ Destroy columns whose fields have been destroyed or are no longer
in field map }
if (not FDataLink.Active) and (FDatalink.DefaultFields) then
FColumns.Clear
else
for J := FColumns.Count-1 downto 0 do
with FColumns[J] do
if not Assigned(Field)
or not FieldIsMapped(Field) then Free;
I := FDataLink.FieldCount;
if (I = 0) and (FColumns.Count = 0) then Inc(I);
for J := 0 to I-1 do
begin
Fld := FDatalink.Fields[J];
if Assigned(Fld) then
begin
K := J;
while (K < FColumns.Count) and (FColumns[K].Field <> Fld) do
Inc(K);
if K < FColumns.Count then
Column := FColumns[K]
else
begin
Column := FColumns.InternalAdd;
Column.Field := Fld;
end;
end
else
Column := FColumns.InternalAdd;
Column.Index := J;
end;
end
else
begin
{ Force columns to reaquire fields (in case dataset has changed) }
for I := 0 to FColumns.Count-1 do
FColumns[I].Field := nil;
end;
end;
procedure MeasureTitleHeights;
var
I, J, K, D, B: Integer;
RestoreCanvas: Boolean;
Heights: array of Integer;
begin
RestoreCanvas := not HandleAllocated;
if RestoreCanvas then
Canvas.Handle := GetDC(0);
try
Canvas.Font := Font;
// row heights
if FIndex = -1
then
begin
K := Canvas.TextHeight('Wg') + 3;
if dgRowLines in Options then
Inc(K, GridLineWidth);
DefaultRowHeight := K
end
else
DefaultRowHeight := SelectCellRect.Bottom - SelectCellRect.Top;
B := GetSystemMetrics(SM_CYHSCROLL);
if dgTitles in Options then
begin
SetLength(Heights, FTitleOffset+1);
for I := 0 to FColumns.Count-1 do
begin
Canvas.Font := FColumns[I].Title.Font;
D := FColumns[I].Depth;
if D <= High(Heights) then
begin
// title height
if FIndex = -1
then
begin
J := Canvas.TextHeight('Wg') + 4;
if FColumns[I].Expandable and (B > J) then
J := B;
end
else
J := FixedCellRect.Bottom - FixedCellRect.Top;
Heights[D] := Max(J, Heights[D]);
end;
end;
if Heights[0] = 0 then
begin
Canvas.Font := FTitleFont;
if FIndex = -1
then
Heights[0] := Canvas.TextHeight('Wg') + 4
else
Heights[0] := FixedCellRect.Bottom - FixedCellRect.Top;
end;
for I := 0 to High(Heights)-1 do
RowHeights[I] := Heights[I];
end;
finally
if RestoreCanvas then
begin
ReleaseDC(0,Canvas.Handle);
Canvas.Handle := 0;
end;
end;
end;
var
I, J: Integer;
begin
if (csLoading in ComponentState) then Exit;
if HandleAllocated then KillMessage(Handle, cm_DeferLayout);
CheckForPassthroughs;
FIndicatorOffset := 0;
if dgIndicator in Options then
Inc(FIndicatorOffset);
FDatalink.ClearMapping;
if FDatalink.Active then DefineFieldMap;
DoubleBuffered := (FDatalink.Dataset <> nil) and FDatalink.Dataset.ObjectView;
ReseTbsColumnFieldBindings;
FVisibleColumns.Clear;
for I := 0 to FColumns.Count-1 do
if FColumns[I].Showing then FVisibleColumns.Add(FColumns[I]);
ColCount := FColumns.Count + FIndicatorOffset;
inherited FixedCols := FIndicatorOffset;
FTitleOffset := 0;
if dgTitles in Options then
begin
FTitleOffset := 1;
if (FDatalink <> nil) and (FDatalink.Dataset <> nil)
and FDatalink.Dataset.ObjectView then
begin
for I := 0 to FColumns.Count-1 do
begin
if FColumns[I].Showing then
begin
J := FColumns[I].Depth;
if J >= FTitleOffset then FTitleOffset := J+1;
end;
end;
end;
end;
UpdateRowCount;
MeasureTitleHeights;
SetColumnAttributes;
UpdateActive;
Invalidate;
end;
procedure TbsSkinCustomDBGrid.LayoutChanged;
begin
if AcquireLayoutLock then
EndLayout;
end;
procedure TbsSkinCustomDBGrid.LinkActive(Value: Boolean);
var
Comp: TComponent;
I: Integer;
begin
if not Value then HideEditor;
FBookmarks.LinkActive(Value);
try
LayoutChanged;
finally
for I := ComponentCount-1 downto 0 do
begin
Comp := Components[I]; // Free all the popped-up subgrids
if (Comp is TbsSkinCustomDBGrid)
and (TbsSkinCustomDBGrid(Comp).DragKind = dkDock) then
Comp.Free;
end;
UpdateScrollBar;
if Value and (dgAlwaysShowEditor in Options) then ShowEditor;
end;
end;
procedure TbsSkinCustomDBGrid.Loaded;
begin
inherited Loaded;
if FColumns.Count > 0 then
ColCount := FColumns.Count;
LayoutChanged;
end;
function TbsSkinCustomDBGrid.PtInExpandButton(X,Y: Integer; var MasterCol: TbsColumn): Boolean;
var
Cell: TGridCoord;
R: TRect;
begin
MasterCol := nil;
Result := False;
Cell := MouseCoord(X,Y);
if (Cell.Y < FTitleOffset) and FDatalink.Active
and (Cell.X >= FIndicatorOffset)
and (RawToDataColumn(Cell.X) < Columns.Count) then
begin
R := CalcTitleRect(Columns[RawToDataColumn(Cell.X)], Cell.Y, MasterCol);
if not UseRightToLeftAlignment then
R.Left := R.Right - GetSystemMetrics(SM_CXHSCROLL)
else
R.Right := R.Left + GetSystemMetrics(SM_CXHSCROLL);
Result := MasterCol.Expandable and PtInRect(R, Point(X,Y));
end;
end;
procedure TbsSkinCustomDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Cell: TGridCoord;
OldCol,OldRow: Integer;
MasterCol: TbsColumn;
begin
if not AcquireFocus then Exit;
if (ssDouble in Shift) and (Button = mbLeft) then
begin
DblClick;
Exit;
end;
if Sizing(X, Y) then
begin
FDatalink.UpdateData;
inherited MouseDown(Button, Shift, X, Y);
Exit;
end;
Cell := MouseCoord(X, Y);
if (Cell.X < 0) and (Cell.Y < 0) then
begin
inherited MouseDown(Button, Shift, X, Y);
Exit;
end;
if (DragKind = dkDock) and (Cell.X < FIndicatorOffset) and
(Cell.Y < FTitleOffset) and (not (csDesigning in ComponentState)) then
begin
BeginDrag(false);
Exit;
end;
if PtInExpandButton(X,Y, MasterCol) then
begin
MasterCol.Expanded := not MasterCol.Expanded;
ReleaseCapture;
UpdateDesigner;
Exit;
end;
if ((csDesigning in ComponentState) or (dgColumnResize in Options)) and
(Cell.Y < FTitleOffset) then
begin
FDataLink.UpdateData;
inherited MouseDown(Button, Shift, X, Y);
Exit;
end;
if FDatalink.Active then
with Cell do
begin
BeginUpdate; { eliminates highlight flicker when selection moves }
try
FDatalink.UpdateData; // validate before moving
HideEditor;
OldCol := Col;
OldRow := Row;
if (Y >= FTitleOffset) and (Y - Row <> 0) then
FDatalink.MoveBy(Y - Row);
if X >= FIndicatorOffset then
MoveCol(X, 0);
if (dgMultiSelect in Options) and FDatalink.Active then
with FBookmarks do
begin
FSelecting := False;
if ssCtrl in Shift then
CurrentRowSelected := not CurrentRowSelected
else
begin
Clear;
CurrentRowSelected := True;
end;
end;
if (Button = mbLeft) and
(((X = OldCol) and (Y = OldRow)) or (dgAlwaysShowEditor in Options)) then
ShowEditor { put grid in edit mode }
else
InvalidateEditor; { draw editor, if needed }
finally
EndUpdate;
end;
end;
end;
procedure TbsSkinCustomDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Cell: TGridCoord;
SaveState: TbsGridState;
begin
SaveState := FGridState;
inherited MouseUp(Button, Shift, X, Y);
if (SaveState = gsRowSizing) or (SaveState = gsColSizing) or
((InplaceEditor <> nil) and (InplaceEditor.Visible) and
(PtInRect(InplaceEditor.BoundsRect, Point(X,Y)))) then Exit;
Cell := MouseCoord(X,Y);
if (Button = mbLeft) and (Cell.X >= FIndicatorOffset) and (Cell.Y >= 0) then
if Cell.Y < FTitleOffset then
TitleClick(Columns[RawToDataColumn(Cell.X)])
else
CellClick(Columns[SelectedIndex]);
end;
procedure TbsSkinCustomDBGrid.MoveCol(RawCol, Direction: Integer);
var
OldCol: Integer;
begin
FDatalink.UpdateData;
if RawCol >= ColCount then
RawCol := ColCount - 1;
if RawCol < FIndicatorOffset then RawCol := FIndicatorOffset;
if Direction <> 0 then
begin
while (RawCol < ColCount) and (RawCol >= FIndicatorOffset) and
(ColWidths[RawCol] <= 0) do
Inc(RawCol, Direction);
if (RawCol >= ColCount) or (RawCol < FIndicatorOffset) then Exit;
end;
OldCol := Col;
if RawCol <> OldCol then
begin
if not FInColExit then
begin
FInColExit := True;
try
ColExit;
finally
FInColExit := False;
end;
if Col <> OldCol then Exit;
end;
if not (dgAlwaysShowEditor in Options) then HideEditor;
Col := RawCol;
ColEnter;
end;
end;
procedure TbsSkinCustomDBGrid.Notification(AComponent: TComponent;
Operation: TOperation);
var
I: Integer;
NeedLayout: Boolean;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FSkinMessage <> nil) and
(AComponent = FSkinMessage) then FSkinMessage := nil;
if (Operation = opRemove) then
begin
if (AComponent is TPopupMenu) then
begin
for I := 0 to Columns.Count-1 do
if Columns[I].PopupMenu = AComponent then
Columns[I].PopupMenu := nil;
end
else if (FDataLink <> nil) then
if (AComponent = DataSource) then
DataSource := nil
else if (AComponent is TField) then
begin
NeedLayout := False;
BeginLayout;
try
for I := 0 to Columns.Count-1 do
with Columns[I] do
if Field = AComponent then
begin
Field := nil;
NeedLayout := True;
end;
finally
if NeedLayout and Assigned(FDatalink.Dataset)
and not FDatalink.Dataset.ControlsDisabled then
EndLayout
else
DeferLayout;
end;
end;
end;
end;
procedure TbsSkinCustomDBGrid.RecordChanged(Field: TField);
var
I: Integer;
CField: TField;
begin
if not HandleAllocated then Exit;
if Field = nil then
Invalidate
else
begin
for I := 0 to Columns.Count - 1 do
if Columns[I].Field = Field then
InvalidateCol(DataToRawColumn(I));
end;
CField := SelectedField;
if ((Field = nil) or (CField = Field)) and
(Assigned(CField) and (CField.Text <> FEditText) and
((SysLocale.PriLangID <> LANG_KOREAN) or FIsESCKey)) then
begin
InvalidateEditor;
if InplaceEditor <> nil then InplaceEditor.Deselect;
end;
end;
procedure TbsSkinCustomDBGrid.Scroll(Distance: Integer);
var
OldRect, NewRect: TRect;
RowHeight: Integer;
begin
if not HandleAllocated then Exit;
OldRect := BoxRect(0, Row, ColCount - 1, Row);
if (FDataLink.ActiveRecord >= RowCount - FTitleOffset) then UpdateRowCount;
UpdateScrollBar;
UpdateActive;
NewRect := BoxRect(0, Row, ColCount - 1, Row);
ValidateRect(Handle, @OldRect);
InvalidateRect(Handle, @OldRect, False);
InvalidateRect(Handle, @NewRect, False);
if Distance <> 0 then
begin
HideEditor;
try
if Abs(Distance) > VisibleRowCount then
begin
Invalidate;
Exit;
end
else
begin
RowHeight := DefaultRowHeight;
if dgRowLines in Options then Inc(RowHeight, GridLineWidth);
if dgIndicator in Options then
begin
OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
InvalidateRect(Handle, @OldRect, False);
end;
NewRect := BoxRect(0, FTitleOffset, ColCount - 1, 1000);
ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
0, nil, SW_Invalidate);
if dgIndicator in Options then
begin
NewRect := BoxRect(0, Row, ColCount - 1, Row);
InvalidateRect(Handle, @NewRect, False);
end;
end;
finally
if dgAlwaysShowEditor in Options then ShowEditor;
end;
end;
if UpdateLock = 0 then Update;
end;
procedure TbsSkinCustomDBGrid.SetColumns(Value: TbsDBGridColumns);
begin
Columns.Assign(Value);
end;
function ReadOnlyField(Field: TField): Boolean;
var
MasterField: TField;
begin
Result := Field.ReadOnly;
if not Result and (Field.FieldKind = fkLookup) then
begin
Result := True;
if Field.DataSet = nil then Exit;
MasterField := Field.Dataset.FindField(Field.KeyFields);
if MasterField = nil then Exit;
Result := MasterField.ReadOnly;
end;
end;
procedure TbsSkinCustomDBGrid.SetColumnAttributes;
var
I: Integer;
begin
for I := 0 to FColumns.Count-1 do
with FColumns[I] do
begin
TabStops[I + FIndicatorOffset] := Showing and not ReadOnly and DataLink.Active and
Assigned(Field) and not (Field.FieldKind = fkCalculated) and not ReadOnlyField(Field);
ColWidths[I + FIndicatorOffset] := Width;
end;
if (dgIndicator in Options) then
if FIndex = -1
then
ColWidths[0] := IndicatorWidth
else
if FixedCellLeftOffset + FixedCellRightOffset >= IndicatorWidth
then
ColWidths[0] := FixedCellLeftOffset + FixedCellRightOffset
else
ColWidths[0] := IndicatorWidth;
end;
procedure TbsSkinCustomDBGrid.SetDataSource(Value: TDataSource);
begin
if Value = FDatalink.Datasource then Exit;
FBookmarks.Clear;
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TbsSkinCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
FEditText := Value;
end;
procedure TbsSkinCustomDBGrid.SetOptions(Value: TbsDBGridOptions);
const
LayoutOptions = [dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
var
NewGridOptions: TGridOptions;
ChangedOptions: TbsDBGridOptions;
begin
if FOptions <> Value then
begin
NewGridOptions := [];
if dgColLines in Value then
NewGridOptions := NewGridOptions + [goFixedVertLine, goVertLine];
if dgRowLines in Value then
NewGridOptions := NewGridOptions + [goFixedHorzLine, goHorzLine];
if dgColumnResize in Value then
NewGridOptions := NewGridOptions + [goColSizing, goColMoving];
if dgTabs in Value then Include(NewGridOptions, goTabs);
if dgRowSelect in Value then
begin
Include(NewGridOptions, goRowSelect);
Exclude(Value, dgAlwaysShowEditor);
Exclude(Value, dgEditing);
end;
if dgEditing in Value then Include(NewGridOptions, goEditing);
if dgAlwaysShowEditor in Value then Include(NewGridOptions, goAlwaysShowEditor);
inherited Options := NewGridOptions;
if dgMultiSelect in (FOptions - Value) then FBookmarks.Clear;
ChangedOptions := (FOptions + Value) - (FOptions * Value);
FOptions := Value;
if ChangedOptions * LayoutOptions <> [] then LayoutChanged;
end;
end;
procedure TbsSkinCustomDBGrid.SetSelectedField(Value: TField);
var
I: Integer;
begin
if Value = nil then Exit;
for I := 0 to Columns.Count - 1 do
if Columns[I].Field = Value then
MoveCol(DataToRawColumn(I), 0);
end;
procedure TbsSkinCustomDBGrid.SetSelectedIndex(Value: Integer);
begin
MoveCol(DataToRawColumn(Value), 0);
end;
procedure TbsSkinCustomDBGrid.SetTitleFont(Value: TFont);
begin
FTitleFont.Assign(Value);
if dgTitles in Options then LayoutChanged;
end;
function TbsSkinCustomDBGrid.StoreColumns: Boolean;
begin
Result := Columns.State = csCustomized;
end;
procedure TbsSkinCustomDBGrid.TimedScroll(Direction: TGridScrollDirection);
begin
if FDatalink.Active then
begin
with FDatalink do
begin
if sdUp in Direction then
begin
FDataLink.MoveBy(-ActiveRecord - 1);
Exclude(Direction, sdUp);
end;
if sdDown in Direction then
begin
FDataLink.MoveBy(RecordCount - ActiveRecord);
Exclude(Direction, sdDown);
end;
end;
if Direction <> [] then inherited TimedScroll(Direction);
end;
end;
procedure TbsSkinCustomDBGrid.TitleClick(Column: TbsColumn);
begin
if Assigned(FOnTitleClick) then FOnTitleClick(Column);
end;
procedure TbsSkinCustomDBGrid.TitleFontChanged(Sender: TObject);
begin
if (not FSelfChangingTitleFont) and not (csLoading in ComponentState) then
ParentFont := False;
if dgTitles in Options then LayoutChanged;
end;
procedure TbsSkinCustomDBGrid.UpdateActive;
var
NewRow: Integer;
Field: TField;
begin
if FDatalink.Active and HandleAllocated and not (csLoading in ComponentState) then
begin
NewRow := FDatalink.ActiveRecord + FTitleOffset;
if Row <> NewRow then
begin
if not (dgAlwaysShowEditor in Options) then HideEditor;
MoveColRow(Col, NewRow, False, False);
InvalidateEditor;
end;
Field := SelectedField;
if Assigned(Field) and (Field.Text <> FEditText) then
InvalidateEditor;
end;
end;
procedure TbsSkinCustomDBGrid.UpdateData;
var
Field: TField;
begin
Field := SelectedField;
if Assigned(Field) then
Field.Text := FEditText;
end;
procedure TbsSkinCustomDBGrid.UpdateRowCount;
var
OldRowCount: Integer;
begin
OldRowCount := RowCount;
if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
FixedRows := FTitleOffset;
with FDataLink do
if not Active or (RecordCount = 0) or not HandleAllocated then
RowCount := 1 + FTitleOffset
else
begin
RowCount := 1000;
FDataLink.BufferCount := VisibleRowCount;
RowCount := RecordCount + FTitleOffset;
if dgRowSelect in Options then TopRow := FixedRows;
UpdateActive;
end;
if OldRowCount <> RowCount then Invalidate;
end;
type
TParentControl = class(TWinControl);
procedure TbsSkinCustomDBGrid.UpdateScrollBar;
var
Pos: Integer;
OldVisible, VVisible, VVisibleChanged: Boolean;
R: TRect;
begin
VVisibleChanged := False;
if FDatalink.Active and HandleAllocated then
with FDatalink.DataSet do
begin
if (VScrollBar <> nil)
then
begin
OldVisible := VScrollBar.Visible;
VVisible := Self.RowCount >= Self.VisibleRowCount;
VVisibleChanged := OldVisible <> VVisible;
if IsSequenced
then
begin
if RecNo <> -1
then
VScrollBar.SetRange(1, Integer(DWORD(RecordCount)) + Self.VisibleRowCount - 1,
RecNo, Self.VisibleRowCount);
end
else
begin
if FDataLink.BOF then Pos := 0
else if FDataLink.EOF then Pos := 4
else Pos := 2;
VScrollBar.SetRange(0, 4, Pos, 0);
end;
end;
end
else
if (VScrollBar <> nil) and VScrollBar.Visible
then
begin
VVisible := False;
VVisibleChanged := True;
end;
FInCheckScrollBars := True;
if VVisibleChanged then VScrollBar.Visible := VVisible;
FInCheckScrollBars := False;
if (VScrollBar <> nil) and (HScrollBar <> nil)
then
begin
if not VScrollBar.Visible and HScrollBar.Both
then
HScrollBar.Both := False
else
if VScrollBar.Visible and not HScrollBar.Both
then
HScrollBar.Both := True;
end;
if (Self.Align <> alNone) and VVisibleChanged
then
begin
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := True;
Invalidate;
FInCheckScrollBars := False;
end;
end;
function TbsSkinCustomDBGrid.ValidFieldIndex(FieldIndex: Integer): Boolean;
begin
Result := DataLink.GetMappedIndex(FieldIndex) >= 0;
end;
procedure TbsSkinCustomDBGrid.CMParentFontChanged(var Message: TMessage);
begin
inherited;
if ParentFont then
begin
FSelfChangingTitleFont := True;
try
TitleFont := Font;
finally
FSelfChangingTitleFont := False;
end;
LayoutChanged;
end;
end;
procedure TbsSkinCustomDBGrid.CMBiDiModeChanged(var Message: TMessage);
var
Loop: Integer;
begin
inherited;
for Loop := 0 to ComponentCount - 1 do
if Components[Loop] is TbsSkinCustomDBGrid then
with Components[Loop] as TbsSkinCustomDBGrid do
{ Changing the window, echos down to the subgrid }
if Parent <> nil then
Parent.BiDiMode := Self.BiDiMode;
end;
procedure TbsSkinCustomDBGrid.CMExit(var Message: TMessage);
begin
try
if FDatalink.Active then
with FDatalink.Dataset do
if (dgCancelOnExit in Options) and (State = dsInsert) and
not Modified and not FDatalink.FModified then
Cancel else
FDataLink.UpdateData;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TbsSkinCustomDBGrid.CMFontChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
BeginLayout;
try
for I := 0 to Columns.Count-1 do
Columns[I].RefreshDefaultFont;
finally
EndLayout;
end;
end;
procedure TbsSkinCustomDBGrid.CMDeferLayout(var Message);
begin
if AcquireLayoutLock then
EndLayout
else
DeferLayout;
end;
procedure TbsSkinCustomDBGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
var
MasterCol: TbsColumn;
begin
inherited;
if (Msg.Result = 1) and ((FDataLink = nil) or
((Columns.State = csDefault) and
(FDataLink.DefaultFields or (not FDataLink.Active)))) then
Msg.Result := 0
else if (Msg.Result = 0) and (FDataLink <> nil) and (FDataLink.Active)
and (Columns.State = csCustomized)
and PtInExpandButton(Msg.XPos, Msg.YPos, MasterCol) then
Msg.Result := 1;
end;
procedure TbsSkinCustomDBGrid.WMSetCursor(var Msg: TWMSetCursor);
begin
if (csDesigning in ComponentState) and
((FDataLink = nil) or
((Columns.State = csDefault) and
(FDataLink.DefaultFields or not FDataLink.Active))) then
Windows.SetCursor(LoadCursor(0, IDC_ARROW))
else inherited;
end;
procedure TbsSkinCustomDBGrid.WMSize(var Message: TWMSize);
begin
inherited;
if UpdateLock = 0 then UpdateRowCount;
InvalidateTitles;
end;
procedure TbsSkinCustomDBGrid.WMVScroll(var Message: TWMVScroll);
begin
if not AcquireFocus then Exit;
if FDatalink.Active then
with Message, FDataLink.DataSet do
case ScrollCode of
SB_LINEUP: FDataLink.MoveBy(-FDatalink.ActiveRecord - 1);
SB_LINEDOWN: FDataLink.MoveBy(FDatalink.RecordCount - FDatalink.ActiveRecord);
SB_PAGEUP: FDataLink.MoveBy(-VisibleRowCount);
SB_PAGEDOWN: FDataLink.MoveBy(VisibleRowCount);
SB_THUMBPOSITION:
if (VScrollBar <> nil)
then
with VScrollBar do
begin
if IsSequenced
then
begin
if Position <= 1 then First
else if Position >= RecordCount then Last
else RecNo := Position;
end
else
case Position of
0: First;
1: FDataLink.MoveBy(-VisibleRowCount);
2: Exit;
3: FDataLink.MoveBy(VisibleRowCount);
4: Last;
end;
end;
SB_BOTTOM: Last;
SB_TOP: First;
end;
end;
procedure TbsSkinCustomDBGrid.SetIme;
var
Column: TbsColumn;
begin
if not SysLocale.FarEast then Exit;
if Columns.Count = 0 then Exit;
ImeName := FOriginalImeName;
ImeMode := FOriginalImeMode;
Column := Columns[SelectedIndex];
if Column.IsImeNameStored then ImeName := Column.ImeName;
if Column.IsImeModeStored then ImeMode := Column.ImeMode;
if InplaceEditor <> nil then
begin
TDBGridInplaceEdit(Self).ImeName := ImeName;
TDBGridInplaceEdit(Self).ImeMode := ImeMode;
end;
end;
procedure TbsSkinCustomDBGrid.UpdateIme;
begin
if not SysLocale.FarEast then Exit;
SetIme;
SetImeName(ImeName);
SetImeMode(Handle, ImeMode);
end;
procedure TbsSkinCustomDBGrid.WMIMEStartComp(var Message: TMessage);
begin
inherited;
ShowEditor;
end;
procedure TbsSkinCustomDBGrid.WMSetFocus(var Message: TWMSetFocus);
begin
if not ((InplaceEditor <> nil) and
(Message.FocusedWnd = InplaceEditor.Handle)) then SetIme;
inherited;
end;
procedure TbsSkinCustomDBGrid.WMKillFocus(var Message: TMessage);
begin
if not SysLocale.FarEast then inherited
else
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
inherited;
if not ((InplaceEditor <> nil) and
(HWND(Message.WParam) = InplaceEditor.Handle)) then
ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
end;
end;
{ Defer action processing to datalink }
function TbsSkinCustomDBGrid.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := (DataLink <> nil) and DataLink.ExecuteAction(Action);
end;
function TbsSkinCustomDBGrid.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := (DataLink <> nil) and DataLink.UpdateAction(Action);
end;
procedure TbsSkinCustomDBGrid.ShowPopupEditor(Column: TbsColumn; X, Y: Integer);
var
SubGrid: TbsSkinCustomDBGrid;
DS: TDataSource;
I: Integer;
FloatRect: TRect;
Cmp: TControl;
begin
if not ((Column.Field <> nil) and (Column.Field is TDataSetField)) then Exit;
// find existing popup for this column field, if any, and show it
for I := 0 to ComponentCount-1 do
if Components[I] is TbsSkinCustomDBGrid then
begin
SubGrid := TbsSkinCustomDBGrid(Components[I]);
if (SubGrid.DataSource <> nil) and
(SubGrid.DataSource.DataSet = (Column.Field as TDatasetField).NestedDataset) and
SubGrid.CanFocus then
begin
SubGrid.Parent.Show;
SubGrid.SetFocus;
Exit;
end;
end;
// create another instance of this kind of grid
SubGrid := TbsSkinCustomDBGrid(TComponentClass(Self.ClassType).Create(Self));
try
DS := TDataSource.Create(SubGrid); // incestuous, but easy cleanup
DS.Dataset := (Column.Field as TDatasetField).NestedDataset;
DS.DataSet.CheckBrowseMode;
SubGrid.DataSource := DS;
SubGrid.Columns.State := Columns.State;
SubGrid.Columns[0].Expanded := True;
SubGrid.Visible := False;
SubGrid.FloatingDockSiteClass := TCustomDockForm;
FloatRect.TopLeft := ClientToScreen(CellRect(Col, Row).BottomRight);
if X > Low(Integer) then FloatRect.Left := X;
if Y > Low(Integer) then FloatRect.Top := Y;
FloatRect.Right := FloatRect.Left + Width;
FloatRect.Bottom := FloatRect.Top + Height;
SubGrid.ManualFloat(FloatRect);
// SubGrid.ManualDock(nil,nil,alClient);
SubGrid.Parent.BiDiMode := Self.BiDiMode; { This carries the BiDi setting }
I := SubGrid.CellRect(SubGrid.ColCount-1, 0).Right;
if (I > 0) and (I < Screen.Width div 2) then
SubGrid.Parent.ClientWidth := I
else
SubGrid.Parent.Width := Screen.Width div 4;
SubGrid.Parent.Height := Screen.Height div 4;
SubGrid.Align := alClient;
SubGrid.DragKind := dkDock;
SubGrid.Color := Color;
SubGrid.Ctl3D := Ctl3D;
SubGrid.Cursor := Cursor;
SubGrid.Enabled := Enabled;
SubGrid.FixedColor := FixedColor;
SubGrid.Font := Font;
SubGrid.HelpContext := HelpContext;
SubGrid.IMEMode := IMEMode;
SubGrid.IMEName := IMEName;
SubGrid.Options := Options;
Cmp := Self;
while (Cmp <> nil) and (TbsSkinCustomDBGrid(Cmp).PopupMenu = nil) do
Cmp := Cmp.Parent;
if Cmp <> nil then
SubGrid.PopupMenu := TbsSkinCustomDBGrid(Cmp).PopupMenu;
SubGrid.TitleFont := TitleFont;
SubGrid.Visible := True;
SubGrid.Parent.Show;
except
SubGrid.Free;
raise;
end;
end;
procedure TbsSkinCustomDBGrid.CalcSizingState(X, Y: Integer;
var State: TbsGridState; var Index, SizingPos, SizingOfs: Integer;
var FixedInfo: TbsGridDrawInfo);
var
R: TGridCoord;
begin
inherited CalcSizingState(X, Y, State, Index, SizingPos, SizingOfs, FixedInfo);
if (State = gsColSizing) and (FDataLink <> nil)
and (FDatalink.Dataset <> nil) and FDataLink.Dataset.ObjectView then
begin
R := MouseCoord(X, Y);
R.X := RawToDataColumn(R.X);
if (R.X >= 0) and (R.X < Columns.Count) and (Columns[R.X].Depth > R.Y) then
State := gsNormal;
end;
end;
function TbsSkinCustomDBGrid.CheckColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean;
var
I, ARow: Integer;
DestCol: TbsColumn;
begin
Result := inherited CheckColumnDrag(Origin, Destination, MousePt);
if Result and (FDatalink.Dataset <> nil) and FDatalink.Dataset.ObjectView then
begin
assert(FDragCol <> nil);
ARow := FDragCol.Depth;
if Destination <> Origin then
begin
DestCol := ColumnAtDepth(Columns[RawToDataColumn(Destination)], ARow);
if DestCol.ParentColumn <> FDragCol.ParentColumn then
if Destination < Origin then
DestCol := Columns[FDragCol.ParentColumn.Index+1]
else
begin
I := DestCol.Index;
while DestCol.ParentColumn <> FDragCol.ParentColumn do
begin
Dec(I);
DestCol := Columns[I];
end;
end;
if (DestCol.Index > FDragCol.Index) then
begin
I := DestCol.Index + 1;
while (I < Columns.Count) and (ColumnAtDepth(Columns[I],ARow) = DestCol) do
Inc(I);
DestCol := Columns[I-1];
end;
Destination := DataToRawColumn(DestCol.Index);
end;
end;
end;
function TbsSkinCustomDBGrid.BeginColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean;
var
I, ARow: Integer;
begin
Result := inherited BeginColumnDrag(Origin, Destination, MousePt);
if Result and (FDatalink.Dataset <> nil) and FDatalink.Dataset.ObjectView then
begin
ARow := MouseCoord(MousePt.X, MousePt.Y).Y;
FDragCol := ColumnAtDepth(Columns[RawToDataColumn(Origin)], ARow);
if FDragCol = nil then Exit;
I := DataToRawColumn(FDragCol.Index);
if Origin <> I then Origin := I;
Destination := Origin;
end;
end;
function TbsSkinCustomDBGrid.EndColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean;
begin
Result := inherited EndColumnDrag(Origin, Destination, MousePt);
FDragCol := nil;
end;
procedure TbsSkinCustomDBGrid.InvalidateTitles;
var
R: TRect;
DrawInfo: TbsGridDrawInfo;
begin
if HandleAllocated and (dgTitles in Options) then
begin
CalcFixedInfo(DrawInfo);
R := Rect(0, 0, Width, DrawInfo.Vert.FixedBoundary);
InvalidateRect(Handle, @R, False);
end;
end;
procedure TbsSkinCustomDBGrid.TopLeftChanged;
begin
InvalidateTitles;
inherited TopLeftChanged;
end;
end.