Componentes.Terceros.TntUni.../internal/2.3.0/1/Source/TntGrids.pas

676 lines
21 KiB
ObjectPascal

{*****************************************************************************}
{ }
{ Tnt Delphi Unicode Controls }
{ http://www.tntware.com/delphicontrols/unicode/ }
{ Version: 2.3.0 }
{ }
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
{ }
{*****************************************************************************}
unit TntGrids;
{$INCLUDE TntCompilers.inc}
interface
uses
Classes, TntClasses, Grids, Windows, Controls, Messages;
type
{TNT-WARN TInplaceEdit}
TTntInplaceEdit = class(TInplaceEdit{TNT-ALLOW TInplaceEdit})
private
function GetText: WideString;
procedure SetText(const Value: WideString);
protected
procedure UpdateContents; override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
public
property Text: WideString read GetText write SetText;
end;
TTntGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: WideString) of object;
TTntSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: WideString) of object;
{TNT-WARN TCustomDrawGrid}
_TTntInternalCustomDrawGrid = class(TCustomDrawGrid{TNT-ALLOW TCustomDrawGrid})
private
FSettingEditText: Boolean;
procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); dynamic; abstract;
protected
procedure SetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
end;
TTntCustomDrawGrid = class(_TTntInternalCustomDrawGrid)
private
FOnGetEditText: TTntGetEditEvent;
FOnSetEditText: TTntSetEditEvent;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
protected
function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
function GetEditText(ACol, ARow: Longint): WideString; reintroduce; virtual;
procedure SetEditText(ACol, ARow: Longint; const Value: WideString); reintroduce; virtual;
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;
property OnGetEditText: TTntGetEditEvent read FOnGetEditText write FOnGetEditText;
property OnSetEditText: TTntSetEditEvent read FOnSetEditText write FOnSetEditText;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TDrawGrid}
TTntDrawGrid = class(TTntCustomDrawGrid)
published
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property Color;
property ColCount;
property Constraints;
property Ctl3D;
property DefaultColWidth;
property DefaultRowHeight;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property FixedCols;
property RowCount;
property FixedRows;
property Font;
property GridLineWidth;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollBars;
property ShowHint;
property TabOrder;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnClick;
property OnColumnMoved;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawCell;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask;
property OnGetEditText;
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 OnMouseWheelDown;
property OnMouseWheelUp;
property OnRowMoved;
property OnSelectCell;
property OnSetEditText;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged;
end;
TTntStringGrid = class;
{TNT-WARN TStringGridStrings}
TTntStringGridStrings = class(TTntStrings)
private
FIsCol: Boolean;
FColRowIndex: Integer;
FGrid: TTntStringGrid;
function GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
protected
function Get(Index: Integer): WideString; override;
procedure Put(Index: Integer; const S: WideString); override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create(AGrid: TTntStringGrid; AIndex: Longint);
function Add(const S: WideString): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: WideString); override;
end;
{TNT-WARN TStringGrid}
_TTntInternalStringGrid = class(TStringGrid{TNT-ALLOW TStringGrid})
private
FSettingEditText: Boolean;
procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); dynamic; abstract;
protected
procedure SetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
end;
TTntStringGrid = class(_TTntInternalStringGrid)
private
FCreatedRowStrings: TStringList{TNT-ALLOW TStringList};
FCreatedColStrings: TStringList{TNT-ALLOW TStringList};
FOnGetEditText: TTntGetEditEvent;
FOnSetEditText: TTntSetEditEvent;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
function GetCells(ACol, ARow: Integer): WideString;
procedure SetCells(ACol, ARow: Integer; const Value: WideString);
function FindGridStrings(const IsCol: Boolean; const ListIndex: Integer): TTntStrings;
function GetCols(Index: Integer): TTntStrings;
function GetRows(Index: Integer): TTntStrings;
procedure SetCols(Index: Integer; const Value: TTntStrings);
procedure SetRows(Index: Integer; const Value: TTntStrings);
protected
function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
function GetEditText(ACol, ARow: Longint): WideString; reintroduce; virtual;
procedure SetEditText(ACol, ARow: Longint; const Value: WideString); reintroduce; virtual;
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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Cells[ACol, ARow: Integer]: WideString read GetCells write SetCells;
property Cols[Index: Integer]: TTntStrings read GetCols write SetCols;
property Rows[Index: Integer]: TTntStrings read GetRows write SetRows;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
property OnGetEditText: TTntGetEditEvent read FOnGetEditText write FOnGetEditText;
property OnSetEditText: TTntSetEditEvent read FOnSetEditText write FOnSetEditText;
end;
implementation
uses
SysUtils, TntSystem, TntGraphics, TntControls, TntStdCtrls, TntActnList, TntSysUtils;
{ TBinaryCompareAnsiStringList }
type
TBinaryCompareAnsiStringList = class(TStringList{TNT-ALLOW TStringList})
protected
function CompareStrings(const S1, S2: string{TNT-ALLOW string}): Integer; override;
end;
function TBinaryCompareAnsiStringList.CompareStrings(const S1, S2: string{TNT-ALLOW string}): Integer;
begin
// must compare strings via binary for speed
if S1 = S2 then
result := 0
else if S1 < S2 then
result := -1
else
result := 1;
end;
{ TTntInplaceEdit }
procedure TTntInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
function TTntInplaceEdit.GetText: WideString;
begin
if IsMasked then
Result := inherited Text
else
Result := TntControl_GetText(Self);
end;
procedure TTntInplaceEdit.SetText(const Value: WideString);
begin
if IsMasked then
inherited Text := Value
else
TntControl_SetText(Self, Value);
end;
type TAccessCustomGrid = class(TCustomGrid);
procedure TTntInplaceEdit.UpdateContents;
begin
Text := '';
with TAccessCustomGrid(Grid) do
Self.EditMask := GetEditMask(Col, Row);
if (Grid is TTntStringGrid) then
with (Grid as TTntStringGrid) do
Self.Text := GetEditText(Col, Row)
else if (Grid is TTntCustomDrawGrid) then
with (Grid as TTntCustomDrawGrid) do
Self.Text := GetEditText(Col, Row)
else
with TAccessCustomGrid(Grid) do
Self.Text := GetEditText(Col, Row);
with TAccessCustomGrid(Grid) do
Self.MaxLength := GetEditLimit;
end;
{ _TTntInternalCustomDrawGrid }
procedure _TTntInternalCustomDrawGrid.SetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
begin
if FSettingEditText then
inherited
else
InternalSetEditText(ACol, ARow, Value);
end;
{ TTntCustomDrawGrid }
function TTntCustomDrawGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
begin
Result := TTntInplaceEdit.Create(Self);
end;
procedure TTntCustomDrawGrid.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
procedure TTntCustomDrawGrid.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomDrawGrid.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntCustomDrawGrid.GetHint: WideString;
begin
Result := TntControl_GetHint(Self);
end;
procedure TTntCustomDrawGrid.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
function TTntCustomDrawGrid.GetEditText(ACol, ARow: Integer): WideString;
begin
Result := '';
if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
end;
procedure TTntCustomDrawGrid.InternalSetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
begin
if not FSettingEditText then
SetEditText(ACol, ARow, TntControl_GetText(InplaceEditor));
end;
procedure TTntCustomDrawGrid.SetEditText(ACol, ARow: Integer; const Value: WideString);
begin
if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
end;
procedure TTntCustomDrawGrid.WMChar(var Msg: TWMChar);
begin
if (goEditing in Options)
and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
RestoreWMCharMsg(TMessage(Msg));
ShowEditorChar(WideChar(Msg.CharCode));
end else
inherited;
end;
procedure TTntCustomDrawGrid.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 TTntCustomDrawGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomDrawGrid.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntStringGridStrings }
procedure TTntStringGridStrings.Assign(Source: TPersistent);
var
UTF8Strings: TStringList{TNT-ALLOW TStringList};
i: integer;
begin
UTF8Strings := TStringList{TNT-ALLOW TStringList}.Create;
try
if Source is TStrings{TNT-ALLOW TStrings} then begin
for i := 0 to TStrings{TNT-ALLOW TStrings}(Source).Count - 1 do
UTF8Strings.AddObject(WideStringToUTF8(WideString(TStrings{TNT-ALLOW TStrings}(Source).Strings[i])),
TStrings{TNT-ALLOW TStrings}(Source).Objects[i]);
GridAnsiStrings.Assign(UTF8Strings);
end else if Source is TTntStrings then begin
for i := 0 to TTntStrings(Source).Count - 1 do
UTF8Strings.AddObject(WideStringToUTF8(TTntStrings(Source).Strings[i]),
TTntStrings(Source).Objects[i]);
GridAnsiStrings.Assign(UTF8Strings);
end else
GridAnsiStrings.Assign(Source);
finally
UTF8Strings.Free;
end;
end;
function TTntStringGridStrings.GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
begin
Assert(Assigned(FGrid));
if FIsCol then
Result := TStringGrid{TNT-ALLOW TStringGrid}(FGrid).Cols[FColRowIndex]
else
Result := TStringGrid{TNT-ALLOW TStringGrid}(FGrid).Rows[FColRowIndex];
end;
procedure TTntStringGridStrings.Clear;
begin
GridAnsiStrings.Clear;
end;
procedure TTntStringGridStrings.Delete(Index: Integer);
begin
GridAnsiStrings.Delete(Index);
end;
function TTntStringGridStrings.GetCount: Integer;
begin
Result := GridAnsiStrings.Count;
end;
function TTntStringGridStrings.Get(Index: Integer): WideString;
begin
Result := UTF8ToWideString(GridAnsiStrings[Index]);
end;
procedure TTntStringGridStrings.Put(Index: Integer; const S: WideString);
begin
GridAnsiStrings[Index] := WideStringToUTF8(S);
end;
procedure TTntStringGridStrings.Insert(Index: Integer; const S: WideString);
begin
GridAnsiStrings.Insert(Index, WideStringToUTF8(S));
end;
function TTntStringGridStrings.Add(const S: WideString): Integer;
begin
Result := GridAnsiStrings.Add(WideStringToUTF8(S));
end;
function TTntStringGridStrings.GetObject(Index: Integer): TObject;
begin
Result := GridAnsiStrings.Objects[Index];
end;
procedure TTntStringGridStrings.PutObject(Index: Integer; AObject: TObject);
begin
GridAnsiStrings.Objects[Index] := AObject;
end;
type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
procedure TTntStringGridStrings.SetUpdateState(Updating: Boolean);
begin
TAccessStrings(GridAnsiStrings).SetUpdateState(Updating);
end;
constructor TTntStringGridStrings.Create(AGrid: TTntStringGrid; AIndex: Integer);
begin
inherited Create;
FGrid := AGrid;
if AIndex > 0 then begin
FIsCol := False;
FColRowIndex := AIndex - 1;
end else begin
FIsCol := True;
FColRowIndex := -AIndex - 1;
end;
end;
{ _TTntInternalStringGrid }
procedure _TTntInternalStringGrid.SetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
begin
if FSettingEditText then
inherited
else
InternalSetEditText(ACol, ARow, Value);
end;
{ TTntStringGrid }
constructor TTntStringGrid.Create(AOwner: TComponent);
begin
inherited;
FCreatedRowStrings := TBinaryCompareAnsiStringList.Create;
FCreatedRowStrings.Sorted := True;
FCreatedRowStrings.Duplicates := dupError;
FCreatedColStrings := TBinaryCompareAnsiStringList.Create;
FCreatedColStrings.Sorted := True;
FCreatedColStrings.Duplicates := dupError;
end;
destructor TTntStringGrid.Destroy;
var
i: integer;
begin
for i := FCreatedColStrings.Count - 1 downto 0 do
FCreatedColStrings.Objects[i].Free;
for i := FCreatedRowStrings.Count - 1 downto 0 do
FCreatedRowStrings.Objects[i].Free;
FreeAndNil(FCreatedColStrings);
FreeAndNil(FCreatedRowStrings);
inherited;
end;
function TTntStringGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
begin
Result := TTntInplaceEdit.Create(Self);
end;
procedure TTntStringGrid.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
procedure TTntStringGrid.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntStringGrid.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntStringGrid.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntStringGrid.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
function TTntStringGrid.GetCells(ACol, ARow: Integer): WideString;
begin
Result := UTF8ToWideString(inherited Cells[ACol, ARow])
end;
procedure TTntStringGrid.SetCells(ACol, ARow: Integer; const Value: WideString);
var
UTF8Str: AnsiString;
begin
UTF8Str := WideStringToUTF8(Value);
if inherited Cells[ACol, ARow] <> UTF8Str then
inherited Cells[ACol, ARow] := UTF8Str;
end;
function TTntStringGrid.FindGridStrings(const IsCol: Boolean; const ListIndex: Integer): TTntStrings;
var
idx: integer;
SrcStrings: TStrings{TNT-ALLOW TStrings};
RCIndex: Integer;
begin
if IsCol then
SrcStrings := FCreatedColStrings
else
SrcStrings := FCreatedRowStrings;
Assert(Assigned(SrcStrings));
idx := SrcStrings.IndexOf(IntToStr(ListIndex));
if idx <> -1 then
Result := SrcStrings.Objects[idx] as TTntStrings
else begin
if IsCol then RCIndex := -ListIndex - 1 else RCIndex := ListIndex + 1;
Result := TTntStringGridStrings.Create(Self, RCIndex);
SrcStrings.AddObject(IntToStr(ListIndex), Result);
end;
end;
function TTntStringGrid.GetCols(Index: Integer): TTntStrings;
begin
Result := FindGridStrings(True, Index);
end;
function TTntStringGrid.GetRows(Index: Integer): TTntStrings;
begin
Result := FindGridStrings(False, Index);
end;
procedure TTntStringGrid.SetCols(Index: Integer; const Value: TTntStrings);
begin
FindGridStrings(True, Index).Assign(Value);
end;
procedure TTntStringGrid.SetRows(Index: Integer; const Value: TTntStrings);
begin
FindGridStrings(False, Index).Assign(Value);
end;
procedure TTntStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
SaveDefaultDrawing: Boolean;
begin
if DefaultDrawing then
WideCanvasTextRect(Canvas, ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
SaveDefaultDrawing := DefaultDrawing;
try
DefaultDrawing := False;
inherited DrawCell(ACol, ARow, ARect, AState);
finally
DefaultDrawing := SaveDefaultDrawing;
end;
end;
function TTntStringGrid.GetEditText(ACol, ARow: Integer): WideString;
begin
Result := Cells[ACol, ARow];
if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
end;
procedure TTntStringGrid.InternalSetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
begin
if not FSettingEditText then
SetEditText(ACol, ARow, TntControl_GetText(InplaceEditor));
end;
procedure TTntStringGrid.SetEditText(ACol, ARow: Integer; const Value: WideString);
begin
FSettingEditText := True;
try
inherited SetEditText(ACol, ARow, WideStringToUTF8(Value));
finally
FSettingEditText := False;
end;
if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
end;
procedure TTntStringGrid.WMChar(var Msg: TWMChar);
begin
if (goEditing in Options)
and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
RestoreWMCharMsg(TMessage(Msg));
ShowEditorChar(WideChar(Msg.CharCode));
end else
inherited;
end;
procedure TTntStringGrid.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 TTntStringGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntStringGrid.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
end.