summaryrefslogtreecommitdiff
path: root/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas')
-rw-r--r--plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas1175
1 files changed, 1175 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas
new file mode 100644
index 0000000000..2664bf7b5a
--- /dev/null
+++ b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas
@@ -0,0 +1,1175 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntCompilers.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.