?? bsskingrids.pas
字號:
TbsSkinDrawGrid = class(TbsSkinCustomGrid)
private
FOnColumnMoved: TMovedEvent;
FOnDrawCell: TDrawCellEvent;
FOnGetEditMask: TGetEditEvent;
FOnGetEditText: TGetEditEvent;
FOnRowMoved: TMovedEvent;
FOnSelectCell: TSelectCellEvent;
FOnSetEditText: TSetEditEvent;
FOnTopLeftChanged: TNotifyEvent;
protected
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
function GetEditMask(ACol, ARow: Longint): string; override;
function GetEditText(ACol, ARow: Longint): string; override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
function SelectCell(ACol, ARow: Longint): Boolean; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure TopLeftChanged; override;
public
function CellRect(ACol, ARow: Longint): TRect;
procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
property Canvas;
property Col;
property ColWidths;
property EditorMode;
property GridHeight;
property GridWidth;
property LeftCol;
property Selection;
property Row;
property RowHeights;
property TabStops;
property TopRow;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property ColCount;
property Constraints;
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 ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnClick;
property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnRowMoved: TMovedEvent read FOnRowMoved write FOnRowMoved;
property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
end;
{ TbsSkinStringGrid }
TbsSkinStringGrid = class;
TbsSkinStringGridStrings = class(TStrings)
private
FGrid: TbsSkinStringGrid;
FIndex: Integer;
procedure CalcXY(Index: Integer; var X, Y: Integer);
protected
function Get(Index: Integer): string; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure Put(Index: Integer; const S: string); override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create(AGrid: TbsSkinStringGrid; AIndex: Longint);
function Add(const S: string): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: string); override;
end;
TbsSkinStringGrid = class(TbsSkinDrawGrid)
private
FData: Pointer;
FRows: Pointer;
FCols: Pointer;
FUpdating: Boolean;
FNeedsUpdating: Boolean;
FEditUpdate: Integer;
procedure DisableEditUpdate;
procedure EnableEditUpdate;
procedure Initialize;
procedure Update(ACol, ARow: Integer); reintroduce;
procedure SetUpdateState(Updating: Boolean);
function GetCells(ACol, ARow: Integer): string;
function GetCols(Index: Integer): TStrings;
function GetObjects(ACol, ARow: Integer): TObject;
function GetRows(Index: Integer): TStrings;
procedure SetCells(ACol, ARow: Integer; const Value: string);
procedure SetCols(Index: Integer; Value: TStrings);
procedure SetObjects(ACol, ARow: Integer; Value: TObject);
procedure SetRows(Index: Integer; Value: TStrings);
function EnsureColRow(Index: Integer; IsCol: Boolean): TbsSkinStringGridStrings;
function EnsureDataRow(ARow: Integer): Pointer;
protected
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
function GetEditText(ACol, ARow: Longint): string; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
property Cols[Index: Integer]: TStrings read GetCols write SetCols;
property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
property Rows[Index: Integer]: TStrings read GetRows write SetRows;
end;
implementation
uses Math, Consts, bsUtils;
type
PIntArray = ^TIntArray;
TIntArray = array[0..MaxCustomExtents] of Integer;
procedure InvalidOp(const id: string);
begin
raise bsEInvalidGridOperation.Create(id);
end;
function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
begin
with Result do
begin
Left := Coord2.X;
if Coord1.X < Coord2.X then Left := Coord1.X;
Right := Coord1.X;
if Coord1.X < Coord2.X then Right := Coord2.X;
Top := Coord2.Y;
if Coord1.Y < Coord2.Y then Top := Coord1.Y;
Bottom := Coord1.Y;
if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
end;
end;
function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
and (Row <= Rect.Bottom);
end;
type
TXorRects = array[0..3] of TRect;
procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
var
Intersect, Union: TRect;
function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
begin
with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
(Y <= Bottom);
end;
function Includes(const P1: TPoint; var P2: TPoint): Boolean;
begin
with P1 do
begin
Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
if Result then P2 := P1;
end;
end;
function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
begin
Build := True;
with R do
if Includes(P1, TopLeft) then
begin
if not Includes(P3, BottomRight) then BottomRight := P2;
end
else if Includes(P2, TopLeft) then BottomRight := P3
else Build := False;
end;
begin
FillChar(XorRects, SizeOf(XorRects), 0);
if not Bool(IntersectRect(Intersect, R1, R2)) then
begin
{ Don't intersect so its simple }
XorRects[0] := R1;
XorRects[1] := R2;
end
else
begin
UnionRect(Union, R1, R2);
if Build(XorRects[0],
Point(Union.Left, Union.Top),
Point(Union.Left, Intersect.Top),
Point(Union.Left, Intersect.Bottom)) then
XorRects[0].Right := Intersect.Left;
if Build(XorRects[1],
Point(Intersect.Left, Union.Top),
Point(Intersect.Right, Union.Top),
Point(Union.Right, Union.Top)) then
XorRects[1].Bottom := Intersect.Top;
if Build(XorRects[2],
Point(Union.Right, Intersect.Top),
Point(Union.Right, Intersect.Bottom),
Point(Union.Right, Union.Bottom)) then
XorRects[2].Left := Intersect.Right;
if Build(XorRects[3],
Point(Union.Left, Union.Bottom),
Point(Intersect.Left, Union.Bottom),
Point(Intersect.Right, Union.Bottom)) then
XorRects[3].Top := Intersect.Bottom;
end;
end;
procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
Default: Integer);
var
LongSize, OldSize: LongInt;
NewSize: Integer;
I: Integer;
begin
if Amount <> 0 then
begin
if not Assigned(Extents) then OldSize := 0
else OldSize := PIntArray(Extents)^[0];
if (Index < 0) or (OldSize < Index) then InvalidOp(SIndexOutOfRange);
LongSize := OldSize + Amount;
if LongSize < 0 then InvalidOp(STooManyDeleted)
else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
NewSize := Cardinal(LongSize);
if NewSize > 0 then Inc(NewSize);
ReallocMem(Extents, NewSize * SizeOf(Integer));
if Assigned(Extents) then
begin
I := Index + 1;
while I < NewSize do
begin
PIntArray(Extents)^[I] := Default;
Inc(I);
end;
PIntArray(Extents)^[0] := NewSize-1;
end;
end;
end;
procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
Default: Integer);
var
OldSize: Integer;
begin
OldSize := 0;
if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
end;
procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
var
Extent: Integer;
begin
if Assigned(Extents) then
begin
Extent := PIntArray(Extents)^[FromIndex];
if FromIndex < ToIndex then
Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
(ToIndex - FromIndex) * SizeOf(Integer))
else if FromIndex > ToIndex then
Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
(FromIndex - ToIndex) * SizeOf(Integer));
PIntArray(Extents)^[ToIndex] := Extent;
end;
end;
function CompareExtents(E1, E2: Pointer): Boolean;
var
I: Integer;
begin
Result := False;
if E1 <> nil then
begin
if E2 <> nil then
begin
for I := 0 to PIntArray(E1)^[0] do
if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
Result := True;
end
end
else Result := E2 = nil;
end;
{ Private. LongMulDiv multiplys the first two arguments and then
divides by the third. This is used so that real number
(floating point) arithmetic is not necessary. This routine saves
the possible 64-bit value in a temp before doing the divide. Does
not do error checking like divide by zero. Also assumes that the
result is in the 32-bit range (Actually 31-bit, since this algorithm
is for unsigned). }
function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
external 'kernel32.dll' name 'MulDiv';
type
TSelection = record
StartPos, EndPos: Integer;
end;
constructor TbsSkinInplaceEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ParentCtl3D := False;
Ctl3D := False;
TabStop := False;
BorderStyle := bsNone;
end;
procedure TbsSkinInplaceEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE;
end;
procedure TbsSkinInplaceEdit.SetGrid(Value: TbsSkinCustomGrid);
begin
FGrid := Value;
end;
procedure TbsSkinInplaceEdit.CMShowingChanged(var Message: TMessage);
begin
end;
procedure TbsSkinInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
if goTabs in Grid.Options then
Message.Result := Message.Result or DLGC_WANTTAB;
end;
procedure TbsSkinInplaceEdit.WMPaste(var Message);
begin
if not EditCanModify then Exit;
inherited
end;
procedure TbsSkinInplaceEdit.WMClear(var Message);
begin
if not EditCanModify then Exit;
inherited;
end;
procedure TbsSkinInplaceEdit.WMCut(var Message);
begin
if not EditCanModify then Exit;
inherited;
end;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -