TTXStringGrid组件 - 扩展delphi的标准TStringGrid组件

    1.1.64版本已发布，有兴趣请到 http://blog.youkuaiyun.com/boythl/archive/2008/11/25/3372110.aspx 下载。

 

     因为项目中有需求需要在TStringGrid的单元格中生成内置的下拉列表,如同TDBGrid里面的一样;貌似有个什么东西能做,但是是收费的, 本人口袋空空,只好自己实现该组件, 开源所有实现代码.

  

     1. 组件化,支持可视化设计;

     2. 支持列设置,包括字体,颜色,居中,列宽,visible,readonly, 内置下拉列表, 右键菜单等; 

     3. 增加一系列事件,如CellClick等.

     4. 对单元格的个性化设置的支持尚在开发中. 

 

      不好意思的说,因为头次写delphi组件, 所以所有代码都是从TCustDBGrid扒拉过来的, 简单嘛, 改吧改吧就能用了;  但TStringGrid的父类和TCustDBGrid做过部分类似的工作, ,所以有部分代码可能是冗余的, 不过应该不碍事.

 

    鉴于首次写组件的技术不成熟性,组件里肯定会有bug;  若发现bug,欢迎及时反馈,本人有时间会及时更新!

     本组件可自由转载,复制,使用,但请保留作者和版权信息! 若有源代码修改, 希望方便时能回增本人一份,boythl#163.com 谢谢!

 

     RAR格式的 完整的组件安装包下载链接请点这儿( B4 优快云,都不提供博客上传附件功能.) 

     ( https://p-blog.youkuaiyun.com/images/p_blog_youkuaiyun.com/boythl/EntryImages/20081007/TXStringGridV1.0.38.jpg  这是随文章上传的完整组件安装包, 请用右键另存为下载并将jpg扩展名改成rar, 就可以解压缩了.)

 

核心的 TXStringGrid.pas 完整代码如下: 

2. {*******************************************************}
3. {                                                       }
4. {       Lonefox Visual Component Library                }
5. {                                                       }
6. {       Copyright (c) 2008 All Rights Reserved          }
7. {                                                       }
8. {       http://lonefox.blogcn.com                       }
9. {       http://blog.youkuaiyun.com/boythl                 }
10. {                                                       }
11. {*******************************************************}
13. unit TXStringGrid;
15. interface
17. uses
18.   SysUtils, Classes, Windows, Controls, Grids, Graphics, Menus, Messages,
19.   Types, stdCtrls;
21. type
22.   TTXColButtonStyle = (tcbsNone, tcbsAutoSelect, tcbsEllipse);//列类型：普通，下拉菜单，按钮
24.   TTXColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
25.     cvTitleCaption, cvTitleAlignment, cvTitleFont);
26.   TTXColumnValues = set of TTXColumnValue;
27.      
28. const
29.     ColumnTitleValues = [cvTitleColor..cvTitleFont];
30.   cm_DeferLayout = WM_USER + 100;
32. type
33.     TTXStringGrid = class;
34.   TTXColumn = class;
36.   TTXColumnClass = class of TTXColumn;
38.   TTXColumnTitle = class(TPersistent)
39.   private
40.     FColumn: TTXColumn;
41.     FCaption: string;
42.     FFont: TFont;
43.     FColor: TColor;
44.     FAlignment: TAlignment;
45.     procedure FontChanged(Sender: TObject);
46.     function GetAlignment: TAlignment;
47.     function GetColor: TColor;
48.     function GetCaption: string;
49.     function GetFont: TFont;
50.     function IsAlignmentStored: Boolean;
51.     function IsColorStored: Boolean;
52.     function IsFontStored: Boolean;
53.     function IsCaptionStored: Boolean;
54.     procedure SetAlignment(Value: TAlignment);
55.     procedure SetColor(Value: TColor);
56.     procedure SetFont(Value: TFont);
57.     procedure SetCaption(const Value: string); virtual;
58.   protected
59.     procedure RefreshDefaultFont;
60.   public
61.     constructor Create(Column: TTXColumn);
62.     destructor Destroy; override;
63.     function DefaultAlignment: TAlignment;
64.     function DefaultColor: TColor;
65.     function DefaultFont: TFont;
66.     procedure RestoreDefaults; virtual;
67.     property Column: TTXColumn read FColumn;
68.   published
69.     property Alignment: TAlignment read GetAlignment write SetAlignment
70.       stored IsAlignmentStored;
71.     property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
72.     property Color: TColor read GetColor write SetColor stored IsColorStored;
73.     property Font: TFont read GetFont write SetFont stored IsFontStored;
74.   end;
76.   TTXColumn = class(TCollectionItem)
77.   private
78.     FAssignedValues: TTXColumnValues;
79.     FColor: TColor;
80.     FTitle: TTXColumnTitle;
81.     FFont: TFont;
82.     FPickList: TStrings;
83.     FPopupMenu: TPopupMenu;
84.     FDropDownRows: Cardinal;
85.     FButtonStyle: TTXColButtonStyle;
86.     FAlignment: TAlignment;
87.     FReadonly: Boolean;
88.     FVisible: Boolean;
89.     FStored: Boolean;
90.     FWidth: Integer;
91.     procedure FontChanged(Sender: TObject);
92.     function  GetAlignment: TAlignment;
93.     function  GetColor: TColor;
94.     function  GetFont: TFont;
95.     function  GetPickList: TStrings;
96.     function  GetReadOnly: Boolean;
97.     function  IsAlignmentStored: Boolean;
98.     function  IsColorStored: Boolean;
99.     function  IsFontStored: Boolean;
100.     function  IsReadOnlyStored: Boolean;
101.     procedure SetAlignment(Value: TAlignment); virtual;
102.     procedure SetButtonStyle(Value: TTXColButtonStyle);
103.     procedure SetColor(Value: TColor);
104.     procedure SetFont(Value: TFont);
105.     procedure SetPickList(Value: TStrings);
106.     procedure SetPopupMenu(Value: TPopupMenu);
107.     procedure SetReadOnly(Value: Boolean); virtual;
108.     procedure SetTitle(Value: TTXColumnTitle);
109.     procedure SetVisible(const Value: Boolean);
110.     function GetWidth: Integer;
111.     function IsWidthStored: Boolean;
112.     procedure SetWidth(const Value: Integer);
113.   protected
114.     function  CreateTitle: TTXColumnTitle; virtual;
115.     function  GetGrid: TTXStringGrid;
116.     procedure RefreshDefaultFont;
117.     property IsStored: Boolean read FStored write FStored default True;
118.     function DefaultWidth: integer;
119.   public
120.     constructor Create(Collection: TCollection); override;
121.     destructor Destroy; override;
122.     procedure Assign(Source: TPersistent); override;
123.     function  DefaultAlignment: TAlignment;
124.     function  DefaultColor: TColor;
125.     function  DefaultFont: TFont;
126.     procedure RestoreDefaults; virtual;
127.     property  Grid: TTXStringGrid read GetGrid;
128.     property  AssignedValues: TTXColumnValues read FAssignedValues;
129.   published
130.     property  Alignment: TAlignment read GetAlignment write SetAlignment
131.       stored IsAlignmentStored;
132.     property  ButtonStyle: TTXColButtonStyle read FButtonStyle write SetButtonStyle
133.       default tcbsNone;
134.     property  Color: TColor read GetColor write SetColor stored IsColorStored;
135.     property  DropDownRows: Cardinal read FDropDownRows write FDropDownRows default 7;
136.     property  Font: TFont read GetFont write SetFont stored IsFontStored;
137.     property  PickList: TStrings read GetPickList write SetPickList;
138.     property  PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
139.     property  ReadOnly: Boolean read GetReadOnly write SetReadOnly
140.       stored IsReadOnlyStored;
141.     property  Title: TTXColumnTitle read FTitle write SetTitle;
142.     property  Visible: Boolean read FVisible write SetVisible default true;
143.     property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
144.   end;
146.   TTXColumns = class(TCollection)
147.   private
148.     FGrid: TTXStringGrid;
149.     function GetTXColumn(Index: Integer): TTXColumn;
150.     procedure SetTXColumn(Index: Integer; Value: TTXColumn);
151.   protected
152.     function GetOwner: TPersistent; override;
153.     procedure Update(Item: TCollectionItem); override;
154.   public
155.     constructor Create(Grid: TTXStringGrid; ColumnClass: TTXColumnClass);
156.     function  Add: TTXColumn;
157.     procedure RestoreDefaults;
158.     property Grid: TTXStringGrid read FGrid;
159.     property Items[Index: Integer]: TTXColumn read GetTXColumn write SetTXColumn; default;
160.   end;
162.   TTXStringGridInplaceEdit = class(TInplaceEditList)
163.   private
164.     FDataList: TListBox;
165.     FUseDataList: Boolean;
166.   protected
167.     procedure CloseUp(Accept: Boolean); override;
168.     procedure DoEditButtonClick; override;
169.     procedure DropDown; override;
170.     procedure UpdateContents; override;
171.   public
172.     constructor Create(Owner: TComponent); override;
173.     property  DataList: TListBox read FDataList;
174.   end;
176.   TTXStringGridClickEvent = procedure (Column: TTXColumn; ARow:integer) of object;
178.   TTXStringGrid = class(TStringGrid)
179.   private
180.     FColumns : TTXColumns;
182.     FTitleOffset: Byte;
183.     FUpdateLock: Byte;
184.     FLayoutLock: Byte; 
185.     FDefaultDrawing: Boolean;
186.     FSelfChangingTitleFont: Boolean;
187.     FOnColEnter: TNotifyEvent;
188.     FOnColExit: TNotifyEvent;
189.     FVisibleColumns: TList;
190.     FOnEditButtonClick: TNotifyEvent;
191.     FOnColumnMoved: TMovedEvent;
192.     FOnCellClick    : TTXStringGridClickEvent;
193.     FOnTitleClick   : TTXStringGridClickEvent;
195.     function GetTXColumns() : TTXColumns;
196.     procedure SetTXColumns(value : TTXColumns);
197.     function AcquireFocus: Boolean;
198.     procedure InternalLayout;
199.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
200.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
201.     procedure CMDeferLayout(var Message); message cm_DeferLayout;
202.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
203.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFOCUS;
204.     procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
205.   protected
206.     FAcquireFocus: Boolean;
207.     function  AcquireLayoutLock: Boolean;
208.     procedure ColWidthsChanged; override;
209.     procedure BeginLayout;
210.     procedure BeginUpdate; 
211.     procedure CancelLayout;
212.     function  CanEditModify: Boolean; override;
213.     function  CanEditShow: Boolean; override;
214.     procedure CellClick(Column: TTXColumn; ARow:integer); dynamic;
215.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
216.     function CalcTitleRect(Col: TTXColumn; ARow: Integer;
217.       var MasterCol: TTXColumn): TRect;
218.     procedure ColEnter; dynamic;
219.     procedure ColExit; dynamic;
220.     function  CreateEditor: TInplaceEdit; override;
221.     procedure CreateWnd; override;
222.     procedure DeferLayout;
223.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
224.     procedure EditButtonClick; dynamic;
225.     procedure EndLayout;
226.     procedure EndUpdate;
227.     function  GetEditStyle(ACol, ARow: Longint): TEditStyle; override;
228.     function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
229.       AState: TGridDrawState): Boolean; virtual;
230.     procedure InvalidateTitles;
231.     procedure LayoutChanged; virtual;
232.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
233.       X, Y: Integer); override;
234.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
235.       X, Y: Integer); override;
236.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
237.     procedure Scroll(Distance: Integer); virtual;
238.     procedure SetColumnAttributes; virtual;
239.     function  StoreColumns: Boolean;
240.     procedure TitleClick(Column: TTXColumn; ARow:integer); dynamic;
241.     procedure TopLeftChanged; override;  
242.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
243.     property LayoutLock: Byte read FLayoutLock;
244.     property ParentColor default False;
245.     property UpdateLock: Byte read FUpdateLock;
246.   public
247.     constructor Create(AOwner: TComponent); override;
248.     destructor Destroy; override;
249.     procedure DefaultHandler(var Msg); override;
250.     procedure ShowPopupEditor(Column: TTXColumn; X: Integer = Low(Integer);
251.       Y: Integer = Low(Integer)); dynamic;
252.     property EditorMode;
253.   published
254.     property Columns : TTXColumns read GetTXColumns write SetTXColumns;
255.     property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
256.     property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
257.     property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
258.       write FOnEditButtonClick;
259.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
260.     property OnCellClick: TTXStringGridClickEvent read FOnCellClick write FOnCellClick;
261.     property OnTitleClick: TTXStringGridClickEvent read FOnTitleClick write FOnTitleClick;
262.   end;
264. procedure Register;
266. implementation
268. uses Math, Forms;
270. procedure Register;
271. begin
272.   RegisterComponents('Sample', [TTXStringGrid]);
273. end;
275. var
276.   DrawBitmap: TBitmap;
277.   UserCount: Integer;
279. {    public function   }
280. procedure KillMessage(Wnd: HWnd; Msg: Integer);
281. // Delete the requested message from the queue, but throw back
282. // any WM_QUIT msgs that PeekMessage may also return
283. var
284.   M: TMsg;
285. begin
286.   M.Message := 0;
287.   if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
288.     PostQuitMessage(M.wparam);
289. end;
291. procedure RaiseGridError(const S: string);
292. begin
293.   raise EInvalidGridOperation.Create(S);
294. end;
296. procedure UsesBitmap;
297. begin
298.   if UserCount = 0 then
299.     DrawBitmap := TBitmap.Create();
300.   Inc(UserCount);
301. end;
303. procedure ReleaseBitmap;
304. begin
305.   Dec(UserCount);
306.   if UserCount = 0 then DrawBitmap.Free;
307. end;
309. procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
310.   const Text: string; Alignment: TAlignment; ARightToLeft: Boolean);
311. const
312.   AlignFlags : array [TAlignment] of Integer =
313.     ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
314.       DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
315.       DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
316.   RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
317. var
318.   B, R: TRect;
319.   Hold, Left: Integer;
320.   I: TColorRef;
321. begin
322.   I := ColorToRGB(ACanvas.Brush.Color);
323.   if GetNearestColor(ACanvas.Handle, I) = I then
324.   begin                       { Use ExtTextOut for solid colors }
325.     { In BiDi, because we changed the window origin, the text that does not
326.       change alignment, actually gets its alignment changed. }
327.     if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
328.       ChangeBiDiModeAlignment(Alignment);
329.     case Alignment of
330.       taLeftJustify:
331.         Left := ARect.Left + DX;
332.       taRightJustify:
333.         Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
334.     else { taCenter }
335.       Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
336.         - (ACanvas.TextWidth(Text) shr 1);
337.     end;
338.     ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
339.   end
340.   else begin                  { Use FillRect and Drawtext for dithered colors }
341.     DrawBitmap.Canvas.Lock;
342.     try
343.       with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
344.       begin                     { brush origin tics in painting / scrolling.    }
345.         Width := Max(Width, Right - Left);
346.         Height := Max(Height, Bottom - Top);
347.         R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
348.         B := Rect(0, 0, Right - Left, Bottom - Top);
349.       end;
350.       with DrawBitmap.Canvas do
351.       begin
352.         Font := ACanvas.Font;
353.         Font.Color := ACanvas.Font.Color;
354.         Brush := ACanvas.Brush;
355.         Brush.Style := bsSolid;
356.         FillRect(B);
357.         SetBkMode(Handle, TRANSPARENT);
358.         if (ACanvas.CanvasOrientation = coRightToLeft) then
359.           ChangeBiDiModeAlignment(Alignment);
360.         DrawText(Handle, PChar(Text), Length(Text), R,
361.           AlignFlags[Alignment] or RTL[ARightToLeft]);
362.       end;
363.       if (ACanvas.CanvasOrientation = coRightToLeft) then  
364.       begin
365.         Hold := ARect.Left;
366.         ARect.Left := ARect.Right;
367.         ARect.Right := Hold;
368.       end;
369.       ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
370.     finally
371.       DrawBitmap.Canvas.Unlock;
372.     end;
373.   end;
374. end;
376. { TTXColumnTitle }
377. constructor TTXColumnTitle.Create(Column: TTXColumn);
378. begin
379.   inherited Create;
380.   FColumn := Column;
381.   FFont := TFont.Create;
382.   FFont.Assign(DefaultFont);
383.   FFont.OnChange := FontChanged;
384. end;
386. destructor TTXColumnTitle.Destroy;
387. begin
388.   FFont.Free;
389.   inherited Destroy;
390. end;
392. function TTXColumnTitle.DefaultAlignment: TAlignment;
393. begin
394.   Result := taLeftJustify;
395. end;
397. function TTXColumnTitle.DefaultColor: TColor;
398. var
399.   Grid: TTXStringGrid;
400. begin
401.   Grid := FColumn.GetGrid;
402.   if Assigned(Grid) then
403.     Result := Grid.FixedColor
404.   else
405.     Result := clBtnFace;
406. end;
408. function TTXColumnTitle.DefaultFont: TFont;
409. var
410.   Grid: TTXStringGrid;
411. begin
412.   Grid := FColumn.GetGrid;
413.   if Assigned(Grid) then
414.     Result := Grid.Font
415.   else
416.     Result := FColumn.Font;
417. end;
419. procedure TTXColumnTitle.FontChanged(Sender: TObject);
420. begin
421.   Include(FColumn.FAssignedValues, cvTitleFont);
422.   FColumn.Changed(True);
423. end;
425. function TTXColumnTitle.GetAlignment: TAlignment;
426. begin
427.   if cvTitleAlignment in FColumn.FAssignedValues then
428.     Result := FAlignment
429.   else
430.     Result := DefaultAlignment;
431. end;
433. function TTXColumnTitle.GetColor: TColor;
434. begin
435.   if cvTitleColor in FColumn.FAssignedValues then
436.     Result := FColor
437.   else
438.     Result := DefaultColor;
439. end;
441. function TTXColumnTitle.GetCaption: string;
442. begin
443.   if cvTitleCaption in FColumn.FAssignedValues then
444.     Result := FCaption;
445. end;
447. function TTXColumnTitle.GetFont: TFont;
448. var
449.   Save: TNotifyEvent;
450.   Def: TFont;
451. begin
452.   if not (cvTitleFont in FColumn.FAssignedValues) then
453.   begin
454.     Def := DefaultFont;
455.     if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
456.     begin
457.       Save := FFont.OnChange;
458.       FFont.OnChange := nil;
459.       FFont.Assign(DefaultFont);
460.       FFont.OnChange := Save;
461.     end;
462.   end;
463.   Result := FFont;
464. end;
466. function TTXColumnTitle.IsAlignmentStored: Boolean;
467. begin
468.   Result := (cvTitleAlignment in FColumn.FAssignedValues) and
469.     (FAlignment <> DefaultAlignment);
470. end;
472. function TTXColumnTitle.IsColorStored: Boolean;
473. begin
474.   Result := (cvTitleColor in FColumn.FAssignedValues) and
475.     (FColor <> DefaultColor);
476. end;
478. function TTXColumnTitle.IsFontStored: Boolean;
479. begin
480.   Result := (cvTitleFont in FColumn.FAssignedValues);
481. end;
483. function TTXColumnTitle.IsCaptionStored: Boolean;
484. begin
485.   Result := (cvTitleCaption in FColumn.FAssignedValues);
486. end;
488. procedure TTXColumnTitle.RefreshDefaultFont;
489. var
490.   Save: TNotifyEvent;
491. begin
492.   if (cvTitleFont in FColumn.FAssignedValues) then Exit;
493.   Save := FFont.OnChange;
494.   FFont.OnChange := nil;
495.   try
496.     FFont.Assign(DefaultFont);
497.   finally
498.     FFont.OnChange := Save;
499.   end;
500. end;
502. procedure TTXColumnTitle.RestoreDefaults;
503. var
504.   FontAssigned: Boolean;
505. begin
506.   FontAssigned := cvTitleFont in FColumn.FAssignedValues;
507.   FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
508.   FCaption := '';
509.   RefreshDefaultFont;
510.   { If font was assigned, changing it back to default may affect grid title
511.     height, and title height changes require layout and redraw of the grid. }
512.   FColumn.Changed(FontAssigned);
513. end;
515. procedure TTXColumnTitle.SetAlignment(Value: TAlignment);
516. begin
517.   if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
518.   FAlignment := Value;
519.   Include(FColumn.FAssignedValues, cvTitleAlignment);
520.   FColumn.Changed(False);
521. end;
523. procedure TTXColumnTitle.SetColor(Value: TColor);
524. begin
525.   if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
526.   FColor := Value;
527.   Include(FColumn.FAssignedValues, cvTitleColor);
528.   FColumn.Changed(False);
529. end;
531. procedure TTXColumnTitle.SetFont(Value: TFont);
532. begin
533.   FFont.Assign(Value);
534. end;
536. procedure TTXColumnTitle.SetCaption(const Value: string);
537. begin
538.   if Column.IsStored then
539.   begin
540.     if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
541.     FCaption := Value;
542.     Include(Column.FAssignedValues, cvTitleCaption);
543.     Column.Changed(False);
544.   end;
545. end;
548. { TTXColumn }
550. constructor TTXColumn.Create(Collection: TCollection);
551. begin
552.     FDropDownRows := 7;
553.   FButtonStyle := tcbsNone;
554.   FFont := TFont.Create;
555.   FFont.Assign(DefaultFont);
556.   FFont.OnChange := FontChanged;
557.   FTitle := CreateTitle;
558.   FVisible := True;
559.   FWidth := self.DefaultWidth;
561.   inherited Create(Collection);
563.   FStored := True;
564. end;
566. destructor TTXColumn.Destroy;
567. begin
568.   FTitle.Free;
569.   FFont.Free;
570.   FPickList.Free;
571.   inherited Destroy;
572. end;
574. procedure TTXColumn.Assign(Source: TPersistent);
575. begin
576.   if Source is TTXColumn then
577.   begin
578.     if Assigned(Collection) then Collection.BeginUpdate;
579.     try
580.       RestoreDefaults;
581.       if cvColor in TTXColumn(Source).AssignedValues then
582.         Color := TTXColumn(Source).Color;
583.       if cvWidth in TTXColumn(Source).AssignedValues then
584.         Width := TTXColumn(Source).Width;
585.       if cvFont in TTXColumn(Source).AssignedValues then
586.         Font := TTXColumn(Source).Font;
587.       if cvAlignment in TTXColumn(Source).AssignedValues then
588.         Alignment := TTXColumn(Source).Alignment;
589.       if cvReadOnly in TTXColumn(Source).AssignedValues then
590.         ReadOnly := TTXColumn(Source).ReadOnly;
591.       Title := TTXColumn(Source).Title;
592.       DropDownRows := TTXColumn(Source).DropDownRows;
593.       ButtonStyle := TTXColumn(Source).ButtonStyle;
594.       PickList := TTXColumn(Source).PickList;
595.       PopupMenu := TTXColumn(Source).PopupMenu;
596.     finally
597.       if Assigned(Collection) then Collection.EndUpdate;
598.     end;
599.   end
600.   else
601.     inherited Assign(Source);
602. end;
604. function TTXColumn.CreateTitle: TTXColumnTitle;
605. begin
606.   Result := TTXColumnTitle.Create(Self);
607. end;
609. function TTXColumn.DefaultAlignment: TAlignment;
610. begin
611.   Result := taLeftJustify;
612. end;
614. function TTXColumn.DefaultColor: TColor;
615. var
616.   Grid: TTXStringGrid;
617. begin
618.   Grid := GetGrid;
619.   if Assigned(Grid) then
620.     Result := Grid.Color
621.   else
622.     Result := clWindow;
623. end;
625. function TTXColumn.DefaultFont: TFont;
626. var
627.   Grid: TTXStringGrid;
628. begin
629.   Grid := GetGrid;
630.   if Assigned(Grid) then
631.     Result := Grid.Font
632.   else
633.     Result := FFont;
634. end;
636. procedure TTXColumn.FontChanged;
637. begin
638.   Include(FAssignedValues, cvFont);
639.   Title.RefreshDefaultFont;
640.   Changed(False);
641. end;
643. function TTXColumn.GetAlignment: TAlignment;
644. begin
645.   if cvAlignment in FAssignedValues then
646.     Result := FAlignment
647.   else
648.     Result := DefaultAlignment;
649. end;
651. function TTXColumn.GetColor: TColor;
652. begin
653.   if cvColor in FAssignedValues then
654.     Result := FColor
655.   else
656.     Result := DefaultColor;
657. end;
659. function TTXColumn.GetFont: TFont;
660. var
661.   Save: TNotifyEvent;
662. begin
663.   if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
664.   begin
665.     Save := FFont.OnChange;
666.     FFont.OnChange := nil;
667.     FFont.Assign(DefaultFont);
668.     FFont.OnChange := Save;
669.   end;
670.   Result := FFont;
671. end;
673. function TTXColumn.GetGrid: TTXStringGrid;
674. begin
675.   if Assigned(Collection) and (Collection is TTXColumns) then
676.     Result := TTXColumns(Collection).Grid
677.   else
678.     Result := nil;
679. end;
681. function TTXColumn.GetPickList: TStrings;
682. begin
683.   if FPickList = nil then
684.     FPickList := TStringList.Create;
685.   Result := FPickList;
686. end;
688. function TTXColumn.GetReadOnly: Boolean;
689. begin
690.   if cvReadOnly in FAssignedValues then
691.     Result := FReadOnly
692.   else
693.     Result := False;  //default "can write"
694. end;
696. function TTXColumn.IsAlignmentStored: Boolean;
697. begin
698.   Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
699. end;
701. function TTXColumn.IsColorStored: Boolean;
702. begin
703.   Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
704. end;
706. function TTXColumn.IsFontStored: Boolean;
707. begin
708.   Result := (cvFont in FAssignedValues);
709. end;
711. function TTXColumn.IsReadOnlyStored: Boolean;
712. begin
713.   Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> false);
714. end;
716. procedure TTXColumn.RefreshDefaultFont;
717. var
718.   Save: TNotifyEvent;
719. begin
720.   if cvFont in FAssignedValues then Exit;
721.   Save := FFont.OnChange;
722.   FFont.OnChange := nil;
723.   try
724.     FFont.Assign(DefaultFont);
725.   finally
726.     FFont.OnChange := Save;
727.   end;
728. end;
730. procedure TTXColumn.RestoreDefaults;
731. var
732.   FontAssigned: Boolean;
733. begin
734.   FontAssigned := cvFont in FAssignedValues;
735.   FTitle.RestoreDefaults;
736.   FAssignedValues := [];
737.   RefreshDefaultFont;
738.   FPickList.Free;
739.   FPickList := nil;
740.   ButtonStyle := tcbsNone;
741.   Changed(FontAssigned);
742. end;
744. procedure TTXColumn.SetAlignment(Value: TAlignment);
745. begin
746.   if IsStored then
747.   begin
748.     if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
749.     FAlignment := Value;
750.     Include(FAssignedValues, cvAlignment);
751.     Changed(False);
752.   end;
753. end;
755. procedure TTXColumn.SetButtonStyle(Value: TTXColButtonStyle);
756. begin
757.   if Value = FButtonStyle then Exit;
758.   FButtonStyle := Value;
759.   Changed(False);
760. end;
762. procedure TTXColumn.SetColor(Value: TColor);
763. begin
764.   if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
765.   FColor := Value;
766.   Include(FAssignedValues, cvColor);
767.   Changed(False);
768. end;
770. procedure TTXColumn.SetFont(Value: TFont);
771. begin
772.   FFont.Assign(Value);
773.   Include(FAssignedValues, cvFont);
774.   Changed(False);
775. end;
777. procedure TTXColumn.SetPickList(Value: TStrings);
778. begin
779.   if Value = nil then
780.   begin
781.     FPickList.Free;
782.     FPickList := nil;
783.     Exit;
784.   end;
785.   PickList.Assign(Value);
786. end;
788. procedure TTXColumn.SetPopupMenu(Value: TPopupMenu);
789. begin
790.   FPopupMenu := Value;
791.   if Value <> nil then Value.FreeNotification(GetGrid);
792. end;
794. procedure TTXColumn.SetReadOnly(Value: Boolean);
795. begin
796.   if IsStored then
797.   begin
798.     if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
799.     FReadOnly := Value;
800.     Include(FAssignedValues, cvReadOnly);
801.     Changed(False);
802.   end;
803. end;
805. procedure TTXColumn.SetTitle(Value: TTXColumnTitle);
806. begin
807.   FTitle.Assign(Value);
808. end;
810. procedure TTXColumn.SetVisible(const Value: Boolean);
811. begin
812.   if Value <> FVisible then
813.   begin
814.     FVisible := Value;
815.     Changed(True);
816.   end;
817. end;
819. function TTXColumn.GetWidth: Integer;
820. begin
821.   if not Visible then
822.     Result := -1
823.   else if cvWidth in FAssignedValues then
824.     Result := FWidth
825.   else
826.     Result := DefaultWidth;
827. end;
829. function TTXColumn.IsWidthStored: Boolean;
830. begin
831.     Result := (cvWidth in FAssignedValues) and
832.                     (FWidth <> DefaultWidth);
833. end;
835. procedure TTXColumn.SetWidth(const Value: Integer);
836. var
837.   Grid: TTXStringGrid;
838.   TM: TTextMetric;
839.   DoSetWidth: Boolean;
840. begin
841.   DoSetWidth := IsStored;
842.   if not DoSetWidth then
843.   begin
844.     Grid := GetGrid;
845.     if Assigned(Grid) then
846.     begin
847.       if Grid.HandleAllocated then
848.       with Grid do
849.       begin
850.         Canvas.Font := Self.Font;
851.         GetTextMetrics(Canvas.Handle, TM);
852.       end;
853.       if (cvWidth in FAssignedValues) then
854.         DoSetWidth := True;
855.     end
856.     else
857.       DoSetWidth := True;
858.   end;
859.   if DoSetWidth then
860.   begin
861.     if ((cvWidth in FAssignedValues) or (Value <> DefaultWidth))
862.       and (Value <> -1) then
863.     begin
864.       FWidth := Value;
865.       Include(FAssignedValues, cvWidth);
866.     end;
867.     Changed(False);
868.   end;
869. end;
871. function TTXColumn.DefaultWidth: integer;
872. begin
873.     if  Assigned(self.Collection) and Assigned(TTXColumns(self.Collection).FGrid) then
874.         Result := TTXColumns(self.Collection).FGrid.DefaultColWidth
875.   else
876.     Result := 60;
877. end;
879. { TTXColumns }
881. constructor TTXColumns.Create(Grid: TTXStringGrid; ColumnClass: TTXColumnClass);
882. begin
883.   inherited Create(ColumnClass);
884.   FGrid := Grid;
885. end;
887. function TTXColumns.Add: TTXColumn;
888. begin
889.   Result := TTXColumn(inherited Add);
890. end;
892. function TTXColumns.GetTXColumn(Index: Integer): TTXColumn;
893. begin
894.   Result := TTXColumn(inherited Items[Index]);
895. end;
897. function TTXColumns.GetOwner: TPersistent;
898. begin
899.   Result := FGrid;
900. end;
902. type
903.   TTXColumnsWrapper = class(TComponent)
904.   private
905.     FColumns: TTXColumns;
906.   published
907.     property Columns: TTXColumns read FColumns write FColumns;
908.   end;
910. procedure TTXColumns.RestoreDefaults;
911. var
912.   I: Integer;
913. begin
914.   BeginUpdate;
915.   try
916.     for I := 0 to Count - 1 do
917.       Items[I].RestoreDefaults;
918.   finally
919.     EndUpdate;
920.   end;
921. end;
923. procedure TTXColumns.SetTXColumn(Index: Integer; Value: TTXColumn);
924. begin
925.   Items[Index].Assign(Value);
926. end;
928. procedure TTXColumns.Update(Item: TCollectionItem);
929. var
930.   Raw: Integer;
931. begin
932.   if (FGrid = nil) or (csLoading in FGrid.ComponentState) then Exit;
934.   inherited;
936.   if Item = nil then
937.   begin
938.     self.FGrid.ColCount := self.Count;
939.     FGrid.LayoutChanged;
940.   end
941.   else
942.   begin
943.     Raw := Item.Index;
944.     FGrid.InvalidateCol(Raw);
945.     FGrid.ColWidths[Raw] := TTXColumn(Item).Width;
946.   end;
947. end;
949. function TTXStringGrid.GetTXColumns: TTXColumns;
950. begin
951.     Result := self.FColumns;
952. end;
954. procedure TTXStringGrid.SetTXColumns(value: TTXColumns);
955. begin
956.     self.Columns.Assign(value);
957. end;
959. {   Class TTXStringGridInplaceEdit    }
960. constructor TTXStringGridInplaceEdit.Create(Owner: TComponent);
961. begin
962.   inherited Create(Owner);
963. end;
965. procedure TTXStringGridInplaceEdit.CloseUp(Accept: Boolean);
966. var
967.   ListValue: string;
968. begin
969.   if ListVisible then
970.   begin
971.     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
972.     if ActiveList = DataList then
973.     begin
974.         if DataList.ItemIndex >= 0 then
975.         ListValue := DataList.Items[DataList.ItemIndex];
976.     end
977.     else
978.       if PickList.ItemIndex <> -1 then
979.         ListValue := PickList.Items[Picklist.ItemIndex];
980.     SetWindowPos(ActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
981.       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
982.     ListVisible := False;
983.     Invalidate;
984.     if Accept then
985.         with TTXStringGrid(Grid) do
986.       begin
987.         if ActiveList = DataList then
988.           Cells[Col, Row] := ListValue
989.         else
990.           if EditCanModify then
991.             Cells[Col, Row] := ListValue;
992.       end;
993.   end;
994. end;
996. procedure TTXStringGridInplaceEdit.DoEditButtonClick;
997. begin
998.   TTXStringGrid(Grid).EditButtonClick;
999. end;
1001. procedure TTXStringGridInplaceEdit.DropDown;
1002. var
1003.   Column: TTXColumn;
1004. begin
1005.   if not ListVisible then
1006.   begin
1007.     with TTXStringGrid(Grid) do
1008.       Column := Columns[Col];
1010.     with Column do begin
1011.       if ActiveList = FDataList then
1012.       begin
1013.         FDataList.Color := Color;
1014.         FDataList.Font := Font;
1015.       end
1016.       else if ActiveList = self.PickList then
1017.       begin
1018.         self.PickList.Items.Assign(PickList);
1019.         self.DropDownRows := Column.DropDownRows;
1020.       end;
1021.     end;
1022.   end;
1023.   inherited DropDown;
1024. end;
1026. procedure TTXStringGridInplaceEdit.UpdateContents;
1027. var
1028.   Column: TTXColumn;
1029. begin
1030.   inherited UpdateContents;
1031.   if FUseDataList then
1032.   begin
1033.     if FDataList = nil then
1034.     begin
1035.       FDataList := TListBox.Create(Self);
1036.       FDataList.Visible := False;
1037.       FDataList.Parent := Self;
1038.       FDataList.OnMouseUp := ListMouseUp;
1039.     end;
1040.     ActiveList := FDataList;
1041.   end;
1042.   with TTXStringGrid(Grid) do
1043.     Column := Columns[Col];
1044.   Self.ReadOnly := Column.ReadOnly;
1045.   Font.Assign(Column.Font);
1046. end;
1048. { TTXStringGrid }
1050. constructor TTXStringGrid.Create(AOwner: TComponent);
1051. var
1052.   i : integer;
1053. begin
1054.   inherited Create(AOwner);
1055.   inherited DefaultDrawing := False;
1056.   FAcquireFocus := True;
1058.   FTitleOffset := 1;
1059.   DesignOptionsBoost := [goColSizing, goRowSizing, goAlwaysShowEditor];
1060.   VirtualView := True;
1061.   UsesBitmap;
1062.   FVisibleColumns := TList.Create;
1064.   Color := clWindow;
1065.   ParentColor := False;
1066.   FDefaultDrawing := True;
1067.   HideEditor;
1069.   self.FColumns := TTXColumns.Create(self, TTXColumn);
1070.   for i := 0 to self.ColCount - 1 do //create default columns
1071.   Begin
1072.       self.FColumns.Add();
1073.     //self.ColWidths[i] := self.DefaultColWidth;
1074.   end;
1075. end;
1077. destructor TTXStringGrid.Destroy;
1078. begin
1079.     FColumns.Clear();
1080.   FColumns.Free;
1081.   FColumns := nil;
1083.   FVisibleColumns.Free;
1084.   FVisibleColumns := nil;
1085.   
1086.   inherited Destroy;
1087.   ReleaseBitmap;
1088. end;
1090. function TTXStringGrid.AcquireLayoutLock: Boolean;
1091. begin
1092.   Result := (FUpdateLock = 0) and (FLayoutLock = 0);
1093.   if Result then BeginLayout;
1094. end;
1096. procedure TTXStringGrid.BeginLayout;
1097. begin
1098.   BeginUpdate;
1099.   if (FLayoutLock = 0) and (Assigned(Columns)) then Columns.BeginUpdate;
1100.   Inc(FLayoutLock);
1101. end;
1103. procedure TTXStringGrid.BeginUpdate;
1104. begin
1105.   Inc(FUpdateLock);
1106. end;
1108. procedure TTXStringGrid.CancelLayout;
1109. begin
1110.   if FLayoutLock > 0 then
1111.   begin
1112.     if FLayoutLock = 1 then
1113.       Columns.EndUpdate;
1114.     Dec(FLayoutLock);
1115.     EndUpdate;
1116.   end;
1117. end;
1119. function TTXStringGrid.CanEditModify: Boolean;
1120. begin
1121.   Result := not Columns[Col].ReadOnly;
1122. end;
1124. function TTXStringGrid.CanEditShow: Boolean;
1125. begin
1126.   Result := (LayoutLock = 0) and inherited CanEditShow;
1127. end;
1129. procedure TTXStringGrid.CellClick(Column: TTXColumn; ARow:integer);
1130. begin
1131.   if Assigned(FOnCellClick) then FOnCellClick(Column, ARow);
1132. end;
1134. procedure TTXStringGrid.ColEnter;
1135. begin
1136.   if Assigned(FOnColEnter) then FOnColEnter(Self);
1137. end;
1139. procedure TTXStringGrid.ColExit;
1140. begin
1141.   if Assigned(FOnColExit) then FOnColExit(Self);
1142. end;
1144. procedure TTXStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
1145. begin
1146.   Columns[FromIndex].Index := ToIndex;
1147.   inherited ColumnMoved(FromIndex, ToIndex);
1148.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
1149. end;
1151. function TTXStringGrid.CreateEditor: TInplaceEdit;
1152. begin
1153.   Result := TTXStringGridInplaceEdit.Create(Self);
1154. end;
1156. procedure TTXStringGrid.CreateWnd;
1157. begin
1158.   BeginUpdate;   { prevent updates in WMSize message that follows WMCreate }
1159.   try
1160.     inherited CreateWnd;
1161.   finally
1162.     EndUpdate;
1163.   end;
1164. end;
1166. procedure TTXStringGrid.DefaultHandler(var Msg);
1167. var
1168.   P: TPopupMenu;
1169.   Cell: TGridCoord;
1170. begin
1171.   inherited DefaultHandler(Msg);
1172.   if TMessage(Msg).Msg = wm_RButtonUp then
1173.     with TWMRButtonUp(Msg) do
1174.     begin
1175.       Cell := MouseCoord(XPos, YPos);
1176.       if (Cell.X < 0) or (Cell.Y < 0) then Exit;
1177.       P := Columns[Cell.X].PopupMenu;
1178.       if (P <> nil) and P.AutoPopup then
1179.       begin
1180.         SendCancelMode(nil);
1181.         P.PopupComponent := Self;
1182.         with ClientToScreen(SmallPointToPoint(Pos)) do
1183.           P.Popup(X, Y);
1184.         Result := 1;
1185.       end;
1186.     end;
1187. end;
1189. procedure TTXStringGrid.DeferLayout;
1190. var
1191.   M: TMsg;
1192. begin
1193.   if HandleAllocated and
1194.     not PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_NoRemove) then
1195.     PostMessage(Handle, cm_DeferLayout, 0, 0);
1196.   CancelLayout;
1197. end;
1199. function TTXStringGrid.CalcTitleRect(Col: TTXColumn; ARow: Integer;
1200.   var MasterCol: TTXColumn): TRect;
1201. var
1202.   I,J, W: Integer;
1203.   DrawInfo: TGridDrawInfo;
1204. begin
1205.     MasterCol := Col;  //we don't surpport Parent column
1207.   I := Col.Index;
1208.     J := ARow;
1210.   Result := CellRect(I, J);
1211.   W := self.ColWidths[I];
1212.   Result.Right := Min(Result.Right, W + Result.Left);
1214.   if (J < FixedRows-1) then
1215.   begin
1216.     CalcFixedInfo(DrawInfo);
1217.     Result.Bottom := DrawInfo.Vert.FixedBoundary - DrawInfo.Vert.EffectiveLineWidth;
1218.   end;
1219. end;
1221. procedure TTXStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
1222. var
1223.   FrameOffs: Byte;
1225.   procedure DrawTitleCell(ACol, ARow: Integer; Column: TTXColumn; var AState: TGridDrawState);
1226.   const
1227.     ScrollArrows: array [Boolean, Boolean] of Integer =
1228.       ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
1229.   var
1230.     MasterCol: TTXColumn;
1231.     TitleRect, TextRect: TRect;
1232.   begin
1233.     TitleRect := CalcTitleRect(Column, ARow, MasterCol);
1235.     if MasterCol = nil then
1236.     begin
1237.       Canvas.FillRect(ARect);
1238.       Exit;
1239.     end;
1241.     Canvas.Font := MasterCol.Title.Font;
1242.     Canvas.Brush.Color := MasterCol.Title.Color;
1243.     if [goVertLine, goHorzLine] * Options = [goVertLine, goHorzLine] then
1244.       InflateRect(TitleRect, -1, -1);
1245.     TextRect := TitleRect;
1247.     with MasterCol.Title do
1248.       WriteText(Canvas, TextRect, FrameOffs, FrameOffs, Caption, Alignment,
1249.         IsRightToLeft);
1250.     if [goVertLine, goHorzLine] * Options = [goVertLine, goHorzLine] then
1251.     begin
1252.       InflateRect(TitleRect, 1, 1);
1253.       DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
1254.       DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
1255.     end;
1256.     AState := AState - [gdFixed];  // prevent box drawing later
1257.   end;
1259. var
1260.   Highlight: Boolean;
1261.   Value: string;
1262.   DrawColumn: TTXColumn;
1263. begin
1264.   if csLoading in ComponentState then
1265.   begin
1266.     Canvas.Brush.Color := Color;
1267.     Canvas.FillRect(ARect);
1268.     Exit;
1269.   end;
1271.   Dec(ARow, FTitleOffset);
1273.   if (gdFixed in AState) and ([goVertLine, goHorzLine] * Options =
1274.     [goVertLine, goHorzLine]) then
1275.   begin
1276.     InflateRect(ARect, -1, -1);
1277.     FrameOffs := 1;
1278.   end
1279.   else
1280.     FrameOffs := 2;
1282.   if (gdFixed in AState) and (ACol < 0) then
1283.   begin
1284.     Canvas.Brush.Color := FixedColor;
1285.     Canvas.FillRect(ARect);
1286.   end
1287.   else with Canvas do
1288.   begin
1289.     DrawColumn := Columns[ACol];
1291.     if (not DrawColumn.Visible) then Exit;    //don't draw hidden column
1292.     
1293.     if not (gdFixed in AState) then
1294.     begin
1295.       Font := DrawColumn.Font;
1296.       Brush.Color := DrawColumn.Color;
1297.     end;
1298.     if ARow < 0 then
1299.       DrawTitleCell(ACol, ARow + FTitleOffset, DrawColumn, AState)
1300.     else
1301.     begin
1302.         inc(ARow, FTitleOffset);
1303.       
1304.       Value := self.Cells[ACol, ARow];
1306.       Highlight := HighlightCell(ACol, ARow, Value, AState);
1307.       if Highlight then
1308.       begin
1309.         Brush.Color := clHighlight;
1310.         Font.Color := clHighlightText;
1311.       end;
1312.       if not Enabled then
1313.         Font.Color := clGrayText;
1314.       if FDefaultDrawing then
1315.         WriteText(Canvas, ARect, 2, 2, Value, DrawColumn.Alignment, False);
1317.       if FDefaultDrawing and (gdSelected in AState)
1318.         and ((goDrawFocusSelected in Options) or Focused)
1319.         and not (csDesigning in ComponentState)
1320.         and not (goRowSelect in Options)
1321.         and (UpdateLock = 0)
1322.         and (ValidParentForm(Self).ActiveControl = Self) then
1323.         Windows.DrawFocusRect(Handle, ARect);
1324.     end;
1325.   end;
1326.   if (gdFixed in AState) and ([goVertLine, goHorzLine] * Options =
1327.     [goVertLine, goHorzLine]) then
1328.   begin
1329.     InflateRect(ARect, 1, 1);
1330.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
1331.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
1332.   end;
1333. end;
1335. procedure TTXStringGrid.EditButtonClick;
1336. begin
1337.   if Assigned(FOnEditButtonClick) then
1338.     FOnEditButtonClick(Self)
1339.   else
1340.     ShowPopupEditor(Columns[Col]);
1341. end;
1343. procedure TTXStringGrid.EndLayout;
1344. begin
1345.   if FLayoutLock > 0 then
1346.   begin
1347.     try
1348.       try
1349.         if FLayoutLock = 1 then
1350.           InternalLayout;
1351.       finally
1352.         if FLayoutLock = 1 then
1353.           FColumns.EndUpdate;
1354.       end;
1355.     finally
1356.       Dec(FLayoutLock);
1357.       EndUpdate;
1358.     end;
1359.   end;
1360. end;
1362. procedure TTXStringGrid.EndUpdate;
1363. begin
1364.   if FUpdateLock > 0 then
1365.     Dec(FUpdateLock);
1366. end;
1368. function TTXStringGrid.GetEditStyle(ACol, ARow: Integer): TEditStyle;
1369. var
1370.   Column: TTXColumn;
1371. begin
1372.   TTXStringGridInplaceEdit(InplaceEditor).FUseDataList := False;
1373.   Column := Columns[Col];
1374.   Result := esSimple;
1375.   case Column.ButtonStyle of
1376.    tcbsEllipse:
1377.      Result := esEllipsis;
1378.    tcbsAutoSelect:
1379.      Result := esPickList;
1380.   end;
1381. end;
1383. function TTXStringGrid.HighlightCell(DataCol, DataRow: Integer;
1384.   const Value: string; AState: TGridDrawState): Boolean;
1385. begin
1386.   Result := (gdSelected in AState)
1387.       and ((goDrawFocusSelected in Options) or Focused)
1388.         { updatelock eliminates flicker when tabbing between rows }
1389.       and ((UpdateLock = 0) or (goRowSelect in Options));
1390. end;
1392. { InternalLayout is called with layout locks and column locks in effect }
1393. procedure TTXStringGrid.InternalLayout;
1394.   procedure CheckForPassthroughs;  // check for Columns.State flip-flop
1395.   var
1396.     SeenPassthrough: Boolean;
1397.     I, J: Integer;
1398.     Column: TTXColumn;
1399.   begin
1400.     SeenPassthrough := False;
1401.     for I := 0 to FColumns.Count-1 do
1402.       if not FColumns[I].IsStored then
1403.         SeenPassthrough := True
1404.       else if SeenPassthrough then
1405.       begin  // we have both persistent and non-persistent columns.  Kill the latter
1406.         for J := FColumns.Count-1 downto 0 do
1407.         begin
1408.           Column := FColumns[J];
1409.           if not Column.IsStored then
1410.             Column.Free;
1411.         end;
1412.         Exit;
1413.       end;
1414.   end;
1416.   procedure MeasureTitleHeights;    //get the max height of the title
1417.   var
1418.     I, J, K: Integer;
1419.     RestoreCanvas: Boolean;
1420.     Heights: Integer;
1421.   begin
1422.     Heights := 0;
1423.     RestoreCanvas := not HandleAllocated;
1424.     if RestoreCanvas then
1425.       Canvas.Handle := GetDC(0);
1426.     try
1427.       Canvas.Font := Font;
1428.       K := Canvas.TextHeight('Wg') + 3;
1429.       if goHorzLine in Options then
1430.         Inc(K, GridLineWidth);
1431.       DefaultRowHeight := K;
1432.       if goFixedHorzLine in Options then
1433.       begin
1434.         for I := 0 to FColumns.Count-1 do
1435.         begin
1436.           if FColumns[I].Title <> nil then
1437.               Canvas.Font := FColumns[I].Title.Font
1438.           else
1439.             Canvas.Font := FColumns[I].DefaultFont();
1441.           J := Canvas.TextHeight('Wg') + 4;
1442.           Heights := Max(J, Heights);
1443.         end;
1444.         if Heights = 0 then
1445.         begin
1446.           Canvas.Font := self.Font;
1447.           Heights := Canvas.TextHeight('Wg') + 4;
1448.         end;
1450.         RowHeights[0] := Heights;
1451.       end;
1452.     finally
1453.       if RestoreCanvas then
1454.       begin
1455.         ReleaseDC(0,Canvas.Handle);
1456.         Canvas.Handle := 0;
1457.       end;
1458.     end;
1459.   end;
1461. var
1462.   I: Integer;
1463. begin
1464.   if ([csLoading, csDestroying] * ComponentState) <> [] then Exit;
1466.   if HandleAllocated then KillMessage(Handle, cm_DeferLayout);
1468.   CheckForPassthroughs;
1469.   FVisibleColumns.Clear;
1470.   for I := 0 to FColumns.Count-1 do
1471.     if (FColumns[I].Visible) then
1472.         FVisibleColumns.Add(FColumns[I]);
1473.   ColCount := FColumns.Count;
1475.   FTitleOffset := 0;
1476.   if goFixedHorzLine in Options then
1477.   begin
1478.     FTitleOffset := 1;
1479.   end;
1480.   MeasureTitleHeights;
1481.   SetColumnAttributes;
1482.   Invalidate;
1483. end;
1485. procedure TTXStringGrid.LayoutChanged;
1486. begin
1487.   if AcquireLayoutLock then
1488.     EndLayout;
1489. end;
1491. function TTXStringGrid.AcquireFocus: Boolean;
1492. begin
1493.   Result := True;
1494.   if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
1495.   begin
1496.     SetFocus;
1497.     Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
1498.   end;
1499. end;
1501. procedure TTXStringGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
1502.   X, Y: Integer);
1503. var
1504.   Cell: TGridCoord;
1505. begin
1506.   if not AcquireFocus then Exit;
1507.   if (ssDouble in Shift) and (Button = mbLeft) then
1508.   begin
1509.     DblClick;
1510.     Exit;
1511.   end;
1513.   if Sizing(X, Y) then
1514.   begin
1515.     inherited MouseDown(Button, Shift, X, Y);
1516.     Exit;
1517.   end;
1519.   Cell := MouseCoord(X, Y);
1520.   if (Cell.X < 0) and (Cell.Y < 0) then
1521.   begin
1522.     inherited MouseDown(Button, Shift, X, Y);
1523.     Exit;
1524.   end;
1526.   if (DragKind = dkDock) and
1527.     (Cell.Y < FTitleOffset) and (not (csDesigning in ComponentState)) then
1528.   begin
1529.     BeginDrag(false);
1530.     Exit;
1531.   end;
1533.   if ((csDesigning in self.ComponentState) or (goColSizing in self.Options)) and
1534.     (Cell.Y < FTitleOffset) then
1535.   begin
1536.     inherited MouseDown(Button, Shift, X, Y);
1537.     Exit;
1538.   end;
1540.   inherited MouseDown(Button, Shift, X, Y);
1541. end;
1543. procedure TTXStringGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
1544.   X, Y: Integer);
1545. var
1546.   Cell: TGridCoord;
1547.   SaveState: TGridState;
1548. begin
1549.   SaveState := FGridState;
1550.   inherited MouseUp(Button, Shift, X, Y);
1551.   if (SaveState = gsRowSizing) or (SaveState = gsColSizing) or
1552.     ((InplaceEditor <> nil) and (InplaceEditor.Visible) and
1553.      (PtInRect(InplaceEditor.BoundsRect, Point(X,Y)))) then Exit;
1554.   Cell := MouseCoord(X,Y);
1555.   if (Button = mbLeft) and (Cell.Y >= 0) then
1556.     if Cell.Y < FTitleOffset then
1557.       TitleClick(Columns[Cell.X], Cell.Y)
1558.     else
1559.       CellClick(Columns[Cell.X], Cell.Y);
1560. end;
1562. procedure TTXStringGrid.Notification(AComponent: TComponent;
1563.   Operation: TOperation);
1564. var
1565.   I: Integer;
1566. begin
1567.   inherited Notification(AComponent, Operation);
1568.   if (Operation = opRemove) then
1569.   begin
1570.     if (AComponent is TPopupMenu) then
1571.     begin
1572.       for I := 0 to Columns.Count-1 do
1573.         if Columns[I].PopupMenu = AComponent then
1574.           Columns[I].PopupMenu := nil;
1575.     end ;
1576.   end;
1577. end;
1579. procedure TTXStringGrid.Scroll(Distance: Integer);
1580. var
1581.   OldRect, NewRect: TRect;
1582.   RowHeight: Integer;
1583. begin
1584.   if not HandleAllocated then Exit;
1585.   OldRect := BoxRect(0, Row, ColCount - 1, Row);
1586.   NewRect := BoxRect(0, Row, ColCount - 1, Row);
1587.   ValidateRect(Handle, @OldRect);
1588.   InvalidateRect(Handle, @OldRect, False);
1589.   InvalidateRect(Handle, @NewRect, False);
1590.   if Distance <> 0 then
1591.   begin
1592.     HideEditor;
1593.     try
1594.       if Abs(Distance) > VisibleRowCount then
1595.       begin
1596.         Invalidate;
1597.         Exit;
1598.       end
1599.       else
1600.       begin
1601.         RowHeight := DefaultRowHeight;
1602.         if goHorzLine in Options then Inc(RowHeight, GridLineWidth);
1603.         NewRect := BoxRect(0, FTitleOffset, ColCount - 1, 1000);
1604.         ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
1605.           0, nil, SW_Invalidate);
1606.       end;
1607.     finally
1608.       if goAlwaysShowEditor in Options then ShowEditor;
1609.     end;
1610.   end;
1611.   if UpdateLock = 0 then Update;
1612. end;
1614. procedure TTXStringGrid.SetColumnAttributes;
1615. var
1616.   I: Integer;
1617. begin
1618.   for I := 0 to FColumns.Count-1 do
1619.   with FColumns[I] do
1620.   begin
1621.     TabStops[I] := Visible and not ReadOnly ;
1622.     ColWidths[I] := Width;
1623.   end;
1624. end;
1626. function TTXStringGrid.StoreColumns: Boolean;
1627. begin
1628.   Result := true;
1629. end;
1631. procedure TTXStringGrid.TitleClick(Column: TTXColumn; ARow:integer);
1632. begin
1633.   if Assigned(FOnTitleClick) then FOnTitleClick(Column, ARow);
1634. end;
1636. procedure TTXStringGrid.CMParentFontChanged(var Message: TMessage);
1637. begin
1638.   inherited;
1639.   if ParentFont then
1640.   begin
1641.     FSelfChangingTitleFont := True;
1642.     FSelfChangingTitleFont := False;
1643.     LayoutChanged;
1644.   end;
1645. end;
1647. procedure TTXStringGrid.CMFontChanged(var Message: TMessage);
1648. var
1649.   I: Integer;
1650. begin
1651.   inherited;
1652.   BeginLayout;
1653.   try
1654.     for I := 0 to Columns.Count-1 do
1655.       Columns[I].RefreshDefaultFont;
1656.   finally
1657.     EndLayout;
1658.   end;
1659. end;
1661. procedure TTXStringGrid.CMDeferLayout(var Message);
1662. begin
1663.   if AcquireLayoutLock then
1664.     EndLayout
1665.   else
1666.     DeferLayout;
1667. end;
1669. procedure TTXStringGrid.WMSize(var Message: TWMSize);
1670. begin
1671.   inherited;
1672.   InvalidateTitles;
1673. end;
1675. procedure TTXStringGrid.WMSetFocus(var Message: TWMSetFocus);
1676. begin
1677.   if not ((InplaceEditor <> nil) and
1678.     (Message.FocusedWnd = InplaceEditor.Handle)) then SetIme;
1679.   inherited;
1680. end;
1682. procedure TTXStringGrid.WMKillFocus(var Message: TMessage);
1683. begin
1684.   if not SysLocale.FarEast then inherited
1685.   else
1686.   begin
1687.     ImeName := Screen.DefaultIme;
1688.     ImeMode := imDontCare;
1689.     inherited;
1690.     if not ((InplaceEditor <> nil) and
1691.       (HWND(Message.WParam) = InplaceEditor.Handle)) then
1692.       ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
1693.   end;
1694. end;
1696. { Defer action processing to datalink }
1698. procedure TTXStringGrid.ShowPopupEditor(Column: TTXColumn; X, Y: Integer);
1699. var
1700.   SubGrid: TTXStringGrid;
1701.   I: Integer;
1702.   FloatRect: TRect;
1703.   Cmp: TControl;
1704. begin
1705.   // find existing popup for this column field, if any, and show it
1706.   for I := 0 to ComponentCount-1 do
1707.     if Components[I] is TTXStringGrid then
1708.     begin
1709.       SubGrid := TTXStringGrid(Components[I]);
1710.       begin
1711.         SubGrid.Parent.Show;
1712.         SubGrid.SetFocus;
1713.         Exit;
1714.       end;
1715.     end;
1717.   // create another instance of this kind of grid
1718.   SubGrid := TTXStringGrid(TComponentClass(Self.ClassType).Create(Self));
1719.   try
1720.     SubGrid.Visible := False;
1721.     SubGrid.FloatingDockSiteClass := TCustomDockForm;
1722.     FloatRect.TopLeft := ClientToScreen(CellRect(Col, Row).BottomRight);
1723.     if X > Low(Integer) then FloatRect.Left := X;
1724.     if Y > Low(Integer) then FloatRect.Top := Y;
1725.     FloatRect.Right := FloatRect.Left + Width;
1726.     FloatRect.Bottom := FloatRect.Top + Height;
1727.     SubGrid.ManualFloat(FloatRect);
1728. //    SubGrid.ManualDock(nil,nil,alClient);
1729.     SubGrid.Parent.BiDiMode := Self.BiDiMode; { This carries the BiDi setting }
1730.     I := SubGrid.CellRect(SubGrid.ColCount-1, 0).Right;
1731.     if (I > 0) and (I < Screen.Width div 2) then
1732.       SubGrid.Parent.ClientWidth := I
1733.     else
1734.       SubGrid.Parent.Width := Screen.Width div 4;
1735.     SubGrid.Parent.Height := Screen.Height div 4;
1736.     SubGrid.Align := alClient;
1737.     SubGrid.DragKind := dkDock;
1738.     SubGrid.Color := Color;
1739.     SubGrid.Ctl3D := Ctl3D;
1740.     SubGrid.Cursor := Cursor;
1741.     SubGrid.Enabled := Enabled;
1742.     SubGrid.FixedColor := FixedColor;
1743.     SubGrid.Font := Font;
1744.     SubGrid.HelpContext := HelpContext;
1745.     SubGrid.IMEMode := IMEMode;
1746.     SubGrid.IMEName := IMEName;
1747.     SubGrid.Options := Options;
1748.     Cmp := Self;
1749.     while (Cmp <> nil) and (TTXStringGrid(Cmp).PopupMenu = nil) do
1750.       Cmp := Cmp.Parent;
1751.     if Cmp <> nil then
1752.       SubGrid.PopupMenu := TTXStringGrid(Cmp).PopupMenu;
1753.     SubGrid.Visible := True;
1754.     SubGrid.Parent.Show;
1755.   except
1756.     SubGrid.Free;
1757.     raise;
1758.   end;
1759. end;
1761. procedure TTXStringGrid.InvalidateTitles;
1762. var
1763.   R: TRect;
1764.   DrawInfo: TGridDrawInfo;
1765. begin
1766.   if HandleAllocated then
1767.   begin
1768.     CalcFixedInfo(DrawInfo);
1769.     R := Rect(0, 0, Width, DrawInfo.Vert.FixedBoundary);
1770.     InvalidateRect(Handle, @R, False);
1771.   end;
1772. end;
1774. procedure TTXStringGrid.TopLeftChanged;
1775. begin
1776.   InvalidateTitles;
1777.   inherited TopLeftChanged;
1778. end;
1780. procedure TTXStringGrid.ColWidthsChanged;
1781. var
1782.   I: Integer;
1783. begin
1784.   inherited ColWidthsChanged;
1785.   if FColumns <> nil then
1786.   begin
1787.       if AcquireLayoutLock then
1788.       try
1789.           for I := 0 to ColCount - 1 do
1790.           FColumns[I].Width := ColWidths[I];
1791.         finally
1792.         EndLayout;
1793.         end;
1794.   end;
1795. end;
1797. end.

===================================

非注明转载的文章和blog在未特殊声明情况下一般为本人原创或整理，
原创文章版权本人（lonefox）所有；转载文章版权归原作者所有；

http://blog.youkuaiyun.com/boythl

欢迎转载，但请注明出处，保留作者和版权信息。

===================================