From 690f5e6d29d1c85c4be72638eb22843964c2f512 Mon Sep 17 00:00:00 2001 From: Alexander Lantsev Date: Fri, 24 Apr 2015 08:21:28 +0000 Subject: All non-working stuff moved from trunk git-svn-id: http://svn.miranda-ng.org/main/trunk@13071 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntDBGrids.pas | 1175 -------------------- 1 file changed, 1175 deletions(-) delete mode 100644 plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas (limited to 'plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas') diff --git a/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas deleted file mode 100644 index 2664bf7b5a..0000000000 --- a/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas +++ /dev/null @@ -1,1175 +0,0 @@ - -{*****************************************************************************} -{ } -{ 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