Files

1176 lines
36 KiB
ObjectPascal

{*****************************************************************************}
{ }
{ Tnt Delphi Unicode Controls }
{ http://www.tntware.com/delphicontrols/unicode/ }
{ Version: 2.3.0 }
{ }
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
{ }
{*****************************************************************************}
unit TntDBGrids;
{$INCLUDE compilers.inc}
interface
uses
Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;
type
{TNT-WARN TColumnTitle}
TTntColumnTitle = class(TColumnTitle{TNT-ALLOW TColumnTitle})
private
FCaption: WideString;
procedure SetInheritedCaption(const Value: AnsiString);
function GetCaption: WideString;
procedure SetCaption(const Value: WideString);
function IsCaptionStored: Boolean;
protected
procedure DefineProperties(Filer: TFiler); override;
public
procedure Assign(Source: TPersistent); override;
procedure RestoreDefaults; override;
function DefaultCaption: WideString;
published
property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
end;
{TNT-WARN TColumn}
type
TTntColumn = class(TColumn{TNT-ALLOW TColumn})
private
FWidePickList: TTntStrings;
function GetWidePickList: TTntStrings;
procedure SetWidePickList(const Value: TTntStrings);
procedure HandlePickListChange(Sender: TObject);
function GetTitle: TTntColumnTitle;
procedure SetTitle(const Value: TTntColumnTitle);
protected
procedure DefineProperties(Filer: TFiler); override;
function CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle}; override;
public
destructor Destroy; override;
property WidePickList: TTntStrings read GetWidePickList write SetWidePickList;
published
{TNT-WARN PickList}
property PickList{TNT-ALLOW PickList}: TTntStrings read GetWidePickList write SetWidePickList;
property Title: TTntColumnTitle read GetTitle write SetTitle;
end;
{ TDBGridInplaceEdit adds support for a button on the in-place editor,
which can be used to drop down a table-based lookup list, a stringlist-based
pick list, or (if button style is esEllipsis) fire the grid event
OnEditButtonClick. }
type
TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEditList)
private
{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
FDataList: TDBLookupListBox; // 1st field - Delphi/BCB 6 TCustomDBGrid assumes this
FUseDataList: Boolean; // 2nd field - Delphi/BCB 6 TCustomDBGrid assumes this
{$ENDIF}
{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
FDataList: TDBLookupListBox; // 1st field - Delphi 7 TCustomDBGrid assumes this
FUseDataList: Boolean; // 2nd field - Delphi 7 TCustomDBGrid assumes this
{$ENDIF}
{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
FDataList: TDBLookupListBox; // 1st field - Delphi 9 TCustomDBGrid assumes this
FUseDataList: Boolean; // 2nd field - Delphi 9 TCustomDBGrid assumes this
{$ENDIF}
{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
FDataList: TDBLookupListBox; // 1st field - Delphi 10 TCustomDBGrid assumes this
FUseDataList: Boolean; // 2nd field - Delphi 10 TCustomDBGrid assumes this
{$ENDIF}
FLookupSource: TDatasource;
FWidePickListBox: TTntCustomListbox;
function GetWidePickListBox: TTntCustomListbox;
protected
procedure CloseUp(Accept: Boolean); override;
procedure DoEditButtonClick; override;
procedure DropDown; override;
procedure UpdateContents; override;
property UseDataList: Boolean read FUseDataList;
public
constructor Create(Owner: TComponent); override;
property DataList: TDBLookupListBox read FDataList;
property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
end;
type
{TNT-WARN TDBGridInplaceEdit}
TTntDBGridInplaceEdit = class(TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit})
private
FInDblClick: Boolean;
FBlockSetText: Boolean;
procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
protected
function GetText: WideString; virtual;
procedure SetText(const Value: WideString); virtual;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure UpdateContents; override;
procedure DblClick; override;
public
property Text: WideString read GetText write SetText;
end;
{TNT-WARN TDBGridColumns}
TTntDBGridColumns = class(TDBGridColumns{TNT-ALLOW TDBGridColumns})
private
function GetColumn(Index: Integer): TTntColumn;
procedure SetColumn(Index: Integer; const Value: TTntColumn);
public
function Add: TTntColumn;
property Items[Index: Integer]: TTntColumn read GetColumn write SetColumn; default;
end;
TTntGridDataLink = class(TGridDataLink)
private
OriginalSetText: TFieldSetTextEvent;
procedure GridUpdateFieldText(Sender: TField; const Text: AnsiString);
protected
procedure UpdateData; override;
procedure RecordChanged(Field: TField); override;
end;
{TNT-WARN TCustomDBGrid}
TTntCustomDBGrid = class(TCustomDBGrid{TNT-ALLOW TCustomDBGrid})
private
FEditText: WideString;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
function GetColumns: TTntDBGridColumns;
procedure SetColumns(const Value: TTntDBGridColumns);
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure ShowEditorChar(Ch: WideChar); dynamic;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns}; override;
property Columns: TTntDBGridColumns read GetColumns write SetColumns;
function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
function CreateDataLink: TGridDataLink; override;
function GetEditText(ACol, ARow: Longint): WideString; reintroduce;
procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
procedure SetEditText(ACol, ARow: Longint; const Value: AnsiString); override;
public
procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TTntColumn; State: TGridDrawState); dynamic;
procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TDBGrid}
TTntDBGrid = class(TTntCustomDBGrid)
public
property Canvas;
property SelectedRows;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns stored False; //StoreColumns;
property Constraints;
property Ctl3D;
property DataSource;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property Font;
property ImeMode;
property ImeName;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property TitleFont;
property Visible;
property OnCellClick;
property OnColEnter;
property OnColExit;
property OnColumnMoved;
property OnDrawDataCell; { obsolete }
property OnDrawColumnCell;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditButtonClick;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
{$IFDEF COMPILER_9_UP}
property OnMouseActivate;
{$ENDIF}
property OnMouseDown;
{$IFDEF COMPILER_10_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnStartDock;
property OnStartDrag;
property OnTitleClick;
end;
implementation
uses
SysUtils, TntControls, Math, Variants, Forms,
TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;
{ TTntColumnTitle }
procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntColumnTitle.DefaultCaption: WideString;
var
Field: TField;
begin
Field := Column.Field;
if Assigned(Field) then
Result := Field.DisplayName
else
Result := Column.FieldName;
end;
function TTntColumnTitle.IsCaptionStored: Boolean;
begin
Result := (cvTitleCaption in Column.AssignedValues) and
(FCaption <> DefaultCaption);
end;
procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
begin
inherited Caption := Value;
end;
function TTntColumnTitle.GetCaption: WideString;
begin
if cvTitleCaption in Column.AssignedValues then
Result := GetSyncedWideString(FCaption, inherited Caption)
else
Result := DefaultCaption;
end;
procedure TTntColumnTitle.SetCaption(const Value: WideString);
begin
if not (Column as TTntColumn).IsStored then
inherited Caption := Value
else begin
if (cvTitleCaption in Column.AssignedValues) and (Value = FCaption) then Exit;
SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
end;
end;
procedure TTntColumnTitle.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TTntColumnTitle then
begin
if cvTitleCaption in TTntColumnTitle(Source).Column.AssignedValues then
Caption := TTntColumnTitle(Source).Caption;
end;
end;
procedure TTntColumnTitle.RestoreDefaults;
begin
FCaption := '';
inherited;
end;
{ TTntColumn }
procedure TTntColumn.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
begin
Result := TTntColumnTitle.Create(Self);
end;
function TTntColumn.GetTitle: TTntColumnTitle;
begin
Result := (inherited Title) as TTntColumnTitle;
end;
procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
begin
inherited Title := Value;
end;
function TTntColumn.GetWidePickList: TTntStrings;
begin
if FWidePickList = nil then begin
FWidePickList := TTntStringList.Create;
TTntStringList(FWidePickList).OnChange := HandlePickListChange;
end;
Result := FWidePickList;
end;
procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
begin
if Value = nil then
begin
FWidePickList.Free;
FWidePickList := nil;
(inherited PickList{TNT-ALLOW PickList}).Clear;
Exit;
end;
WidePickList.Assign(Value);
end;
procedure TTntColumn.HandlePickListChange(Sender: TObject);
begin
inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
end;
destructor TTntColumn.Destroy;
begin
inherited;
FWidePickList.Free;
end;
{ TTntPopupListbox }
type
TTntPopupListbox = class(TTntCustomListbox)
private
FSearchText: WideString;
FSearchTickCount: Longint;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure WMChar(var Message: TWMChar); message WM_CHAR;
procedure KeyPressW(var Key: WideChar);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;
procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TTntPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;
procedure TTntPopupListbox.WMChar(var Message: TWMChar);
var
Key: WideChar;
begin
Key := GetWideCharFromWMCharMsg(Message);
KeyPressW(Key);
SetWideCharForWMCharMsg(Message, Key);
inherited;
end;
procedure TTntPopupListbox.KeypressW(var Key: WideChar);
var
TickCount: Integer;
begin
case Key of
#8, #27: FSearchText := '';
#32..High(WideChar):
begin
TickCount := GetTickCount;
if TickCount - FSearchTickCount > 2000 then FSearchText := '';
FSearchTickCount := TickCount;
if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
if IsWindowUnicode(Handle) then
SendMessageW(Handle, LB_SelectString, WORD(-1), Longint(PWideChar(FSearchText)))
else
SendMessageA(Handle, LB_SelectString, WORD(-1), Longint(PAnsiChar(AnsiString(FSearchText))));
Key := #0;
end;
end;
end;
procedure TTntPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
(Owner as TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;
{ TTntPopupDataList }
type
TTntPopupDataList = class(TPopupDataList)
protected
procedure Paint; override;
end;
procedure TTntPopupDataList.Paint;
var
FRecordIndex: Integer;
FRecordCount: Integer;
FKeySelected: Boolean;
FKeyField: TField;
procedure UpdateListVars;
begin
if ListActive then
begin
FRecordIndex := ListLink.ActiveRecord;
FRecordCount := ListLink.RecordCount;
FKeySelected := not VarIsNull(KeyValue) or
not ListLink.DataSet.BOF;
end else
begin
FRecordIndex := 0;
FRecordCount := 0;
FKeySelected := False;
end;
FKeyField := nil;
if ListLink.Active and (KeyField <> '') then
FKeyField := GetFieldProperty(ListLink.DataSet, Self, KeyField);
end;
function VarEquals(const V1, V2: Variant): Boolean;
begin
Result := False;
try
Result := V1 = V2;
except
end;
end;
var
I, J, W, X, TxtWidth, TxtHeight, LastFieldIndex: Integer;
S: WideString;
R: TRect;
Selected: Boolean;
Field: TField;
AAlignment: TAlignment;
begin
UpdateListVars;
Canvas.Font := Font;
TxtWidth := WideCanvasTextWidth(Canvas, '0');
TxtHeight := WideCanvasTextHeight(Canvas, '0');
LastFieldIndex := ListFields.Count - 1;
if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
Canvas.Pen.Color := clBtnFace else
Canvas.Pen.Color := clBtnShadow;
for I := 0 to RowCount - 1 do
begin
if Enabled then
Canvas.Font.Color := Font.Color else
Canvas.Font.Color := clGrayText;
Canvas.Brush.Color := Color;
Selected := not FKeySelected and (I = 0);
R.Top := I * TxtHeight;
R.Bottom := R.Top + TxtHeight;
if I < FRecordCount then
begin
ListLink.ActiveRecord := I;
if not VarIsNull(KeyValue) and
VarEquals(FKeyField.Value, KeyValue) then
begin
Canvas.Font.Color := clHighlightText;
Canvas.Brush.Color := clHighlight;
Selected := True;
end;
R.Right := 0;
for J := 0 to LastFieldIndex do
begin
Field := ListFields[J];
if J < LastFieldIndex then
W := Field.DisplayWidth * TxtWidth + 4 else
W := ClientWidth - R.Right;
S := GetWideDisplayText(Field);
X := 2;
AAlignment := Field.Alignment;
if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
case AAlignment of
taRightJustify: X := W - WideCanvasTextWidth(Canvas, S) - 3;
taCenter: X := (W - WideCanvasTextWidth(Canvas, S)) div 2;
end;
R.Left := R.Right;
R.Right := R.Right + W;
if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
WideCanvasTextRect(Canvas, R, R.Left + X, R.Top, S);
if J < LastFieldIndex then
begin
Canvas.MoveTo(R.Right, R.Top);
Canvas.LineTo(R.Right, R.Bottom);
Inc(R.Right);
if R.Right >= ClientWidth then Break;
end;
end;
end;
R.Left := 0;
R.Right := ClientWidth;
if I >= FRecordCount then Canvas.FillRect(R);
if Selected then
Canvas.DrawFocusRect(R);
end;
if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
end;
//-----------------------------------------------------------------------------------------
// TDBGridInplaceEdit - Delphi 6 and higher
//-----------------------------------------------------------------------------------------
constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
begin
inherited Create(Owner);
FLookupSource := TDataSource.Create(Self);
end;
function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
var
PopupListbox: TTntPopupListbox;
begin
if not Assigned(FWidePickListBox) then
begin
PopupListbox := TTntPopupListbox.Create(Self);
PopupListbox.Visible := False;
PopupListbox.Parent := Self;
PopupListbox.OnMouseUp := ListMouseUp;
PopupListbox.IntegralHeight := True;
PopupListbox.ItemHeight := 11;
FWidePickListBox := PopupListBox;
end;
Result := FWidePickListBox;
end;
procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
var
MasterField: TField;
ListValue: Variant;
begin
if ListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if ActiveList = DataList then
ListValue := DataList.KeyValue
else
if WidePickListBox.ItemIndex <> -1 then
ListValue := WidePickListBox.Items[WidePickListBox.ItemIndex];
SetWindowPos(ActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
ListVisible := False;
if Assigned(FDataList) then
FDataList.ListSource := nil;
FLookupSource.Dataset := nil;
Invalidate;
if Accept then
if ActiveList = DataList then
with Grid as TTntCustomDBGrid, Columns[SelectedIndex].Field do
begin
MasterField := DataSet.FieldByName(KeyFields);
if MasterField.CanModify and DataLink.Edit then
MasterField.Value := ListValue;
end
else
if (not VarIsNull(ListValue)) and EditCanModify then
with Grid as TTntCustomDBGrid do
SetWideText(Columns[SelectedIndex].Field, ListValue)
end;
end;
procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoEditButtonClick;
begin
(Grid as TTntCustomDBGrid).EditButtonClick;
end;
type TAccessTntCustomListbox = class(TTntCustomListbox);
procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
var
Column: TTntColumn;
I, J, Y: Integer;
begin
if not ListVisible then
begin
with (Grid as TTntCustomDBGrid) do
Column := Columns[SelectedIndex] as TTntColumn;
if ActiveList = FDataList then
with Column.Field do
begin
FDataList.Color := Color;
FDataList.Font := Font;
FDataList.RowCount := Column.DropDownRows;
FLookupSource.DataSet := LookupDataSet;
FDataList.KeyField := LookupKeyFields;
FDataList.ListField := LookupResultField;
FDataList.ListSource := FLookupSource;
FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
end
else if ActiveList = WidePickListBox then
begin
WidePickListBox.Items.Assign(Column.WidePickList);
DropDownRows := Column.DropDownRows;
// this is needed as inherited doesn't know about our WidePickListBox
if (DropDownRows > 0) and (WidePickListBox.Items.Count >= DropDownRows) then
WidePickListBox.Height := DropDownRows * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4
else
WidePickListBox.Height := WidePickListBox.Items.Count * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4;
if Text = '' then
WidePickListBox.ItemIndex := -1
else
WidePickListBox.ItemIndex := WidePickListBox.Items.IndexOf(Text);
J := WidePickListBox.ClientWidth;
for I := 0 to WidePickListBox.Items.Count - 1 do
begin
Y := WideCanvasTextWidth(WidePickListBox.Canvas, WidePickListBox.Items[I]);
if Y > J then J := Y;
end;
WidePickListBox.ClientWidth := J;
end;
end;
inherited DropDown;
end;
procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
var
Column: TTntColumn;
begin
inherited UpdateContents;
if EditStyle = esPickList then
ActiveList := WidePickListBox;
if FUseDataList then
begin
if FDataList = nil then
begin
FDataList := TTntPopupDataList.Create(Self);
FDataList.Visible := False;
FDataList.Parent := Self;
FDataList.OnMouseUp := ListMouseUp;
end;
ActiveList := FDataList;
end;
with (Grid as TTntCustomDBGrid) do
Column := Columns[SelectedIndex] as TTntColumn;
Self.ReadOnly := Column.ReadOnly;
Font.Assign(Column.Font);
ImeMode := Column.ImeMode;
ImeName := Column.ImeName;
end;
//-----------------------------------------------------------------------------------------
{ TTntDBGridInplaceEdit }
procedure TTntDBGridInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
function TTntDBGridInplaceEdit.GetText: WideString;
begin
Result := TntControl_GetText(Self);
end;
procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
begin
TntControl_SetText(Self, Value);
end;
procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
begin
if (not FBlockSetText) then
inherited;
end;
procedure TTntDBGridInplaceEdit.UpdateContents;
var
Grid: TTntCustomDBGrid;
begin
Grid := Self.Grid as TTntCustomDBGrid;
EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
Text := Grid.GetEditText(Grid.Col, Grid.Row);
MaxLength := Grid.GetEditLimit;
FBlockSetText := True;
try
inherited;
finally
FBlockSetText := False;
end;
end;
procedure TTntDBGridInplaceEdit.DblClick;
begin
FInDblClick := True;
try
inherited;
finally
FInDblClick := False;
end;
end;
{ TTntGridDataLink }
procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
begin
Sender.OnSetText := OriginalSetText;
if Assigned(Sender) then
SetWideText(Sender, (Grid as TTntCustomDBGrid).FEditText);
end;
procedure TTntGridDataLink.RecordChanged(Field: TField);
var
CField: TField;
begin
inherited;
if Grid.HandleAllocated then begin
CField := Grid.SelectedField;
if ((Field = nil) or (CField = Field)) and
(Assigned(CField) and (GetWideText(CField) <> (Grid as TTntCustomDBGrid).FEditText)) then
begin
with (Grid as TTntCustomDBGrid) do begin
InvalidateEditor;
if InplaceEditor <> nil then InplaceEditor.Deselect;
end;
end;
end;
end;
procedure TTntGridDataLink.UpdateData;
var
Field: TField;
begin
Field := (Grid as TTntCustomDBGrid).SelectedField;
// remember "set text"
if Field <> nil then
OriginalSetText := Field.OnSetText;
try
// redirect "set text" to self
if Field <> nil then
Field.OnSetText := GridUpdateFieldText;
inherited; // clear modified !
finally
// redirect "set text" to field
if Field <> nil then
Field.OnSetText := OriginalSetText;
// forget original "set text"
OriginalSetText := nil;
end;
end;
{ TTntDBGridColumns }
function TTntDBGridColumns.Add: TTntColumn;
begin
Result := inherited Add as TTntColumn;
end;
function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
begin
Result := inherited Items[Index] as TTntColumn;
end;
procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
begin
inherited Items[Index] := Value;
end;
{ TTntCustomDBGrid }
procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
type TAccessCustomGrid = class(TCustomGrid);
procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
begin
if (goEditing in TAccessCustomGrid(Self).Options)
and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
RestoreWMCharMsg(TMessage(Msg));
ShowEditorChar(WideChar(Msg.CharCode));
end else
inherited;
end;
procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
begin
ShowEditor;
if InplaceEditor <> nil then begin
if Win32PlatformIsUnicode then
PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
else
PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
end;
end;
procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomDBGrid.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntCustomDBGrid.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomDBGrid.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
begin
Result := TTntDBGridColumns.Create(Self, TTntColumn);
end;
function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
begin
Result := inherited Columns as TTntDBGridColumns;
end;
procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
begin
inherited Columns := Value;
end;
function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
begin
Result := TTntDBGridInplaceEdit.Create(Self);
end;
function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
begin
Result := TTntGridDataLink.Create(Self);
end;
function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
var
Field: TField;
begin
Field := GetColField(RawToDataColumn(ACol));
if Field = nil then
Result := ''
else
Result := GetWideText(Field);
FEditText := Result;
end;
procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
begin
if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
FEditText := Value
else
FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
inherited;
end;
//----------------- DRAW CELL PROCS --------------------------------------------------
var
DrawBitmap: TBitmap = nil;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: WideString; 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 ExtTextOutW 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 - WideCanvasTextWidth(ACanvas, Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) div 2
- (WideCanvasTextWidth(ACanvas, Text) div 2);
end;
WideCanvasTextRect(ACanvas, 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);
Tnt_DrawTextW(Handle, PWideChar(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;
procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
var
Alignment: TAlignment;
Value: WideString;
begin
Alignment := taLeftJustify;
Value := '';
if Assigned(Field) then
begin
Alignment := Field.Alignment;
Value := GetWideDisplayText(Field);
end;
WriteText(Canvas, Rect, 2, 2, Value, Alignment,
UseRightToLeftAlignmentForField(Field, Alignment));
end;
procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
var
Value: WideString;
begin
Value := '';
if Assigned(Column.Field) then
Value := GetWideDisplayText(Column.Field);
WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
end;
procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
FrameOffs: Byte;
procedure DrawTitleCell(ACol, ARow: Integer; Column: TTntColumn; var AState: TGridDrawState);
const
ScrollArrows: array [Boolean, Boolean] of Integer =
((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
var
MasterCol: TColumn{TNT-ALLOW TColumn};
TitleRect, TxtRect, 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);
TxtRect := TitleRect;
I := GetSystemMetrics(SM_CXHSCROLL);
if ((TxtRect.Right - TxtRect.Left) > I) and MasterCol.Expandable then
begin
Dec(TxtRect.Right, I);
ButtonRect := TitleRect;
ButtonRect.Left := TxtRect.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 ExtTextOutW 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 as TTntColumnTitle) do
WriteText(Canvas, TxtRect, 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;
Highlight: Boolean;
Value: WideString;
DrawColumn: TTntColumn;
begin
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
if (gdFixed in AState) and (RawToDataColumn(ACol) < 0) then
begin
inherited;
exit;
end;
Dec(ARow, FixedRows);
ACol := RawToDataColumn(ACol);
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
with Canvas do
begin
DrawColumn := Columns[ACol] as TTntColumn;
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 + FixedRows, DrawColumn, AState)
else if (DataLink = nil) or not DataLink.Active then
FillRect(ARect)
else
begin
Value := '';
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then
Value := GetWideDisplayText(DrawColumn.Field);
Highlight := HighlightCell(ACol, ARow, Value, AState);
if Highlight then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if not Enabled then
Font.Color := clGrayText;
if DefaultDrawing then
DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
DataLink.ActiveRecord := OldActive;
end;
if DefaultDrawing 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 TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
initialization
DrawBitmap := TBitmap.Create;
finalization
DrawBitmap.Free;
end.