From a0f6fd68a56068a20e7186e2dd2d7daccfbce4aa Mon Sep 17 00:00:00 2001 From: Pavel Perminov Date: Wed, 26 Sep 2012 19:02:53 +0000 Subject: Chess4Net_MI 2010.0 release (106 rev. truncated adjusted copy) git-svn-id: http://svn.miranda-ng.org/main/trunk@1666 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntDBGrids.pas | 1175 ++++++++++++++++++++ 1 file changed, 1175 insertions(+) create mode 100644 plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas') diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas new file mode 100644 index 0000000000..2664bf7b5a --- /dev/null +++ b/plugins/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. -- cgit v1.2.3