home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 October
/
Chip_2001-10_cd1.bin
/
zkuste
/
delphi
/
kolekce
/
d456
/
DCSLIB25.ZIP
/
DCGrids.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-06-28
|
75KB
|
2,802 lines
{
BUSINESS CONSULTING
s a i n t - p e t e r s b u r g
Components Library for Borland Delphi 4.x - 6.x
Copyright (c) 1998-2001 Alex'EM
}
unit DCGrids;
{$R-}
{$G+}
interface
{$I DCConst.inc}
uses
Windows, Messages, Graphics, grids, classes, controls, sysutils, stdctrls, DCConst, dialogs;
type
TDragGridState = (dsNone, dsColMoving, dsHeaderMoving);
TDragMousePos = (dmNone, dmColumn, dmGroupBox);
TDCCustomGrid = class;
TDCFooter = class;
PGroupBoxItem_tag = ^TGroupBoxItem;
TGroupBoxItem = packed record
LOffset: byte;
ColIndex: integer;
Size: TPoint;
MaxHeight: integer;
end;
TDCGroupBoxList = class(TList)
private
FOwner: TDCCustomGrid;
FMargin: TPoint;
FBoxSize: integer;
FUpdateCount: integer;
FMovePos: integer;
FMoveIndex: integer;
FFixedCols: integer;
FReadOnly: boolean;
function GetBoxSize: integer;
function GetBoxItems(Index: integer): TGroupBoxItem;
procedure SetBoxItems(Index: integer; const Value: TGroupBoxItem);
function GetItemOffset(i: integer): integer;
function GetBoundsRect: TRect;
procedure SetMoveIndex(const Value: integer);
procedure SetFixedCols(const Value: integer);
procedure Changed;
protected
procedure Update; virtual;
procedure ColumnMoved(FromIndex, ToIndex: Longint); virtual;
procedure BeginUpdate;
procedure EndUpdate;
function UpdateSize: integer;
property MoveIndex: integer read FMoveIndex write SetMoveIndex;
public
constructor Create(AOwner: TDCCustomGrid);
procedure Draw;
function Add(AColIndex, ALOffset: integer): integer;
procedure Insert(Index, AColIndex, ALOffset: integer);
procedure Move(CurIndex, NewIndex: Integer);
procedure Delete(Index: integer);
procedure Clear; override;
function GetItemAtPos(APos: TPoint): integer;
function GetAreaAtPos(APos: TPoint): integer;
function GetItemRect(Index: integer): TRect;
procedure UpdateItemSize(Index: integer);
function Find(AColIndex: integer): integer;
procedure Invalidate;
function PtConvert(APoint: TPoint): TPoint;
function MouseInBox(X, Y: integer; Convert: boolean): boolean;
property BoxSize: integer read GetBoxSize;
property BoxItems[Index: integer]: TGroupBoxItem read GetBoxItems write SetBoxItems;
property BoundsRect: TRect read GetBoundsRect;
property FixedCols: integer read FFixedCols write SetFixedCols;
property ReadOnly: boolean read FReadOnly write FReadOnly;
end;
TDCFooterPanel = class(TCollectionItem)
private
FColIndex: integer;
FStyle: TBevelStyle;
FVisible: boolean;
procedure SetStyle(const Value: TBevelStyle);
procedure SetVisible(const Value: boolean);
function GetFooter: TDCFooter;
function GetCanvas: TCanvas;
protected
function AdjustHeight: integer; dynamic;
procedure SetInternalColIndex(const Value: integer);
procedure SetColIndex(const Value: integer); virtual;
function Draw(const Rect: TRect; DrawInfo: TGridDrawInfo): boolean; dynamic;
function GetColIndex: integer; virtual;
public
constructor Create(Collection: TCollection); override;
property ColIndex: integer read GetColIndex write SetColIndex;
property Footer: TDCFooter read GetFooter;
property Canvas: TCanvas read GetCanvas;
published
property Style: TBevelStyle read FStyle write SetStyle;
property Visible: boolean read FVisible write SetVisible;
end;
TDCFooterTextPanel = class(TDCFooterPanel)
private
FText: string;
procedure SetText(const Value: string);
protected
function AdjustHeight: integer; override;
procedure DoDrawText(var Rect: TRect; Flags: Longint); dynamic;
function Draw(const Rect: TRect; DrawInfo: TGridDrawInfo): boolean; override;
public
function PaintEdge(Rect: TRect; DrawInfo: TGridDrawInfo): TRect;
published
property Text: string read FText write SetText;
end;
TDCFooterPanels = class(TCollection)
private
FOwner: TDCFooter;
function GetItem(Index: Integer): TDCFooterPanel;
procedure SetItem(Index: Integer; Value: TDCFooterPanel);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(AOwner: TDCFooter);
function Add: TDCFooterPanel;
property Items[Index: Integer]: TDCFooterPanel read GetItem write SetItem; default;
end;
TDCFooterClass = class of TDCFooter;
TDCFooters = class;
TDCFooter = class(TPersistent)
private
FAutoSize: boolean;
FCanvas: TCanvas;
FHeight: integer;
FOwner: TDCFooters;
FPanels: TDCFooterPanels;
FStyle: TBevelStyle;
FVisible: boolean;
function GetColor: TColor;
function GetFont: TFont;
function GetGrid: TDCCustomGrid;
function GetVisible: boolean;
procedure SetHeight(const Value: integer);
procedure SetVisible(const Value: boolean);
procedure SetStyle(const Value: TBevelStyle);
procedure SetPanels(const Value: TDCFooterPanels);
function GetIndex: integer;
procedure SetIndex(const Value: integer);
procedure SetOwner(Value: TDCFooters);
procedure UpdatePanel(Index: Integer; Repaint: Boolean);
procedure SetAutoSize(const Value: boolean);
protected
procedure AdjustHeight;
procedure ColumnMoved(FromIndex, ToIndex: Integer); virtual;
procedure Changed(AllItems: boolean); virtual;
function GetHeight: integer; virtual;
property AutoSize: boolean read FAutoSize write SetAutoSize default True;
property Style: TBevelStyle read FStyle write SetStyle;
property Index: integer read GetIndex write SetIndex;
property Height: integer read GetHeight write SetHeight;
property Visible: boolean read GetVisible write SetVisible;
public
constructor Create(AOwner: TDCFooters);
destructor Destroy; override;
procedure DrawItem(ACanvas: TCanvas; DrawInfo: TGridDrawInfo;
const Rect: TRect; Index: integer); virtual;
property Canvas: TCanvas read FCanvas;
property Color: TColor read GetColor;
property Font: TFont read GetFont;
property Grid: TDCCustomGrid read GetGrid;
property Owner: TDCFooters read FOwner write SetOwner;
property Panels: TDCFooterPanels read FPanels write SetPanels;
end;
TDCFooters = class(TPersistent)
private
FOwner: TDCCustomGrid;
FItems: TList;
FUpdateCount: integer;
FHeight: integer;
FStyle: TBevelStyle;
function GetCount: Integer;
function GetItem(Index: Integer): TDCFooter;
procedure SetItem(Index: Integer; const Value: TDCFooter);
procedure InsertItem(Item: TDCFooter);
procedure RemoveItem(Item: TDCFooter);
function GetHeight: integer;
function GetBoundsRect: TRect;
procedure SetStyle(const Value: TBevelStyle);
protected
procedure ColumnMoved(FromIndex, ToIndex: Longint); virtual;
procedure Changed;
function PaintEdge(ARect: TRect): TRect;
function GetOwner: TPersistent; override;
function GetMargins: TRect;
procedure Update(Item: TDCFooter);
function UpdateSize: integer;
procedure RedrawItem(Item: TDCFooter; Index: integer);
property UpdateCount: Integer read FUpdateCount;
public
constructor Create(AOwner: TDCCustomGrid);
destructor Destroy; override;
procedure BeginUpdate;
procedure Clear;
procedure Delete(Index: Integer);
procedure Draw;
procedure Invalidate;
procedure EndUpdate;
property BoundsRect: TRect read GetBoundsRect;
property Count: Integer read GetCount;
property Grid: TDCCustomGrid read FOwner;
property Items[Index: Integer]: TDCFooter read GetItem write SetItem;
property Height: integer read GetHeight;
property Style: TBevelStyle read FStyle write SetStyle;
end;
TDataGridDesigner = class(TObject)
private
FDataGrid: TDCCustomGrid;
public
constructor Create(DataGrid: TDCCustomGrid);
destructor Destroy; override;
property DataGrid: TDCCustomGrid read FDataGrid;
end;
TSelectedArea = class(TObject)
private
FGrid: TDCCustomGrid;
protected
function GetGrid: TDCCustomGrid;
public
constructor Create(AGrid: TDCCustomGrid);
destructor Destroy; override;
function IsEmpty: boolean; virtual;
property Grid: TDCCustomGrid read GetGrid;
end;
TGridGroupBoxDropEvent = procedure (Sender: TObject; ColIndex,
Position: integer; var Allow: boolean) of object;
TGridGroupBoxMoveEvent = procedure (Sender: TObject; OldPosition,
NewPosition: integer; var Allow: boolean) of object;
TGridOption = (goAutoSize, goAdvancedSelect);
TGridOptions = set of TGridOption;
TDCCustomGrid = class(TCustomGrid)
private
FArrowsVisible: boolean;
FClickedCol: integer;
FDesigner: TDataGridDesigner;
FDragImages: TImageList;
FDragState: TDragGridState;
FDragStartPos: TDragMousePos;
FDragStopPos: TDragMousePos;
FFooters: TDCFooters;
FGridOptions: TGridOptions;
FGrouping: boolean;
FGroupBoxList: TDCGroupBoxList;
FLockUpdate: boolean;
FLockCount: integer;
FMoveIndex, FMovePos: integer;
FMousePos: TPoint;
FOnGroupBoxInsert: TGridGroupBoxDropEvent;
FOnGroupBoxRemove: TGridGroupBoxDropEvent;
FOnGroupBoxMove: TGridGroupBoxMoveEvent;
FOutRange: boolean;
FScrollBars: TScrollStyle;
procedure CreateTitleDragImage(Origin: integer);
function DoGroupBoxClick(X, Y: integer): boolean;
procedure DoHeaderDragging(X, Y: Integer);
procedure DrawDragArrows(Hide: boolean);
function GetGrouping: boolean;
procedure HideDragImage;
procedure SetGrouping(const Value: boolean);
procedure SetGridOptions(const Value: TGridOptions);
procedure SetScrollBars(const Value: TScrollStyle);
procedure ShowDragImage;
procedure StartDragHeader(Origin: integer; DragStart: TDragMousePos);
procedure StopDragHeader(ApllyChanges: boolean);
procedure UpdateDragingIndex(X, Y: Integer);
protected
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMCancelMode(var Message: TMessage); message CM_CANCELMODE;
function BeginColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; override;
procedure BeginLayout; virtual;
function CanColResize(ACol: integer): boolean; virtual;
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); override;
procedure CreateCellDragImage(ACol, ARow: integer; var DragImages: TImageList); virtual;
procedure DoColumnClick(Shift: TShiftState; ColIndex: integer); virtual;
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
procedure DoGroupBoxInsertItem(ColIndex, Position: integer; var Allow: boolean); virtual;
procedure DoGroupBoxMoveItem(OldPosition, NewPosition: integer; var Allow: boolean); virtual;
procedure DoGroupBoxRemoveItem(ColIndex, Position: integer; var Allow: boolean); virtual;
procedure DoStartDrag(var DragObject: TDragObject); override;
function DrawTitleCell(ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect;
BorderState: TDrawBorerState; AFillRect, ADraw: boolean): TPoint; virtual;
procedure Endlayout; virtual;
function FlatButtons: boolean; virtual;
function GetBorderStyle: TEdgeBorderStyle; virtual;
function GetClientRect: TRect; override;
function GetGridBounds: TRect;
function GetDragImages: TDragImageList; override;
function GetRealColWidth(ColIndex: integer): integer; virtual;
function GetGroupingBoxSize: integer; virtual;
procedure GroupBoxChanged; virtual;
procedure LockUpdate;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function RawToDataColumn(ACol: Integer): Integer; virtual; abstract;
procedure ResizeColWidth(ACol, AWidth: integer); virtual;
procedure UpdateColWidths(StartIndex: integer; Direct: boolean);
procedure UnlockUpdate;
function UpdateLocked: boolean;
procedure WndProc(var Message: TMessage); override;
property Designer: TDataGridDesigner read FDesigner;
property DragState: TDragGridState read FDragState;
property ClickedCol: integer read FClickedCol write FClickedCol;
property GridOptions: TGridOptions read FGridOptions write SetGridOptions;
property GroupBox: TDCGroupBoxList read FGroupBoxList;
property Footers: TDCFooters read FFooters;
property OnGroupBoxInsert: TGridGroupBoxDropEvent read FOnGroupBoxInsert write FOnGroupBoxInsert;
property OnGroupBoxRemove: TGridGroupBoxDropEvent read FOnGroupBoxRemove write FOnGroupBoxRemove;
property OnGroupBoxMove: TGridGroupBoxMoveEvent read FOnGroupBoxMove write FOnGroupBoxMove;
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GroupingEnabled: boolean; virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Paint; override;
property Grouping: boolean read GetGrouping write SetGrouping;
end;
const
nbmArrow = 0;
nbmEdit = 1;
nbmInsert = 2;
nbmMultiDot = 3;
nbmMultiArrow = 4;
nbmCheck = 5;
nbmMain = 6;
nbmIndexAsc = 7;
nbmIndexDesc = 8;
nbmIndexNone = 9;
nbmCheckHrd = 10;
function DrawTitleRect(ACanvas: TCanvas; ATextRect: TRect; AValue: string;
AAlignment: TAlignment; DrawRect: boolean; Images: TImageList = nil): TPoint;
function GDGetImages: TImageList;
implementation
uses DCPopupWindow, DCEditTools, Forms, CommCtrl;
const
HSCLT_IDEVENT = $1;
const
bmArrow = 'DC_DBGARROW';
bmEdit = 'DC_DBEDIT';
bmInsert = 'DC_DBINSERT';
bmMultiDot = 'DC_DBMULTIDOT';
bmMultiArrow = 'DC_DBMULTIARROW';
bmCheck = 'DC_DBCHECK';
bmMain = 'DC_DBMAIN';
bmIndexAsc = 'DC_DBINDEXASC';
bmIndexDesc = 'DC_DBINDEXDESC';
bmIndexNone = 'DC_DBINDEXNONE';
bmCheckHrd = 'DC_HDCHECK';
var
ArrowsBitmap: TBitmap;
GridIndicatorImages: TImageList;
{ TDCCustomGrid }
function DrawTitleRect(ACanvas: TCanvas; ATextRect: TRect; AValue: string;
AAlignment: TAlignment; DrawRect: boolean; Images: TImageList = nil): TPoint;
var
pText, pTextSub, pLine: PChar;
l: integer;
P: TPoint;
R: TRect;
function aGetMax(aValue: array of integer): integer;
var
i, max: integer;
begin
max := -1;
Result := -1;
for i := Low(aValue) to High(aValue) do
begin
if aValue[i] > max then
begin
max := aValue[i];
Result := i;
end;
end;
end;
function aGetValue(aValue: array of pointer; index: integer): pointer;
begin
Result := aValue[index];
end;
function GetEntry: PChar;
var
p1, p2, p3: PChar;
i1, i2, i3, index: integer;
begin
p1 := StrPos(pText, '#/');
p2 := StrPos(pText, #10);
p3 := StrPos(pText, #13);
if p1<> nil then i1 := p1 - pText else i1 := -1;
if p2<> nil then i2 := p2 - pText else i2 := -1;
if p3<> nil then i3 := p3 - pText else i3 := -1;
index := aGetMax([i1, i2, i3]);
if index = -1 then
Result := nil
else
Result := aGetValue([p1, p2, p3], index)
end;
begin
Result := Point(0, 0);
pText := PChar(aValue);
R := ATextRect;
pLine := AllocMem(1);
while (pText <> nil) and (pText^ <> #0) do
begin
pTextSub := GetEntry;
if pTextSub <> nil then
l := pTextSub - pText - 1
else
l := StrLen(pText);
ReallocMem(pLine, l+1);
StrLCopy(pLine, pText, l);
P := DrawHighLightText(ACanvas, pLine, ATextRect, 0, DT_NOPREFIX, Images);
Result.X := _intMax(Result.X, P.X);
Result.Y := Result.Y + P.Y;
case AAlignment of
taCenter:
P.X := ATextRect.Left + (ATextRect.Right - P.X) div 2;
taRightJustify:
P.X := ATextRect.Right + ATextRect.Left - P.X;
taLeftJustify:
P.X := ATextRect.Right - P.X;
end;
if ATextRect.Left < P.X then R.Left := P.X else R.Left := ATextRect.Left;
if DrawRect then DrawHighLightText(ACanvas, pLine, R, 1, DT_NOPREFIX, Images);
R.Top := R.Top + P.Y;
pText := pTextSub;
if pText <> nil then
begin
if pText^ = '/' then Inc(pText, 2) else
begin
Inc(pText, 1);
if (pText^ = #10) or (pText^ = #13) then Inc(pText, 1);
end;
end;
end;
ReallocMem(pLine, 0);
end;
function TDCCustomGrid.BeginColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean;
begin
Result := False;
StartDragHeader(Origin, dmColumn);
end;
procedure TDCCustomGrid.CMCancelMode(var Message: TMessage);
begin
if FDragState <> dsNone then StopDragHeader(True);
inherited;
end;
function TDCCustomGrid.GroupingEnabled: boolean;
begin
Result := True;
end;
constructor TDCCustomGrid.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csDisplayDragImage];
FClickedCol := -1;
FArrowsVisible := False;
FDragStartPos := dmNone;
FDragStopPos := dmNone;
FGroupBoxList := TDCGroupBoxList.Create(Self);
FFooters := TDCFooters.Create(Self);
FMoveIndex := -1;
FMovePos := -1;
FScrollBars := ssBoth;
FLockUpdate := False;
FLockCount := 0;
end;
procedure TDCCustomGrid.CreateTitleDragImage(Origin: integer);
var
ABitmap: TBitmap;
ARect: TRect;
begin
if (Origin >= 0) and (Origin < ColCount) then
begin
ProcessPaintMessages;
ABitmap := TBitmap.Create;
try
with ABitmap do
begin
Width := GetRealColWidth(Origin);
Height := RowHeights[0];
ARect := Rect(0, 0, Width, Height);
DrawTitleCell(Canvas, RawToDataColumn(Origin), 0, ARect, dsUp, True, True);
DrawGridFrameBorder(Canvas, ARect, GetBorderStyle, dsUp, clBtnShadow);
if FDragImages = nil then FDragImages := TImageList.CreateSize(Width, Height);
end;
FDragImages.AddMasked(ABitmap, clNone);
finally
ABitmap.Free;
end;
end;
end;
procedure TDCCustomGrid.DoHeaderDragging(X, Y: Integer);
var
P: TPoint;
begin
P := Point(X, Y);
P := ClientToScreen(P);
FDragImages.DragCursor := Cursor;
FDragImages.DragMove(P.X, P.Y);
UpdateDragingIndex(X, Y);
end;
procedure TDCCustomGrid.DrawDragArrows(Hide: boolean);
var
ACellRect, R, ArrowsRect: TRect;
P, Pos, HotSpot: TPoint;
ArrowPos,SizeX, SizeY: Integer;
ScreenDC: HDC;
ABrush, PBrush: HBRUSH;
APen, PPen: HPEN;
Points: array[0..6] of TPoint;
AColor: integer;
function IsArrowDrawing: boolean;
begin
Result := False;
case FDragStopPos of
dmNone: Result := False;
dmColumn:
Result := (FMovePos <> FMoveIndex) and (FMovePos > -1);
dmGroupBox:
with FGroupBoxList do
Result := (FMovePos <> FMoveIndex) and (FMovePos > -1);
end;
end;
begin
case FDragStopPos of
dmColumn:
begin
ACellRect := CellRect(FMovePos, 0);
P := Point(0, 0);
P := ClientToScreen(P);
OffsetRect(ACellRect, P.X, P.Y);
if (FMovePos > FMoveIndex) and (FMoveIndex > 0) or FOutRange then
begin
ArrowPos := ACellRect.Right;
end
else
ArrowPos := ACellRect.Left;
end;
dmGroupBox:
with FGroupBoxList do
begin
ACellRect := GetItemRect(FMovePos);
P := Point(0, 0);
P := ClientToScreen(P);
OffsetRect(ACellRect, P.X, P.Y);
if (FMovePos >= FMoveIndex) and ((FMoveIndex > -1) or (FMovePos >= Count)) then
ArrowPos := ACellRect.Right
else
ArrowPos := ACellRect.Left - 3;
end;
else
ArrowPos := 0;
end;
with ACellRect do ArrowsRect := Rect(ArrowPos - 4, Top - 8, ArrowPos + 4, Bottom + 8);
InflateRect(ArrowsRect, 1, 1);
if Hide then
begin
if (FDragImages <> nil) and FDragImages.Dragging then
begin
ImageList_GetIconSize(ImageList_GetDragImage(@Pos, @HotSpot), SizeX, SizeY);
with Pos do R := Rect(X, Y, X + SizeX, Y + SizeY);
OffsetRect(R, -HotSpot.X, -HotSpot.Y);
if not IntersectRect(R, R, ArrowsRect) then Hide := False;
end
end;
if Hide then HideDragImage;
ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
try
if FArrowsVisible then
begin
with ArrowsBitmap, ArrowsRect do
BitBlt(ScreenDC, Left, Top, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
FArrowsVisible := False;
end
else
if IsArrowDrawing then
begin
with ArrowsBitmap, ArrowsRect do
begin
Width := Right - Left;
Height := Bottom - Top;
end;
with ArrowsBitmap, ArrowsRect do
BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
AColor := ColorToRGB(GetNearestColor(ScreenDC, clDragArrow));
APen := CreatePen(PS_SOLID, 1, AColor);
PPen := SelectObject(ScreenDC, APen);
ABrush := CreateSolidBrush(AColor);
PBrush := SelectObject(ScreenDC, ABrush);
try
with ACellRect do
begin
{Top arrow}
Points[0] := Point(ArrowPos - 4, Top - 4);
Points[1] := Point(ArrowPos - 1, Top - 4);
Points[2] := Point(ArrowPos - 1, Top - 8);
Points[3] := Point(ArrowPos + 1, Top - 8);
Points[4] := Point(ArrowPos + 1, Top - 4);
Points[5] := Point(ArrowPos + 4, Top - 4);
Points[6] := Point(ArrowPos, Top);
Polygon(ScreenDC, Points, 7);
{Bottom arrow}
Points[0] := Point(ArrowPos - 4, Bottom + 4);
Points[1] := Point(ArrowPos - 1, Bottom + 4);
Points[2] := Point(ArrowPos - 1, Bottom + 8);
Points[3] := Point(ArrowPos + 1, Bottom + 8);
Points[4] := Point(ArrowPos + 1, Bottom + 4);
Points[5] := Point(ArrowPos + 4, Bottom + 4);
Points[6] := Point(ArrowPos, Bottom);
Polygon(ScreenDC, Points, 7);
end;
finally
SelectObject(ScreenDC, PPen);
SelectObject(ScreenDC, PBrush);
DeleteObject(APen);
DeleteObject(ABrush);
end;
FArrowsVisible := True;
end;
finally
ReleaseDC(GetDesktopWindow, ScreenDC);
if Hide then ShowDragImage;
end;
end;
function TDCCustomGrid.DrawTitleCell(ACanvas: TCanvas; ACol,
ARow: Integer; ARect: TRect; BorderState: TDrawBorerState; AFillRect, ADraw: boolean): TPoint;
begin
{}
end;
function TDCCustomGrid.GetBorderStyle: TEdgeBorderStyle;
begin
Result := ebsNormal;
end;
function TDCCustomGrid.GetGrouping: boolean;
begin
Result := FGrouping and GroupingEnabled;
end;
function TDCCustomGrid.GetGroupingBoxSize: integer;
begin
if FGrouping then
Result := FGroupBoxList.GetBoxSize
else
Result := 0
end;
procedure TDCCustomGrid.HideDragImage;
begin
if (FDragImages <> nil) and FDragImages.Dragging then FDragImages.HideDragImage;
end;
procedure TDCCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (FDragState <> dsNone) then
begin
if Key = VK_ESCAPE then StopDragHeader(False);
Key := 0;
end;
inherited;
end;
procedure TDCCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
case FDragState of
dsHeaderMoving:
DoHeaderDragging(X, Y);
dsColMoving:;
else begin
if (FDragStartPos = dmGroupBox) and (FGroupBoxList.FMoveIndex <> -1) and
((Abs(X - FMousePos.X) > 5) or ((Abs(Y - FMousePos.Y) > 5))) then
begin
{Drag Groupbox column}
if not FGroupBoxList.ReadOnly then
StartDragHeader(FGroupBoxList.MoveIndex, FDragStartPos);
end;
end;
end;
inherited;
end;
procedure TDCCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
case FDragState of
dsHeaderMoving:
StopDragHeader(True);
dsColMoving:;
else begin
if (FDragStartPos = dmGroupBox) and (FGroupBoxList.FMoveIndex <> -1) then
with FGroupBoxList do
begin
{═αµαδΦ φα ²δσ∞σφ≥}
DoColumnClick(Shift, BoxItems[FMoveIndex].ColIndex);
MoveIndex := -1;
FDragStartPos := dmNone;
end;
end;
end;
FMousePos := Point(0, 0);
inherited;
end;
procedure TDCCustomGrid.SetGrouping(const Value: boolean);
begin
if GroupingEnabled and (Value <> FGrouping) then
begin
FGrouping := Value;
FGroupBoxList.UpdateSize;
end;
end;
procedure TDCCustomGrid.ShowDragImage;
begin
if (FDragImages <> nil) and FDragImages.Dragging then FDragImages.ShowDragImage;
end;
procedure TDCCustomGrid.StartDragHeader(Origin: integer; DragStart: TDragMousePos);
var
P, AP: TPoint;
R: TRect;
begin
GetCursorPos(P);
AP := ScreenToClient(P);
Application.CancelHint;
case DragStart of
dmColumn:
begin
CreateTitleDragImage(Origin);
FMoveIndex := Origin;
FMovePos := FMoveIndex;
with FGroupBoxList do
begin
MoveIndex := -1;
FMovePos := -1;
end;
R := CellRect(Origin, 0);
end;
dmGroupBox:
begin
with FGroupBoxList do
begin
CreateTitleDragImage(BoxItems[Origin].ColIndex);
MoveIndex := Origin;
FMovePos := FMoveIndex;
R := GetItemRect(Origin);
end;
FMoveIndex := -1;
FMovePos := -1;
end
end;
FDragImages.SetDragImage(0, AP.X - R.Left, AP.Y - R.Top);
FDragImages.DragCursor := Cursor;
FDragImages.BeginDrag(GetDeskTopWindow, P.X, P.Y);
FDragState := dsHeaderMoving;
FDragStartPos := DragStart;
end;
procedure TDCCustomGrid.StopDragHeader(ApllyChanges: boolean);
var
Allow: boolean;
begin
FDragState := dsNone;
FDragImages.EndDrag;
FDragImages.Free;
FDragImages := nil;
if FArrowsVisible then DrawDragArrows(False);
if ApllyChanges then
begin
Allow := True;
try
case FDragStartPos of
dmColumn:
case FDragStopPos of
dmColumn:
if (FMovePos <> -1) and (FMoveIndex <> FMovePos) then MoveColumn(FMoveIndex, FMovePos);
dmGroupBox:
begin
{├≡≤∩∩Φ≡εΓΩα}
{╧≡εΓσ≡Φ≥ⁿ Γετ∞εµφε δΦ π≡≤∩∩Φ≡εΓα≥ⁿ ∩ε Σαφφε∞≤ ∩εδ■}
if FGroupBoxList.Find(FMoveIndex) = -1 then
begin
DoGroupBoxInsertItem(FMoveIndex, FGroupBoxList.FMovePos, Allow);
if Allow then
begin
FGroupBoxList.BeginUpdate;
if FGroupBoxList.FMovePos > FGroupBoxList.Count then
FGroupBoxList.Add(FMoveIndex, 1)
else
FGroupBoxList.Insert(FGroupBoxList.FMovePos, FMoveIndex, 1);
FGroupBoxList.EndUpdate;
end;
end;
end;
end;
dmGroupBox:
case FDragStopPos of
dmColumn:
begin
{╤φ ≥Φσ π≡≤∩∩Φ≡εΓΩΦ}
DoGroupBoxRemoveItem(FMovePos, FGroupBoxList.FMoveIndex, Allow);
if Allow then FGroupBoxList.Delete(FGroupBoxList.FMoveIndex);
end;
dmGroupBox:
begin
{╧σ≡σπ≡≤∩∩Φ≡εΓΩα}
with FGroupBoxList do
begin
DoGroupBoxMoveItem(FMoveIndex, FMovePos, Allow);
if Allow then
begin
if FMovePos > Count-1 then
Move(FMoveIndex, Count-1)
else
Move(FMoveIndex, FMovePos);
end;
end;
end;
end;
end;
except
{!!!}
end;
end
else begin
ClickedCol := -1;
InvalidateCell(FMoveIndex, 0);
end;
FMoveIndex := -1;
FMovePos := -1;
with FGroupBoxList do
begin
MoveIndex := -1;
FMovePos := -1;
end;
end;
procedure TDCCustomGrid.UpdateDragingIndex(X, Y: Integer);
var
DrawInfo: TGridDrawInfo;
CellHit: TGridCoord;
AOutRange: boolean;
Boundary: integer;
begin
CalcDrawInfo(DrawInfo);
Boundary := DrawInfo.Horz.GridBoundary - GetSystemMetrics(SM_CYHSCROLL);
CellHit := MouseCoord(X, Y);
AOutRange := False;
if (Y > -12) and (Y < DrawInfo.Vert.FixedBoundary) then
begin
if (X > Boundary) then
begin
CellHit.X := DrawInfo.Horz.LastFullVisibleCell;
CellHit.Y := 0;
if FDragStartPos = dmGroupBox then AOutRange := True;
end
else begin
if (X > 0) and (X < DrawInfo.Horz.FixedBoundary) then
begin
CellHit.X := FixedCols;
CellHit.Y := 0;
end
end;
end;
if ((CellHit.X >= FixedCols) or (LeftCol > FixedCols)) and
(CellHit.Y = 0) and (Y > -12) then
begin
if (CellHit.X <> FMovePos) or (FDragStopPos <> dmColumn) or
(AOutRange <> FOutRange) or
((X >= DrawInfo.Horz.FullVisBoundary) and (FMovePos <> DrawInfo.Horz.GridCellCount - 1)) then
begin
if FArrowsVisible then DrawDragArrows(True);
if (X < DrawInfo.Horz.FixedBoundary) then
begin
if (FMovePos > DrawInfo.Horz.FixedCellCount) then
begin
HideDragImage;
Perform(WM_HSCROLL, MakeLong(SB_LINEUP, 0), 0);
Update;
ShowDragImage;
CalcDrawInfo(DrawInfo);
end;
CellHit.X := DrawInfo.Horz.FirstGridCell;
end
else with DrawInfo.Horz do
begin
if FMovePos = LastFullVisibleCell then
begin
if (X >= DrawInfo.Horz.FullVisBoundary) then
begin
if (FMovePos < DrawInfo.Horz.GridCellCount -1) then
begin
HideDragImage;
Perform(WM_HSCROLL, MakeLong(SB_LINEDOWN, 0), 0);
Update;
CalcDrawInfo(DrawInfo);
ShowDragImage;
end;
CellHit.X := DrawInfo.Horz.LastFullVisibleCell;
end;
end;
if (FMovePos = LastFullVisibleCell + 1) and AOutRange then
begin
if (FMovePos < DrawInfo.Horz.GridCellCount -1) then
begin
HideDragImage;
Perform(WM_HSCROLL, MakeLong(SB_LINEDOWN, 0), 0);
Update;
CalcDrawInfo(DrawInfo);
ShowDragImage;
end;
end;
end;
FDragStopPos := dmColumn;
FMovePos := CellHit.X;
FOutRange := AOutRange;
DrawDragArrows(True);
end
else with DrawInfo.Horz do
begin
if (X >= Boundary) and (RawToDataColumn(LeftCol) >= 0) and
(ColWidths[CellHit.X] + FixedBoundary > GridBoundary) then
begin
if FArrowsVisible then DrawDragArrows(True);
HideDragImage;
Perform(WM_HSCROLL, MakeLong(SB_LINEDOWN, 0), 0);
Update;
ShowDragImage;
CalcDrawInfo(DrawInfo);
CellHit.X := DrawInfo.Horz.FirstGridCell;
FDragStopPos := dmColumn;
FMovePos := CellHit.X;
FOutRange := AOutRange;
DrawDragArrows(True);
end
end
end
else begin
if FGroupBoxList.MouseInBox(X, Y, False) then
with FGroupBoxList do
begin
CellHit.X := GetAreaAtPos(Point(X, Y));
if (CellHit.X <> FMovePos) or (FDragStopPos <> dmGroupBox) then
begin
if FArrowsVisible then DrawDragArrows(True);
FDragStopPos := dmGroupBox;
FMovePos := CellHit.X;
DrawDragArrows(True);
end;
end
else begin
if FArrowsVisible then DrawDragArrows(True);
FMovePos := -1;
FGroupBoxList.FMovePos := -1;
FDragStopPos := dmNone;
end;
end;
end;
procedure TDCCustomGrid.WMKillFocus(var Message: TWMKillFocus);
begin
if FDragState <> dsNone then StopDragHeader(True);
inherited;
end;
procedure TDCCustomGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
Inc(Message.CalcSize_Params^.rgrc[0].Top, GetGroupingBoxSize);
end;
procedure TDCCustomGrid.WMNCPaint(var Message: TMessage);
var
GroupBoxSize: integer;
begin
inherited;
GroupBoxSize := GetGroupingBoxSize;
if GroupBoxSize > 0 then FGroupBoxList.Draw;
end;
destructor TDCCustomGrid.Destroy;
begin
Destroying;
FFooters.Free;
if FDesigner <> nil then
begin
FDesigner.Free;
FDesigner := nil;
end;
FGroupBoxList.Free;
inherited;
end;
function TDCCustomGrid.FlatButtons: boolean;
begin
Result := False;
end;
procedure TDCCustomGrid.WndProc(var Message: TMessage);
begin
inherited;
end;
procedure TDCCustomGrid.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
with Message do
begin
if FGroupBoxList.MouseInBox(XPos, YPos, True) then
begin
Result := HTCLIENT{HTBORDER};
end;
end;
end;
function TDCCustomGrid.DoGroupBoxClick(X, Y: integer): boolean;
var
Index: integer;
P: TPoint;
begin
Result := False;
if Grouping then
begin
FMousePos := Point(X, Y);
if PtInRect(FGroupBoxList.BoundsRect, FGroupBoxList.PtConvert(FMousePos)) then
begin
Result := True;
P := FMousePos;
Index := FGroupBoxList.GetItemAtPos(P);
if Index > -1 then
begin
FGroupBoxList.MoveIndex := Index;
FDragStartPos := dmGroupBox;
end;
end
end;
end;
procedure TDCCustomGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not( (Button = mbLeft) and DoGroupBoxClick(X, Y) ) then inherited;
end;
procedure TDCCustomGrid.ColumnMoved(FromIndex, ToIndex: Integer);
begin
inherited;
if GroupingEnabled then GroupBox.ColumnMoved(FromIndex, ToIndex);
Footers.ColumnMoved(FromIndex, ToIndex);
end;
procedure TDCCustomGrid.DoColumnClick(Shift: TShiftState;
ColIndex: integer);
begin
{}
end;
procedure TDCCustomGrid.GroupBoxChanged;
begin
{}
end;
function TDCCustomGrid.GetRealColWidth(ColIndex: integer): integer;
begin
Result := ColWidths[ColIndex];
end;
procedure TDCCustomGrid.DoGroupBoxInsertItem(ColIndex, Position: integer;
var Allow: boolean);
begin
{─εßαΓδσφΦσ ²δσ∞σφ≥α Γ π≡≤∩∩Φ≡εΓΩ≤}
if Assigned(FOnGroupBoxInsert) then FOnGroupBoxInsert(Self, ColIndex, Position, Allow);
end;
procedure TDCCustomGrid.DoGroupBoxMoveItem(OldPosition, NewPosition: integer;
var Allow: boolean);
begin
{╧σ≡σφε± ²δσ∞σφ≥α π≡≤∩∩Φ≡εΓΩΦ}
if Assigned(FOnGroupBoxMove) then FOnGroupBoxMove(Self, OldPosition, NewPosition, Allow);
end;
procedure TDCCustomGrid.DoGroupBoxRemoveItem(ColIndex, Position: integer;
var Allow: boolean);
begin
{╧σ≡σφε± ²δσ∞σφ≥α Φτ π≡≤∩∩εΦ≡εΓΩΦ}
if Assigned(FOnGroupBoxRemove) then FOnGroupBoxRemove(Self, ColIndex, Position, Allow);
end;
procedure TDCCustomGrid.CreateCellDragImage(ACol, ARow: integer;
var DragImages: TImageList);
begin
{}
end;
procedure TDCCustomGrid.DoStartDrag(var DragObject: TDragObject);
var
P, AP: TPoint;
Cell: TGridCoord;
begin
GetCursorPos(P);
AP := ScreenToClient(P);
Cell := MouseCoord(AP.X, AP.Y);
Application.CancelHint;
inherited;
CreateCellDragImage(Cell.X, Cell.Y, FDragImages);
if FDragImages <> nil then
begin
FDragImages.SetDragImage(0, 2, 8);
FDragImages.BeginDrag(GetDeskTopWindow, P.X, P.Y);
FDragState := dsColMoving;
end;
end;
function TDCCustomGrid.GetDragImages: TDragImageList;
begin
if FDragImages <> nil then
begin
Result := FDragImages
end
else
Result := inherited GetDragImages;
end;
procedure TDCCustomGrid.DoEndDrag(Target: TObject; X, Y: Integer);
begin
inherited;
if FDragImages <> nil then
begin
FDragImages.Free;
FDragImages := nil;
FDragState := dsNone;
end;
end;
procedure TDCCustomGrid.SetGridOptions(const Value: TGridOptions);
var
ChangedOptions: TGridOptions;
begin
if FGridOptions <> Value then
begin
ChangedOptions := (FGridOptions + Value) - (FGridOptions * Value);
FGridOptions := Value;
if goAutoSize in ChangedOptions then LeftCol := FixedCols;
end;
end;
procedure TDCCustomGrid.UpdateColWidths(StartIndex: integer;
Direct: boolean);
type
TResizeInfo = packed record
Width: integer;
Sizing: boolean;
Fixed: boolean;
end;
var
ResizeInfo: array of TResizeInfo;
SizingArea, GridArea: integer;
i, ASizingArea, AGridArea, AWidth: integer;
DrawInfo: TGridDrawInfo;
procedure UpdateColWidth;
var
i: integer;
begin
for i := 0 to ColCount - 1 do
begin
if ResizeInfo[i].Sizing or not ResizeInfo[i].Fixed then
ResizeColWidth(i, ResizeInfo[i].Width);
end;
end;
begin
if UpdateLocked or not(goAutoSize in GridOptions) or ([csLoading]*ComponentState <> []) then Exit;
LockUpdate;
SetLength(ResizeInfo, ColCount);
CalcDrawInfo(DrawInfo);
for i := 0 to ColCount - 1 do ResizeInfo[i].Width := ColWidths[i];
for i := 0 to ColCount - 1 do
begin
if (i > StartIndex) and Direct or (i < StartIndex) and not Direct then
ResizeInfo[i].Sizing := CanColResize(i)
else
ResizeInfo[i].Sizing := False;
ResizeInfo[i].Fixed := True;
end;
SizingArea := 0;
repeat
GridArea := DrawInfo.Horz.GridExtent;
for i := 0 to ColCount - 1 do
begin
if not ResizeInfo[i].Sizing then
begin
Dec(GridArea, ResizeInfo[i].Width);
end;
Dec(GridArea, DrawInfo.Horz.EffectiveLineWidth);
end;
if (GridArea < 0) and (StartIndex <> -1) then
begin
{═≤µφε ∩≡εßσµα≥ⁿ± ∩ε ∩ε±δσΣ≤■∙Φ∞ Φ Γ√±≥αΓΦ≥ⁿ Φ∞ ∞ΦφΦ∞αδⁿφ≤■ °Φ≡Φφ≤}
GridArea := DrawInfo.Horz.GridExtent;
for i := 0 to ColCount - 1 do
begin
if (not ResizeInfo[i].Sizing) and (i <> StartIndex) then
begin
Dec(GridArea, ResizeInfo[i].Width);
end
else begin
if ResizeInfo[i].Sizing then
begin
{┬√ßε≡ ∞ΦφΦ∞αδⁿφεπε ≡ατ∞σ≡α}
ResizeInfo[i].Width := 15;
ResizeInfo[i].Fixed := True;
Dec(GridArea, ResizeInfo[i].Width)
end;
end;
Dec(GridArea, DrawInfo.Horz.EffectiveLineWidth);
end;
ResizeInfo[StartIndex].Fixed := False;
if SizingArea <> 0 then
ResizeInfo[StartIndex].Width := GridArea
else
ResizeInfo[StartIndex].Width := 0;
Break;
end;
SizingArea := 0;
for i := 0 to ColCount - 1 do
begin
if ResizeInfo[i].Sizing then Inc(SizingArea, ResizeInfo[i].Width);
end;
AGridArea := GridArea;
ASizingArea := SizingArea;
if Abs(SizingArea - GridArea) = 1 then
begin
for i := 0 to ColCount - 1 do
begin
if ResizeInfo[i].Sizing then
begin
ResizeInfo[i].Width := ResizeInfo[i].Width + GridArea - SizingArea;
Break;
end;
end;
SizingArea := GridArea;
end;
if (SizingArea > 0) and (SizingArea <> GridArea) then
begin
for i := 0 to ColCount - 1 do
begin
if ResizeInfo[i].Sizing then
begin
AWidth := ResizeInfo[i].Width;
ResizeInfo[i].Width := MulDiv(AWidth, AGridArea, ASizingArea);
{╠ΦφΦ∞αδⁿφεσ τφα≈σφΦσ}
if ResizeInfo[i].Width < 15 then
begin
ResizeInfo[i].Width := 15;
ResizeInfo[i].Sizing := False;
ResizeInfo[i].Fixed := False;
Break;
end;
Dec(AGridArea, ResizeInfo[i].Width);
Dec(ASizingArea, AWidth);
end;
end;
end;
until (SizingArea = 0) or (SizingArea = GridArea);
if (SizingArea <> GridArea) and (StartIndex <> -1) then with ResizeInfo[StartIndex] do
begin
Width := Width + GridArea - SizingArea;
Fixed := False;
end;
UpdateColWidth;
UnlockUpdate;
ColWidthsChanged;
end;
procedure TDCCustomGrid.SetScrollBars(const Value: TScrollStyle);
var
AValue: TScrollStyle;
begin
FScrollBars := Value;
AValue := Value;
if goAutoSize in GridOptions then
begin
case Value of
ssBoth:
AValue := ssVertical;
ssHorizontal:
AValue := ssNone;
end;
end;
inherited ScrollBars := AValue;
end;
procedure TDCCustomGrid.LockUpdate;
begin
FLockUpdate := True;
Inc(FLockCount);
end;
procedure TDCCustomGrid.UnlockUpdate;
begin
Dec(FLockCount);
if FLockCount = 0 then FLockUpdate := False;
end;
function TDCCustomGrid.UpdateLocked: boolean;
begin
Result := FLockUpdate;
end;
procedure TDCCustomGrid.ResizeColWidth(ACol, AWidth: integer);
begin
ColWidths[ACol] := AWidth;
end;
function TDCCustomGrid.CanColResize(ACol: integer): boolean;
begin
Result := ACol >= FixedCols;
end;
procedure TDCCustomGrid.ConstrainedResize(var MinWidth, MinHeight,
MaxWidth, MaxHeight: Integer);
var
i: integer;
begin
inherited;
if goAutoSize in GridOptions then
begin
MinWidth := 0;
for i := 0 to ColCount - 1 do
begin
if CanColResize(i) and (ColWidths[i] <> -1) then
Inc(MinWidth, -1)
else
Inc(MinWidth, ColWidths[i]);
end;
end;
end;
procedure TDCCustomGrid.BeginLayout;
begin
{}
end;
procedure TDCCustomGrid.Endlayout;
begin
{}
end;
function TDCCustomGrid.GetClientRect: TRect;
var
aHeight: integer;
begin
Result := inherited GetClientRect;
aHeight := FFooters.Height;
if aHeight > 0 then Result.Bottom := Result.Bottom - aHeight;
end;
procedure TDCCustomGrid.Paint;
var
SaveIndex: integer;
ARect: TRect;
begin
ARect := FFooters.BoundsRect;
if not IsRectEmpty(ARect) and RectVisible(Canvas.Handle, ARect) then
begin
SaveIndex := SaveDC(Canvas.Handle);
try
ExcludeClipRect(Canvas.Handle, ARect.Left, ARect.Top, ARect.Right,
ARect.Bottom);
inherited;
finally
RestoreDC(Canvas.Handle, SaveIndex);
end;
FFooters.Draw;
end
else
inherited;
end;
function TDCCustomGrid.GetGridBounds: TRect;
begin
Result := inherited GetClientRect;
end;
procedure TDCCustomGrid.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
R: TRect;
begin
if not DoubleBuffered or (Message. DC <> 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else
begin
DC := GetDC(0);
R := GetGridBounds;
MemBitmap := CreateCompatibleBitmap(DC, R.Right, R.Bottom);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
WMPaint(Message);
Message.DC := 0;
BitBlt(DC, 0, 0, R.Right, R.Bottom, MemDC, 0, 0, SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;
{ TDCGroupBoxList }
function TDCGroupBoxList.Add(AColIndex, ALOffset: integer): integer;
var
pBoxItem: PGroupBoxItem_tag;
begin
GetMem(pBoxItem, SizeOf(TGroupBoxItem));
pBoxItem^.ColIndex := AColIndex;
pBoxItem^.LOffset := ALOffset;
Result := inherited Add(pBoxItem);
UpdateItemSize(Result);
end;
procedure TDCGroupBoxList.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TDCGroupBoxList.Changed;
begin
if FUpdateCount = 0 then Update;
end;
procedure TDCGroupBoxList.Clear;
var
i: integer;
begin
for i := 0 to Count -1 do
begin
FreeMem(Items[i], SizeOf(TGroupBoxItem));
end;
inherited Clear;
end;
procedure TDCGroupBoxList.ColumnMoved(FromIndex, ToIndex: Integer);
var
i, nCount: integer;
pBoxItem: PGroupBoxItem_tag;
begin
nCount := Count;
for i := 0 to nCount -1 do
begin
pBoxItem := Items[i];
if pBoxItem^.ColIndex = FromIndex then
pBoxItem^.ColIndex := ToIndex
else begin
if FromIndex > ToIndex then
if (pBoxItem^.ColIndex >= ToIndex) and (pBoxItem^.ColIndex < FromIndex) then Inc(pBoxItem^.ColIndex) else
else
if (pBoxItem^.ColIndex <= ToIndex) and (pBoxItem^.ColIndex > FromIndex) then Dec(pBoxItem^.ColIndex);
end;
end;
end;
constructor TDCGroupBoxList.Create(AOwner: TDCCustomGrid);
begin
inherited Create;
FOwner := AOwner;
FMargin := Point(5, 5);
FUpdateCount := 0;
FMoveIndex := -1;
FMovePos := -1;
FFixedCols := 0;
end;
procedure TDCGroupBoxList.Delete(Index: integer);
var
pBoxItem: PGroupBoxItem_tag;
begin
while (Index >=0) and (BoxItems[Index].LOffset = 0) do Dec(Index);
repeat
pBoxItem := Items[Index];
FreeMem(pBoxItem, SizeOf(TGroupBoxItem));
inherited Delete(Index);
Inc(Index);
until (Index > Count - 1) or (BoxItems[Index].LOffset <> 0);
Changed;
end;
procedure TDCGroupBoxList.Draw;
var
DrawStr: string;
i, Border, c: integer;
ClipRect, R, ARect: TRect;
Offset, PosA, PosB: TPoint;
BoxItem: TGroupBoxItem;
DC: HDC;
begin
Offset := Point(FMargin.X, FMargin.Y);
with FOwner do
begin
DC := GetWindowDC(Handle);
Canvas.Handle := DC;
Canvas.Font := Font;
try
Canvas.Brush.Color := clBtnShadow;
GetWindowRect(Handle, ARect); OffsetRect(ARect, -ARect.Left, -ARect.Top);
ARect.Bottom := GetBoxSize;
if BorderStyle = bsSingle then
begin
InflateRect(ARect, -1, 0);
OffsetRect(ARect, 0, 1);
if not FlatButtons then OffsetRect(ARect, 0, 1);
end;
if Count = 0 then
begin
ClipRect := ARect;
DrawStr := LoadStr(RES_STRN_MSG_GRPBOX);
InflateRect(ClipRect, -Offset.X, -Offset.Y);
Canvas.Font.Color := clWindow;
DrawText(Canvas.Handle, PChar(DrawStr), Length(DrawStr), ClipRect, DT_CALCRECT);
DrawText(Canvas.Handle, PChar(DrawStr), Length(DrawStr), ClipRect, DT_LEFT or DT_END_ELLIPSIS);
with ClipRect do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
end
else begin
for i := 0 to Count-1 do
begin
BoxItem := BoxItems[i];
R := Rect(0, 0, BoxItem.Size.X, BoxItem.Size.Y);
OffsetRect(R, Offset.X, Offset.Y);
ClipRect := R;
Border := 1;
c := ColorToRGB(clSilver);
c := RGB(GetRValue(c) shr 1, GetGValue(c) shr 1, GetBValue(c) shr 1);
Canvas.Pen.Color := GetNearestColor(Canvas.Handle, c);
if i = Self.FMoveIndex then
begin
{Down}
DrawEdge(Canvas.Handle, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
Canvas.PenPos := Point(R.Left, R.Bottom);
Canvas.LineTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Top);
InflateRect(R, -1, -1);
try
DrawTitleCell(Canvas, RawToDataColumn(BoxItem.ColIndex), 0, R, dsDown, True, True);
except
{}
end;
end
else begin
{Up}
DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_TOPLEFT);
Canvas.PenPos := Point(R.Left, R.Bottom-1);
Canvas.LineTo(R.Right-1, R.Bottom-1);
Canvas.LineTo(R.Right-1, R.Top);
InflateRect(R, -1, -1);
try
DrawTitleCell(Canvas, RawToDataColumn(BoxItem.ColIndex), 0, R, dsUp, True, True);
except
{}
end;
end;
{Γ√≈Φ±δ ∞ ±∞σ∙σφΦ Σδ ±δσΣ≤■∙σπε ²δσ∞σφ≥α}
if (i < Count -1) and (BoxItems[i+1].LOffset = 0) then
Inc(Offset.X, 2 + BoxItem.Size.X)
else begin
Inc(Offset.X, 5 + BoxItem.Size.X);
if (i <> 0) and (BoxItems[i].LOffset <> 0) then
begin
{≡Φ±≤σ∞ ±εσΣΦφΦ≥σδⁿφ√σ δΦφφΦΦ}
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := 1;
PosA := Point(R.Left - 13, R.Bottom - 5);
PosB := Point(R.Left - Border, R.Bottom - 5);
Canvas.PenPos := PosA;
Canvas.LineTo(PosB.X, PosB.Y);
ExcludeClipRect(Canvas.Handle, PosA.X, PosA.Y, PosB.X + 1, PosB.Y + 1);
PosA := Point(R.Left - 13, R.Top - BoxItems[i-1].Size.Y div 2);
PosB := Point(R.Left - 13, R.Bottom - 5);
Canvas.PenPos := PosA;
Canvas.LineTo(PosB.X, PosB.Y);
ExcludeClipRect(Canvas.Handle, PosA.X, PosA.Y, PosB.X+1, PosB.Y+1);
end;
end;
Inc(Offset.Y, GetItemOffset(i));
with ClipRect do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
end;
end;
Canvas.FillRect(ARect);
finally
Canvas.Handle := 0;
ReleaseDC(Handle, DC);
end;
end;
end;
procedure TDCGroupBoxList.EndUpdate;
begin
if FUpdateCount > 0 then
begin
Dec(FUpdateCount);
Changed;
end;
end;
function TDCGroupBoxList.Find(AColIndex: integer): integer;
var
i: integer;
begin
Result := -1;
for i := 0 to Count-1 do
if BoxItems[i].ColIndex = AColIndex then
begin
Result := i;
Break;
end
end;
function TDCGroupBoxList.GetAreaAtPos(APos: TPoint): integer;
var
i, OffsetX: integer;
begin
OffsetX := FMargin.X;
for i := 0 to Count - 1 do
begin
Inc(OffsetX, BoxItems[i].Size.X);
if APos.X < OffsetX then
begin
Result := i;
Exit;;
end;
Inc(OffsetX, 5);
end;
Result := Count;
end;
function TDCGroupBoxList.GetBoundsRect: TRect;
begin
Result := Rect(0, 0, FOwner.ClientWidth, FBoxSize);
end;
function TDCGroupBoxList.GetBoxItems(Index: integer): TGroupBoxItem;
begin
Result := PGroupBoxItem_tag(Items[Index])^;
end;
function TDCGroupBoxList.GetBoxSize: integer;
begin
if FOwner.GroupingEnabled and FOwner.Grouping then
Result := FBoxSize
else
Result := 0;
end;
function TDCGroupBoxList.GetItemAtPos(APos: TPoint): integer;
var
i: integer;
R: TRect;
Offset: TPoint;
BoxItem: TGroupBoxItem;
begin
APos.Y := APos.Y + BoxSize + 1;
Offset := Point(FMargin.X, FMargin.Y);
Result := -1;
for i := 0 to Count - 1 do
begin
BoxItem := BoxItems[i];
R := Rect(0, 0, BoxItem.Size.X, BoxItem.Size.Y);
OffsetRect(R, Offset.X, Offset.Y);
if PtInRect(R, APos) then
begin
Result := i;
Break;
end;
if (i < Count -1) and (BoxItems[i+1].LOffset = 0) then
Inc(Offset.X, 2 + BoxItem.Size.X)
else
Inc(Offset.X, 5 + BoxItem.Size.X);
Inc(Offset.Y, GetItemOffset(i));
end;
end;
function TDCGroupBoxList.GetItemOffset(i: integer): integer;
begin
if (i < Count - 1) and (BoxItems[i+1].LOffset > 0)then
begin
if i = Count - 1 then
Result := BoxItems[i].Size.Y div 2
else begin
if BoxItems[i].Size.Y <= BoxItems[i+1].Size.Y then
Result := BoxItems[i].MaxHeight div 2
else
Result := BoxItems[i].MaxHeight - BoxItems[i+1].Size.Y div 2;
end;
end
else
Result := 0;
end;
function TDCGroupBoxList.GetItemRect(Index: integer): TRect;
var
i: integer;
Offset: TPoint;
begin
if (Index < 0) then
begin
SetRectEmpty(Result);
Exit;
end;
i := 0;
Offset := Point(FMargin.X, FMargin.Y);
if Count = 0 then
Result := Rect(0, 0, 1, BoxSize - FMargin.Y - 10)
else begin
while (i < Index) and (i < Count) do
begin
Inc(Offset.X, 5 + BoxItems[i].Size.X);
Inc(Offset.Y, GetItemOffset(i));
Inc(i);
end;
if Index >= Count then
begin
Result := Rect(0, 0, BoxItems[Count-1].Size.X, BoxItems[Count-1].Size.Y);
Dec(Offset.Y, GetItemOffset(Count-1));
Dec(Offset.X, BoxItems[Count-1].Size.X + 5);
end
else
Result := Rect(0, 0, BoxItems[Index].Size.X, BoxItems[Index].Size.Y);
end;
OffsetRect(Result, Offset.X, Offset.Y - BoxSize);
end;
procedure TDCGroupBoxList.Insert(Index, AColIndex, ALOffset: integer);
var
pBoxItem: PGroupBoxItem_tag;
begin
GetMem(pBoxItem, SizeOf(TGroupBoxItem));
pBoxItem^.ColIndex := AColIndex;
pBoxItem^.LOffset := ALOffset;
inherited Insert(Index, pBoxItem);
UpdateItemSize(Index);
end;
procedure TDCGroupBoxList.Invalidate;
begin
if FOwner.HandleAllocated and (BoxSize > 0) then Draw;
end;
function TDCGroupBoxList.MouseInBox(X, Y: integer; Convert: boolean): boolean;
var
P: TPoint;
begin
if BoxSize > 0 then
begin
if Convert then
P := PtConvert(FOwner.ScreenToClient(Point(X, Y)))
else
P := PtConvert(Point(X, Y));
Result := PtInRect(BoundsRect, P);
end
else
Result := False;
end;
procedure TDCGroupBoxList.Move(CurIndex, NewIndex: Integer);
begin
while (NewIndex >=0) and (BoxItems[NewIndex].LOffset = 0) do Dec(NewIndex);
while (CurIndex >=0) and (BoxItems[CurIndex].LOffset = 0) do Dec(CurIndex);
if CurIndex <> NewIndex then
begin
repeat
inherited Move(CurIndex, NewIndex);
Inc(CurIndex);
Inc(NewIndex);
until (CurIndex > Count - 1) or (BoxItems[CurIndex].LOffset <> 0)
end;
end;
function TDCGroupBoxList.PtConvert(APoint: TPoint): TPoint;
begin
Result := Point(APoint.X + FOwner.BorderWidth, APoint.Y + FOwner.BorderWidth + FBoxSize);
if FOwner.FlatButtons then
begin
Dec(Result.X);
Dec(Result.Y);
end;
end;
procedure TDCGroupBoxList.SetBoxItems(Index: integer;
const Value: TGroupBoxItem);
begin
PGroupBoxItem_tag(Items[Index])^ := Value;
end;
procedure TDCGroupBoxList.SetFixedCols(const Value: integer);
var
i: integer;
pBoxItem: PGroupBoxItem_tag;
begin
if FFixedCols <> Value then
begin
for i := 0 to Count-1 do
begin
pBoxItem := Items[i];
pBoxItem^.ColIndex := pBoxItem^.ColIndex + Value - FFixedCols;
end;
FFixedCols := Value;
end;
end;
procedure TDCGroupBoxList.SetMoveIndex(const Value: integer);
begin
if FMoveIndex <> Value then
begin
FMoveIndex := Value;
Changed;
end;
end;
procedure TDCGroupBoxList.Update;
begin
with FOwner do
begin
BeginLayout;
GroupBoxChanged;
UpdateSize;
EndLayout;
Perform(CM_SHOWINGCHANGED, 0, 0);
end;
end;
procedure TDCGroupBoxList.UpdateItemSize(Index: integer);
var
R: TRect;
BoxItem: TGroupBoxItem;
lChanged: boolean;
begin
if (Index > -1) and (Index < Count) then
begin
R := Rect(0, 0, FOwner.ClientWidth, FOwner.ClientHeight);
BoxItem := BoxItems[Index];
with FOwner do
BoxItem.Size := DrawTitleCell(Canvas, RawToDataColumn(BoxItem.ColIndex), 0, R, dsUp, False, False);
if BoxItem.Size.Y = 0 then Inc(BoxItem.Size.Y, 1);
Inc(BoxItem.Size.Y, 5);
BoxItem.MaxHeight := BoxItem.Size.Y;
lChanged := (BoxItem.Size.Y <> BoxItems[Index].Size.Y) or (BoxItem.Size.X <> BoxItems[Index].Size.X);
BoxItems[Index] := BoxItem;
if lChanged then Changed
end;
end;
function TDCGroupBoxList.UpdateSize: integer;
var
i, ABoxSize: integer;
begin
ABoxSize := FBoxSize;
if FOwner.Grouping then
begin
Result := FMargin.Y;
if Count = 0 then
begin
Inc(Result, GetDCTextHeight(FOwner.Font, 'Wg'));
Inc(Result, 10);
end
else begin
for i := 0 to Count - 2 do
begin
Inc(Result, GetItemOffset(i));
if (BoxItems[i].LOffset = 0) and (i >0) then
PGroupBoxItem_tag(Items[i])^.MaxHeight :=
_intMax(BoxItems[i].MaxHeight, BoxItems[i-1].MaxHeight);
end;
i := Count - 1;
if (BoxItems[i].LOffset = 0) and (i >0) then
PGroupBoxItem_tag(Items[i])^.MaxHeight :=
_intMax(BoxItems[i].MaxHeight, BoxItems[i-1].MaxHeight);
if i >= 0 then Inc(Result, BoxItems[i].MaxHeight);
Inc(Result, 4);
end;
end
else
Result := 0;
FBoxSize := Result;
if ABoxSize <> Result then with FOwner do
begin
SetWindowPos(Handle, HWND_TOP, Left, Top, Width, Height,
SWP_FRAMECHANGED or SWP_NOZORDER or SWP_NOREDRAW);
RedrawWindow(Handle, nil, 0,
RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_NOINTERNALPAINT);
end;
end;
procedure CreateGridIndicators;
var
Bitmap: TBitmap;
i: integer;
const
GRID_INDICATOR_COUNT = 11;
aGridIndicators: array [0..GRID_INDICATOR_COUNT - 1] of string =
( bmArrow, bmEdit, bmInsert, bmMultiDot, bmMultiArrow, bmCheck, bmMain,
bmIndexAsc, bmIndexDesc, bmIndexNone, bmCheckHrd);
begin
Bitmap := TBitmap.Create;
try
for i := 0 to GRID_INDICATOR_COUNT - 1 do
begin
Bitmap.LoadFromResourceName(HInstance, aGridIndicators[i]);
if i = 0 then GridIndicatorImages := TImageList.CreateSize(Bitmap.Width, Bitmap.Height);
GridIndicatorImages.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0,0]);
end;
finally
Bitmap.Free;
end;
end;
procedure DestroyGridIndicators;
begin
GridIndicatorImages.Clear;
GridIndicatorImages.Free;
end;
function GDGetImages: TImageList;
begin
Result := GridIndicatorImages;
end;
{ TDCFooter }
procedure TDCFooter.Changed(AllItems: boolean);
begin
if (FOwner <> nil) and (FOwner.FUpdateCount = 0) then
begin
AdjustHeight;
if AllItems then
FOwner.Update(nil)
else
FOwner.Update(Self)
end;
end;
procedure TDCFooter.ColumnMoved(FromIndex, ToIndex: Integer);
var
i, nCount: integer;
Panel: TDCFooterPanel;
begin
nCount := Panels.Count;
Owner.BeginUpdate;
for i := 0 to nCount -1 do
begin
Panel := Panels.Items[i];
if Panel.ColIndex = FromIndex then
Panel.ColIndex := ToIndex
else begin
if FromIndex > ToIndex then
if (Panel.ColIndex >= ToIndex) and (Panel.ColIndex < FromIndex) then
Panel.ColIndex := Panel.ColIndex + 1
else
else
if (Panel.ColIndex <= ToIndex) and (Panel.ColIndex > FromIndex) then
Panel.ColIndex := Panel.ColIndex - 1;
end;
end;
Owner.EndUpdate;
end;
constructor TDCFooter.Create(AOwner: TDCFooters);
begin
inherited Create;
FPanels := TDCFooterPanels.Create(Self);
FCanvas := TCanvas.Create;
FVisible := True;
FHeight := -1;
FAutoSize := True;
SetOwner(AOwner);
end;
destructor TDCFooter.Destroy;
begin
SetOwner(nil);
FCanvas.Free;
FPanels.Free;
inherited;
end;
procedure TDCFooter.DrawItem(ACanvas: TCanvas; DrawInfo: TGridDrawInfo;
const Rect: TRect; Index: integer);
var
DC: HDC;
R: TRect;
i, nCount: integer;
Panel: TDCFooterPanel;
begin
DC := ACanvas.Handle;
FCanvas.Lock;
try
FCanvas.Handle := DC;
FCanvas.Font := Font;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Brush.Style := bsSolid;
{Draw}
if Index = -1 then
begin
nCount := Panels.Count;
for i := 0 to nCount - 1 do with DrawInfo.Horz do
begin
Panel := Panels.Items[i];
if Panel.Visible and (Panel.ColIndex <> -1) then
begin
R := Grid.BoxRect(Panel.ColIndex, 0, Panel.ColIndex, 0);
if (R.Left >= FixedBoundary) and not IsRectEmpty(R)then
begin
R.Top := Rect.Top;
R.Bottom := Rect.Bottom;
InflateRect(R, 0, -1);
if Panel.Draw(R, DrawInfo) then
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
end;
end;
end
end
else begin
Panel := Panels.Items[Index];
R := Grid.BoxRect(Panel.ColIndex, 0, Panel.ColIndex, 0);
if not IsRectEmpty(R) then
begin
R.Left := _intMax(R.Left, DrawInfo.Horz.FixedBoundary);
R.Top := Rect.Top;
R.Bottom := Rect.Bottom;
if not( Panel.Visible and Panel.Draw(R, DrawInfo) ) then Canvas.FillRect(R);
end;
end;
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
end;
end;
function TDCFooter.GetColor: TColor;
begin
if Grid <> nil then
Result := Grid.FixedColor
else
Result := clWindow;
end;
function TDCFooter.GetFont: TFont;
begin
if Grid <> nil then
Result := Grid.Font
else
Result := nil;
end;
function TDCFooter.GetGrid: TDCCustomGrid;
begin
if Assigned(FOwner) then
Result := FOwner.Grid
else
Result := nil;
end;
function TDCFooter.GetHeight: integer;
begin
Result := FHeight;
end;
function TDCFooter.GetIndex: integer;
begin
if Owner <> nil then
Result := Owner.FItems.IndexOf(Self)
else
Result := -1;
end;
function TDCFooter.GetVisible: boolean;
begin
Result := FVisible;
end;
procedure TDCFooter.SetStyle(const Value: TBevelStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
Changed(False);
end;
end;
procedure TDCFooter.SetHeight(const Value: integer);
begin
if FHeight <> Value then
begin
FHeight := Value;
Changed(True);
end;
end;
procedure TDCFooter.SetIndex(const Value: integer);
var
CurIndex: Integer;
begin
CurIndex := GetIndex;
if (CurIndex >= 0) and (CurIndex <> Value) then
begin
FOwner.FItems.Move(CurIndex, Value);
Changed(True);
end;
end;
procedure TDCFooter.SetOwner(Value: TDCFooters);
begin
if FOwner <> Value then
begin
if FOwner <> nil then FOwner.RemoveItem(Self);
if Value <> nil then Value.InsertItem(Self);
AdjustHeight;
end;
end;
procedure TDCFooter.SetPanels(const Value: TDCFooterPanels);
begin
FPanels.Assign(Value);
Changed(True);
end;
procedure TDCFooter.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
Changed(True);
end;
end;
procedure TDCFooter.UpdatePanel(Index: Integer; Repaint: Boolean);
begin
Owner.RedrawItem(Self, Index);
end;
procedure TDCFooter.SetAutoSize(const Value: boolean);
begin
if FAutoSize <> Value then
begin
FAutoSize := Value;
Changed(True);
end;
end;
procedure TDCFooter.AdjustHeight;
var
i, nCount, h: integer;
Panel: TDCFooterPanel;
begin
if AutoSize then
begin
nCount := Panels.Count;
h := 0;
for i := 0 to nCount -1 do
begin
Panel := Panels.Items[i];
if Panel.Visible then h := _IntMax(Panel.AdjustHeight, h);
end;
FHeight := h;
end;
end;
{ TDCFooterPanels }
function TDCFooterPanels.Add: TDCFooterPanel;
begin
Result := TDCFooterPanel(inherited Add);
end;
constructor TDCFooterPanels.Create(AOwner: TDCFooter);
begin
inherited Create(TDCFooterPanel);
FOwner := AOwner;
end;
function TDCFooterPanels.GetItem(Index: Integer): TDCFooterPanel;
begin
Result := TDCFooterPanel(inherited GetItem(Index));
end;
function TDCFooterPanels.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TDCFooterPanels.SetItem(Index: Integer; Value: TDCFooterPanel);
begin
inherited SetItem(Index, Value);
end;
procedure TDCFooterPanels.Update(Item: TCollectionItem);
begin
inherited;
with FOwner do
begin
if (Item = nil) or AutoSize then
Changed(False)
else
UpdatePanel(Item.Index, False)
end;
end;
{ TDCFooterPanel }
constructor TDCFooterPanel.Create(Collection: TCollection);
begin
inherited;
FStyle := beLowered;
FColIndex := -1;
FVisible := False;
end;
function TDCFooterPanel.Draw(const Rect: TRect; DrawInfo: TGridDrawInfo): boolean;
begin
Result := False;
end;
function TDCFooterPanel.GetCanvas: TCanvas;
begin
Result := Footer.Canvas;
end;
function TDCFooterPanel.GetColIndex: integer;
begin
Result := FColIndex;
end;
function TDCFooterPanel.GetFooter: TDCFooter;
begin
Result := TDCFooterPanels(Collection).FOwner;
end;
procedure TDCFooterPanel.SetColIndex(const Value: integer);
begin
if FColIndex <> Value then
begin
FColIndex := Value;
Changed(True);
end;
end;
procedure TDCFooterPanel.SetInternalColIndex(const Value: integer);
begin
if FColIndex <> Value then
begin
FColIndex := Value;
Changed(True);
end;
end;
procedure TDCFooterPanel.SetStyle(const Value: TBevelStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
Changed(False);
end;
end;
procedure TDCFooterPanel.SetVisible(const Value: boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
Changed(False);
end;
end;
function TDCFooterPanel.AdjustHeight: integer;
begin
Result := Footer.Height;
end;
{ TDCFooters }
procedure TDCFooters.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TDCFooters.Changed;
begin
if FUpdateCount = 0 then Update(nil);
end;
procedure TDCFooters.Clear;
var
i, iCount: integer;
begin
BeginUpdate;
iCount := Count;
for i := iCount-1 downto 0 do Items[i].Free;
EndUpdate;
end;
constructor TDCFooters.Create(AOwner: TDCCustomGrid);
begin
inherited Create;
FItems := TList.Create;
FOwner := AOwner;
FHeight := 0;
FStyle := beFlat;
end;
procedure TDCFooters.Delete(Index: Integer);
begin
TDCFooter(FItems[Index]).Free;
end;
destructor TDCFooters.Destroy;
begin
FItems.Free;
inherited;
end;
procedure TDCFooters.Draw;
var
ARect, BRect, mRect: TRect;
i, nCount, SaveIndex: integer;
Footer: TDCFooter;
DrawInfo: TGridDrawInfo;
begin
SaveIndex := SaveDC(Grid.Canvas.Handle);
try
ARect := BoundsRect;
BRect := PaintEdge(ARect);
mRect := GetMargins;
Inc(ARect.Left, mRect.Left);
Inc(ARect.Top, mRect.Top);
Dec(ARect.Right, mRect.Right);
nCount := Count;
Grid.CalcDrawInfo(DrawInfo);
for i := 0 to nCount -1 do
begin
Footer := Items[i];
if Footer.Visible then
begin
Footer.DrawItem(Grid.Canvas, DrawInfo,
Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Top + Footer.Height), -1);
Inc(ARect.Top, Footer.Height);
end;
end;
Grid.Canvas.FillRect(BRect);
finally
RestoreDC(Grid.Canvas.Handle, SaveIndex);
end;
end;
function TDCFooters.PaintEdge(ARect: TRect): TRect;
begin
with Grid, Canvas do
begin
Brush.Color := clBtnFace;
case FStyle of
beNone:;
beLowered:;
beRaised:
begin
DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_RECT);
InflateRect(ARect, -1, -1);
DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_RECT);
InflateRect(ARect, -1, -1);
end;
beFlat:
begin
DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_TOP);
Inc(ARect.Top, 1);
DrawEdge(Handle, ARect, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
InflateRect(ARect, -1, -1);
end;
beSingle:
begin
DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_TOP);
Inc(ARect.Top, 1);
end;
end;
end;
Result := ARect;
end;
procedure TDCFooters.EndUpdate;
begin
Dec(FUpdateCount);
if FUpdateCount = 0 then Update(nil);
end;
function TDCFooters.GetBoundsRect: TRect;
begin
Result := FOwner.GetGridBounds;
Result.Top := Result.Bottom - GetHeight;
end;
function TDCFooters.GetCount: Integer;
begin
Result := FItems.Count;
end;
function TDCFooters.GetHeight: integer;
begin
Result := FHeight;
end;
function TDCFooters.GetItem(Index: Integer): TDCFooter;
begin
Result := FItems.Items[Index]
end;
function TDCFooters.GetMargins: TRect;
const
aMargins: array[TBevelStyle] of TRect =
( {beNone} (Left: 1; Top: 1; Right: 1; Bottom: 1),
{beLowered} (Left: 3; Top: 3; Right: 3; Bottom: 3),
{beRaised} (Left: 3; Top: 3; Right: 3; Bottom: 3),
{beFlat} (Left: 2; Top: 3; Right: 2; Bottom: 2),
{beSingle} (Left: 1; Top: 2; Right: 1; Bottom: 1));
begin
Result := aMargins[FStyle];
end;
function TDCFooters.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TDCFooters.InsertItem(Item: TDCFooter);
begin
FItems.Add(Item);
Item.FOwner := Self;
Changed;
end;
procedure TDCFooters.RemoveItem(Item: TDCFooter);
begin
FItems.Remove(Item);
Item.FOwner := nil;
Changed;
end;
procedure TDCFooters.SetItem(Index: Integer; const Value: TDCFooter);
begin
end;
procedure TDCFooters.Update(Item: TDCFooter);
begin
FOwner.BeginLayout;
UpdateSize;
FOwner.EndLayout;
end;
function TDCFooters.UpdateSize: integer;
var
i, nCount: integer;
Footer: TDCFooter;
mRect: TRect;
begin
nCount := Count;
mRect := GetMargins;
FHeight := 0;
for i := 0 to nCount -1 do
begin
Footer := Items[i];
if Footer.Visible then Inc(FHeight, Footer.Height);
end;
if FHeight > 0 then Inc(FHeight, mRect.Top + mRect.Bottom);
Result := FHeight;
end;
procedure TDCFooters.SetStyle(const Value: TBevelStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
Changed;
end;
end;
procedure TDCFooters.ColumnMoved(FromIndex, ToIndex: Integer);
var
i, nCount: integer;
begin
BeginUpdate;
nCount := Count;
for i := 0 to nCount -1 do Items[i].ColumnMoved(FromIndex, ToIndex);
EndUpdate;
end;
procedure TDCFooters.RedrawItem(Item: TDCFooter; Index: integer);
var
ARect, BRect, mRect: TRect;
i, nCount, SaveIndex: integer;
Footer: TDCFooter;
DrawInfo: TGridDrawInfo;
begin
SaveIndex := SaveDC(Grid.Canvas.Handle);
try
ARect := BoundsRect;
BRect := PaintEdge(ARect);
mRect := GetMargins;
Inc(ARect.Left, mRect.Left);
Inc(ARect.Top, mRect.Top);
Dec(ARect.Right, mRect.Right);
nCount := Count;
Grid.CalcDrawInfo(DrawInfo);
for i := 0 to nCount -1 do
begin
Footer := Items[i];
if Footer = Item then
begin
Footer.DrawItem(Grid.Canvas, DrawInfo,
Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Top + Footer.Height), Index);
Break;
end;
if Footer.Visible then Inc(ARect.Top, Footer.Height);
end;
finally
RestoreDC(Grid.Canvas.Handle, SaveIndex);
end;
end;
procedure TDCFooters.Invalidate;
var
R: TRect;
begin
R := BoundsRect;
InvalidateRect(Grid.Canvas.Handle, @R, False);
end;
{ TDataGridDesigner }
constructor TDataGridDesigner.Create(DataGrid: TDCCustomGrid);
begin
FDataGrid := DataGrid;
FDataGrid.FDesigner := Self;
end;
destructor TDataGridDesigner.Destroy;
begin
FDataGrid.FDesigner := nil;
inherited;
end;
{ TDCFooterTextPanel }
function TDCFooterTextPanel.AdjustHeight: integer;
var
DC: HDC;
Rect: TRect;
begin
if Visible then
begin
Rect := Footer.Grid.GetGridBounds;
DC := GetDC(0);
try
Footer.Canvas.Handle := DC;
SetRectEmpty(Rect);
DoDrawText(Rect, DT_EXPANDTABS or DT_CALCRECT);
Canvas.Handle := 0;
finally
ReleaseDC(0, DC);
Result := Rect.Bottom - Rect.Top + 4;
case Style of
beNone:
;
beLowered:
Inc(Result, 2);
beRaised:
Inc(Result, 2);
beFlat:
;
beSingle:
Inc(Result, 2);
end;
end
end
else
Result := 0;
end;
procedure TDCFooterTextPanel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
function TDCFooterTextPanel.Draw(const Rect: TRect; DrawInfo: TGridDrawInfo): boolean;
var
R: TRect;
begin
R := PaintEdge(Rect, DrawInfo);
Canvas.FillRect(R);
InflateRect(R, -1, -1);
DoDrawText(R, DT_VCENTER or DT_SINGLELINE or DT_WORDBREAK or DT_END_ELLIPSIS);
Result := True;
end;
function TDCFooterTextPanel.PaintEdge(Rect: TRect; DrawInfo: TGridDrawInfo): TRect;
var
Brush: HBRUSH;
begin
Result := Rect;
if ColIndex = DrawInfo.Horz.LastFullVisibleCell + 1 then Inc(Result.Right);
case Style of
beNone:;
beLowered:
begin
DrawEdge(Canvas.Handle, Result, BDR_SUNKENOUTER, BF_RECT);
InflateRect(Result, -1, -1);
end;
beRaised:
begin
DrawEdge(Canvas.Handle, Result, BDR_RAISEDINNER, BF_RECT);
InflateRect(Result, -1, -1);
end;
beFlat:
begin
{!}
end;
beSingle:
begin
Brush := CreateSolidBrush(ColorToRGB(clBtnShadow));
try
FrameRect(Canvas.Handle, Result, Brush);
InflateRect(Result, -1, -1);
finally
DeleteObject(Brush);
end;
end;
end;
end;
procedure TDCFooterTextPanel.SetText(const Value: string);
begin
if FText <> Value then
begin
FText := Value;
Changed(False);
end;
end;
{ TSelectedArea }
constructor TSelectedArea.Create(AGrid: TDCCustomGrid);
begin
inherited Create;
FGrid := AGrid;
end;
destructor TSelectedArea.Destroy;
begin
inherited;
end;
function TSelectedArea.GetGrid: TDCCustomGrid;
begin
Result := FGrid;
end;
function TSelectedArea.IsEmpty: boolean;
begin
Result := True;
end;
initialization
ArrowsBitmap := TBitmap.Create;
CreateGridIndicators;
finalization
ArrowsBitmap.Free;
DestroyGridIndicators;
end.