我自写了一个控件,现在出现Tcomobox的Item显示不到列表,但能选值,请帮 ( 积分: 100 )

unit UTFieldListEditor;

interface

uses
SysUtils, Classes, Controls, ValEdit, ExtCtrls, StdCtrls, Graphics, Grids, Types;

type
TFieldListEditor = class(TStringGrid)
private
FTComboBox: TComboBox;
FOnDrawCell: TDrawCellEvent;
protected
procedure KeyPress(var Key: Char); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
end;

TFieldPanel = class(TCustomPanel)
private
FCaptionEditor: TEdit;
FCtl3D: Boolean;
FFieldListEditor: TFieldListEditor;
FFonts: TFont;
FTitleCaptions: TStrings;
function GetCaption: string;
function GetCaptionColor: TColor;
function GetColumnCount: Byte;
function GetRowColor: TColor;
function GetTitleColor: TColor;
function GetTitles: string;
procedure SetCaption(const Value: string);
procedure SetCaptionColor(Value: TColor);
procedure SetColumnCount(Value: Byte);
procedure SetCtl3D(Value: Boolean);
procedure SetFonts(Value: TFont);
procedure SetRowColor(Value: TColor);
procedure SetTitleColor(Value: TColor);
procedure SetTitles(const Value: string);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
procedure RefreshTitle;
published
property Caption: string read GetCaption write SetCaption;
property CaptionColor: TColor read GetCaptionColor write SetCaptionColor;
property ColumnCount: Byte read GetColumnCount write SetColumnCount;
property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property Fonts: TFont read FFonts write SetFonts;
property RowColor: TColor read GetRowColor write SetRowColor;
property TitleColor: TColor read GetTitleColor write SetTitleColor;
property Titles: string read GetTitles write SetTitles;
end;

implementation

{ TFieldPanel }

{
********************************* TFieldPanel **********************************
}
constructor TFieldPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCtl3D := True;
Self.Width := 350;
Self.Height := 330;

FFonts := TFont.Create;

FTitleCaptions := TStringList.Create;
FTitleCaptions.CommaText := '第一列 第二列 第三列 第四列';

FCaptionEditor := TEdit.Create(AOwner);
FCaptionEditor.Parent := Self;
FCaptionEditor.Align := alTop;
FCaptionEditor.Text := 'TableCaption';

FFieldListEditor := TFieldListEditor.Create(AOwner);
FFieldListEditor.Parent := Self;
FFieldListEditor.Align := alClient;
FFieldListEditor.ColCount := 4;
FFieldListEditor.DefaultRowHeight := 18;
RefreshTitle;
end;

destructor TFieldPanel.Destroy;
begin
FFonts.Free;
FTitleCaptions.Free;
FCaptionEditor.Free;
FFieldListEditor.Free;
inherited Destroy;
end;

function TFieldPanel.GetCaption: string;
begin
Result := FCaptionEditor.Text;
end;

function TFieldPanel.GetCaptionColor: TColor;
begin
Result := FCaptionEditor.Color;
end;

function TFieldPanel.GetColumnCount: Byte;
begin
Result := FFieldListEditor.ColCount;
end;

function TFieldPanel.GetRowColor: TColor;
begin
Result := FFieldListEditor.Color;
end;

function TFieldPanel.GetTitleColor: TColor;
begin
Result := FFieldListEditor.FixedColor;
end;

function TFieldPanel.GetTitles: string;
begin
Result := FTitleCaptions.DelimitedText;
end;

procedure TFieldPanel.RefreshTitle;
var
i, MaxColumn, MinColumn: Integer;
begin
MaxColumn := FTitleCaptions.Count;
FFieldListEditor.ColCount := MaxColumn;
FFieldListEditor.Rows[0].Clear;
for i := 0 to MaxColumn - 1 do
begin
FFieldListEditor.Cells[i, 0] := FTitleCaptions.Strings;
end;
end;

procedure TFieldPanel.SetCaption(const Value: string);
begin
FCaptionEditor.Text := Value;
end;

procedure TFieldPanel.SetCaptionColor(Value: TColor);
begin
FCaptionEditor.Color := Value;
end;

procedure TFieldPanel.SetColumnCount(Value: Byte);
begin
if FFieldListEditor.ColCount <> Value then
begin
FFieldListEditor.ColCount := Value;
end;
end;

procedure TFieldPanel.SetCtl3D(Value: Boolean);
begin
if FCtl3D <> Value then
begin
FCtl3D := Value;
FFieldListEditor.Ctl3D := Value;
FCaptionEditor.Ctl3D := Value;
Perform(CM_CTL3DCHANGED, 0, 0);
end;
end;

procedure TFieldPanel.SetFonts(Value: TFont);
begin
FFonts := Value;
FFieldListEditor.Font := Value;
FCaptionEditor.Font := Value;
end;

procedure TFieldPanel.SetRowColor(Value: TColor);
begin
FFieldListEditor.Color := Value;
end;

procedure TFieldPanel.SetTitleColor(Value: TColor);
begin
FFieldListEditor.FixedColor := Value;
end;

procedure TFieldPanel.SetTitles(const Value: string);
begin
FTitleCaptions.DelimitedText := Value;
RefreshTitle;
end;

{ TFieldListEditor }

{
******************************* TFieldListEditor *******************************
}
constructor TFieldListEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FixedCols := 0;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs];

FTComboBox := TComboBox.Create(AOwner);
end;

destructor TFieldListEditor.Destroy;
begin
FTComboBox.Free;
end;

procedure TFieldListEditor.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
begin
if ACol=2 And ARow>0 then
begin
FTComboBox.Top := Top + DefaultRowHeight * ARow + 5;
FTComboBox.Left := Left+2;
FTComboBox.Width := DefaultColWidth - 1;
FTComboBox.Parent := Self;
Self.InsertControl(FTComboBox);
FTComboBox.Items.Add('eeeee');
FTComboBox.Items.Add('uuuuu');
FTComboBox.Items.Add('ppppp');
FTComboBox.Items.Add('ccccc');
end;
end;

procedure TFieldListEditor.KeyPress(var Key: Char);
begin
if Key = #13 then
begin
if Col < ColCount - 1 then
Col := Col + 1
else
begin
if Row < RowCount - 1 then
begin
Row := Row + 1;
Col := 0;
end
else
begin
RowCount := RowCount + 1;
Row := RowCount - 1;
Col := 0;
end;
end;
end;
inherited KeyPress(Key);
end;

end.

unit UTFieldListEditor;

interface

uses
SysUtils, Classes, Controls, ValEdit, ExtCtrls, StdCtrls, Graphics, Grids, Types;

type
TFieldListEditor = class(TStringGrid)
private
FTComboBox: TComboBox;
FOnDrawCell: TDrawCellEvent;
protected
procedure KeyPress(var Key: Char); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
end;

TFieldPanel = class(TCustomPanel)
private
FCaptionEditor: TEdit;
FCtl3D: Boolean;
FFieldListEditor: TFieldListEditor;
FFonts: TFont;
FTitleCaptions: TStrings;
function GetCaption: string;
function GetCaptionColor: TColor;
function GetColumnCount: Byte;
function GetRowColor: TColor;
function GetTitleColor: TColor;
function GetTitles: string;
procedure SetCaption(const Value: string);
procedure SetCaptionColor(Value: TColor);
procedure SetColumnCount(Value: Byte);
procedure SetCtl3D(Value: Boolean);
procedure SetFonts(Value: TFont);
procedure SetRowColor(Value: TColor);
procedure SetTitleColor(Value: TColor);
procedure SetTitles(const Value: string);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
procedure RefreshTitle;
published
property Caption: string read GetCaption write SetCaption;
property CaptionColor: TColor read GetCaptionColor write SetCaptionColor;
property ColumnCount: Byte read GetColumnCount write SetColumnCount;
property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property Fonts: TFont read FFonts write SetFonts;
property RowColor: TColor read GetRowColor write SetRowColor;
property TitleColor: TColor read GetTitleColor write SetTitleColor;
property Titles: string read GetTitles write SetTitles;
end;

implementation

{ TFieldPanel }

{
********************************* TFieldPanel **********************************
}
constructor TFieldPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCtl3D := True;
Self.Width := 350;
Self.Height := 330;

FFonts := TFont.Create;

FTitleCaptions := TStringList.Create;
FTitleCaptions.CommaText := '第一列 第二列 第三列 第四列';

FCaptionEditor := TEdit.Create(AOwner);
FCaptionEditor.Parent := Self;
FCaptionEditor.Align := alTop;
FCaptionEditor.Text := 'TableCaption';

FFieldListEditor := TFieldListEditor.Create(AOwner);
FFieldListEditor.Parent := Self;
FFieldListEditor.Align := alClient;
FFieldListEditor.ColCount := 4;
FFieldListEditor.DefaultRowHeight := 18;
RefreshTitle;
end;

destructor TFieldPanel.Destroy;
begin
FFonts.Free;
FTitleCaptions.Free;
FCaptionEditor.Free;
FFieldListEditor.Free;
inherited Destroy;
end;

function TFieldPanel.GetCaption: string;
begin
Result := FCaptionEditor.Text;
end;

function TFieldPanel.GetCaptionColor: TColor;
begin
Result := FCaptionEditor.Color;
end;

function TFieldPanel.GetColumnCount: Byte;
begin
Result := FFieldListEditor.ColCount;
end;

function TFieldPanel.GetRowColor: TColor;
begin
Result := FFieldListEditor.Color;
end;

function TFieldPanel.GetTitleColor: TColor;
begin
Result := FFieldListEditor.FixedColor;
end;

function TFieldPanel.GetTitles: string;
begin
Result := FTitleCaptions.DelimitedText;
end;

procedure TFieldPanel.RefreshTitle;
var
i, MaxColumn, MinColumn: Integer;
begin
MaxColumn := FTitleCaptions.Count;
FFieldListEditor.ColCount := MaxColumn;
FFieldListEditor.Rows[0].Clear;
for i := 0 to MaxColumn - 1 do
begin
FFieldListEditor.Cells[i, 0] := FTitleCaptions.Strings;
end;
end;

procedure TFieldPanel.SetCaption(const Value: string);
begin
FCaptionEditor.Text := Value;
end;

procedure TFieldPanel.SetCaptionColor(Value: TColor);
begin
FCaptionEditor.Color := Value;
end;

procedure TFieldPanel.SetColumnCount(Value: Byte);
begin
if FFieldListEditor.ColCount <> Value then
begin
FFieldListEditor.ColCount := Value;
end;
end;

procedure TFieldPanel.SetCtl3D(Value: Boolean);
begin
if FCtl3D <> Value then
begin
FCtl3D := Value;
FFieldListEditor.Ctl3D := Value;
FCaptionEditor.Ctl3D := Value;
Perform(CM_CTL3DCHANGED, 0, 0);
end;
end;

procedure TFieldPanel.SetFonts(Value: TFont);
begin
FFonts := Value;
FFieldListEditor.Font := Value;
FCaptionEditor.Font := Value;
end;

procedure TFieldPanel.SetRowColor(Value: TColor);
begin
FFieldListEditor.Color := Value;
end;

procedure TFieldPanel.SetTitleColor(Value: TColor);
begin
FFieldListEditor.FixedColor := Value;
end;

procedure TFieldPanel.SetTitles(const Value: string);
begin
FTitleCaptions.DelimitedText := Value;
RefreshTitle;
end;

{ TFieldListEditor }

{
******************************* TFieldListEditor *******************************
}
constructor TFieldListEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FixedCols := 0;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs];

FTComboBox := TComboBox.Create(AOwner);
end;

destructor TFieldListEditor.Destroy;
begin
FTComboBox.Free;
end;

procedure TFieldListEditor.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
begin
if ACol=2 And ARow>0 then
begin
FTComboBox.Top := Top + DefaultRowHeight * ARow + 5;
FTComboBox.Left := Left+2;
FTComboBox.Width := DefaultColWidth - 1;
FTComboBox.Parent := Self;
Self.InsertControl(FTComboBox);
FTComboBox.Items.Add('eeeee');
FTComboBox.Items.Add('uuuuu');
FTComboBox.Items.Add('ppppp');
FTComboBox.Items.Add('ccccc');
end;
end;

procedure TFieldListEditor.KeyPress(var Key: Char);
begin
if Key = #13 then
begin
if Col < ColCount - 1 then
Col := Col + 1
else
begin
if Row < RowCount - 1 then
begin
Row := Row + 1;
Col := 0;
end
else
begin
RowCount := RowCount + 1;
Row := RowCount - 1;
Col := 0;
end;
end;
end;
inherited KeyPress(Key);
end;

end.

改进stringgrid的控件有很多，可供参考
现在没时间搞，你到http://bbs.eston.com.cn 去发个贴吧，有空大家一起研究研究。

TComboBox在TFieldListEditor里的作用不明，没能指定它的parent值，显示不出来。没必要的话可以放在TFieldPanel类中；

DrawCell段写错了
if ACol=2 And ARow>0 then
begin
FTComboBox.Top := Top + DefaultRowHeight * ARow + 5;
FTComboBox.Left := Left+2;
FTComboBox.Width := DefaultColWidth - 1;
FTComboBox.Parent := Self;
Self.InsertControl(FTComboBox);
FTComboBox.Items.Add('eeeee');
FTComboBox.Items.Add('uuuuu');
FTComboBox.Items.Add('ppppp');
FTComboBox.Items.Add('ccccc');
end;
列表不能显示
但只在TStringGrid中就能实现

不必一定要在TStringGrid中实现。
将TComboBox在TStringGrid中生成相当不灵活，将TComboBox的Parent设为TStringGrid会使选择TComboBox时焦点返回到TStringGrid，从而是使TComboBox的列表显示不能。
我建议将TComboBox移到TPanel上，由Event来实现功能。

constructor TFieldPanel.Create(AOwner: TComponent);
begin
......
FFieldListEditor := TFieldListEditor.Create(AOwner);
FFieldListEditor.Parent := Self;
...
[red] FFieldListEditor.OnDrawEvent := ListEditorDrawEvent;

FComboBox := TComboBox.Create(AOwner);
TComboBox.Parent := Self;[/red]
........
end;
像这样的方式实现。

AdvStringGrid不错

本来不想费这个劲看你的源码，我还是推荐你用AdvStringGrid,改动了一下，基本功能有了，要想完善，还有很多。

unit UTFieldListEditor;

interface

uses
SysUtils, Classes, Controls, ValEdit, ExtCtrls, StdCtrls, Graphics, Grids, Types;

type
TFieldListEditor = class(TStringGrid)
private
FTComboBox: TComboBox;
protected
procedure KeyPress(var Key: Char); override;
procedure SelectCell(Sender:TObject;Acol,Arow:integer;var CanSelect:boolean);
procedure CloseUp(Sender:TObject);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
end;

TFieldPanel = class(TCustomPanel)
private
FCaptionEditor: TEdit;
FCtl3D: Boolean;
FFieldListEditor: TFieldListEditor;
FFonts: TFont;
FTitleCaptions: TStrings;
function GetCaption: string;
function GetCaptionColor: TColor;
function GetColumnCount: Byte;
function GetRowColor: TColor;
function GetTitleColor: TColor;
function GetTitles: string;
procedure SetCaption(const Value: string);
procedure SetCaptionColor(Value: TColor);
procedure SetColumnCount(Value: Byte);
procedure SetCtl3D(Value: Boolean);
procedure SetFonts(Value: TFont);
procedure SetRowColor(Value: TColor);
procedure SetTitleColor(Value: TColor);
procedure SetTitles(const Value: string);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
procedure RefreshTitle;
published
property Caption: string read GetCaption write SetCaption;
property CaptionColor: TColor read GetCaptionColor write SetCaptionColor;
property ColumnCount: Byte read GetColumnCount write SetColumnCount;
property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property Fonts: TFont read FFonts write SetFonts;
property RowColor: TColor read GetRowColor write SetRowColor;
property TitleColor: TColor read GetTitleColor write SetTitleColor;
property Titles: string read GetTitles write SetTitles;
end;

implementation

{ TFieldPanel }

{
********************************* TFieldPanel **********************************
}
constructor TFieldPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCtl3D := True;
Self.Width := 350;
Self.Height := 330;

FFonts := TFont.Create;

FTitleCaptions := TStringList.Create;
FTitleCaptions.CommaText := '第一列 第二列 第三列 第四列';

FCaptionEditor := TEdit.Create(AOwner);
FCaptionEditor.Parent := Self;
FCaptionEditor.Align := alTop;
FCaptionEditor.Text := 'TableCaption';

FFieldListEditor := TFieldListEditor.Create(AOwner);
FFieldListEditor.Parent := Self;
FFieldListEditor.Align := alClient;
FFieldListEditor.ColCount := 4;
FFieldListEditor.DefaultRowHeight := 18;
RefreshTitle;
end;

destructor TFieldPanel.Destroy;
begin
FFonts.Free;
FTitleCaptions.Free;
FCaptionEditor.Free;
FFieldListEditor.Free;
inherited Destroy;
end;

function TFieldPanel.GetCaption: string;
begin
Result := FCaptionEditor.Text;
end;

function TFieldPanel.GetCaptionColor: TColor;
begin
Result := FCaptionEditor.Color;
end;

function TFieldPanel.GetColumnCount: Byte;
begin
Result := FFieldListEditor.ColCount;
end;

function TFieldPanel.GetRowColor: TColor;
begin
Result := FFieldListEditor.Color;
end;

function TFieldPanel.GetTitleColor: TColor;
begin
Result := FFieldListEditor.FixedColor;
end;

function TFieldPanel.GetTitles: string;
begin
Result := FTitleCaptions.DelimitedText;
end;

procedure TFieldPanel.RefreshTitle;
var
i, MaxColumn, MinColumn: Integer;
begin
MaxColumn := FTitleCaptions.Count;
FFieldListEditor.ColCount := MaxColumn;
FFieldListEditor.Rows[0].Clear;
for i := 0 to MaxColumn - 1 do
begin
FFieldListEditor.Cells[i, 0] := FTitleCaptions.Strings;
end;
end;

procedure TFieldPanel.SetCaption(const Value: string);
begin
FCaptionEditor.Text := Value;
end;

procedure TFieldPanel.SetCaptionColor(Value: TColor);
begin
FCaptionEditor.Color := Value;
end;

procedure TFieldPanel.SetColumnCount(Value: Byte);
begin
if FFieldListEditor.ColCount <> Value then
begin
FFieldListEditor.ColCount := Value;
end;
end;

procedure TFieldPanel.SetCtl3D(Value: Boolean);
begin
if FCtl3D <> Value then
begin
FCtl3D := Value;
FFieldListEditor.Ctl3D := Value;
FCaptionEditor.Ctl3D := Value;
Perform(CM_CTL3DCHANGED, 0, 0);
end;
end;

procedure TFieldPanel.SetFonts(Value: TFont);
begin
FFonts := Value;
FFieldListEditor.Font := Value;
FCaptionEditor.Font := Value;
end;

procedure TFieldPanel.SetRowColor(Value: TColor);
begin
FFieldListEditor.Color := Value;
end;

procedure TFieldPanel.SetTitleColor(Value: TColor);
begin
FFieldListEditor.FixedColor := Value;
end;

procedure TFieldPanel.SetTitles(const Value: string);
begin
FTitleCaptions.DelimitedText := Value;
RefreshTitle;
end;

{ TFieldListEditor }

{
******************************* TFieldListEditor *******************************
}
constructor TFieldListEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FixedCols := 0;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs];

RowCount:=10;
FTComboBox := TComboBox.Create(AOwner);
FTComboBox.Parent:=twincontrol(AOwner);
FTComboBox.Visible:=false;
FTComboBox.Style:=csOwnerDrawVariable;
FTComboBox.Items.Add('eeeee');
FTComboBox.Items.Add('uuuuu');
FTComboBox.Items.Add('ppppp');
FTComboBox.Items.Add('ccccc');
OnSelectCell:=SelectCell;
FTComboBox.OnCloseUp:=CloseUp;
end;

destructor TFieldListEditor.Destroy;
begin
FTComboBox.Free;
end;

procedure TFieldListEditor.SelectCell(Sender:Tobject;Acol,Arow:integer;var CanSelect:boolean);
var l,t,w,h,index:integer;
begin
l:=Left+self.CellRect(acol,arow).Left+2;
t:=Top+self.CellRect(acol,arow).top+3;
w:=CellRect(acol,arow).Right-CellRect(acol,arow).Left;
h:=CellRect(acol,arow).Bottom-CellRect(acol,arow).Top-5;
FTComboBox.Left:=l;
FTComboBox.Top:=t;
FTComboBox.Width:=w;
FTComboBox.ItemHeight:=h;
index:=FTComboBox.Items.IndexOf(Cells[Acol,Arow]);
if index>-1 then
FTComboBox.ItemIndex:=index
else
FTComboBox.ItemIndex:=-1;
FTComboBox.Visible:=true;
FTComboBox.BringToFront;
end;

procedure TFieldListEditor.CloseUp(Sender:TObject);
begin
Cells[Col,Row]:=FTComboBox.Items.Strings[FTComboBox.ItemIndex];
FTComboBox.Visible:=false;
end;



procedure TFieldListEditor.KeyPress(var Key: Char);
begin
if Key = #13 then
begin
if Col < ColCount - 1 then
Col := Col + 1
else
begin
if Row < RowCount - 1 then
begin
Row := Row + 1;
Col := 0;
end
else
begin
RowCount := RowCount + 1;
Row := RowCount - 1;
Col := 0;
end;
end;
end;
inherited KeyPress(Key);
end;

end.

我只是临时测试用的,
正式的是在SelectCell中的

To Ymjy
我也逼不得意的
只是半桶水
以后还向你多请教
谢

unit UTFieldListEditor;

interface

uses
SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, Grids, Types, Messages, windows;

type
TFieldListEditor = class (TStringGrid)
private
FComboBoxLocation: TPoint;
FTComboBox: TComboBox;
procedure CloseUp(Sender: TObject);
procedure DoSelectCell(Sender: TObject; ACol, ARow: Longint; var CanSelect:
Boolean);
function GetComboboxItems: TStrings;
function GetTitles: TStrings;
procedure SetComboboxItems(Value: TStrings);
procedure SetComboBoxLocation(Value: TPoint);
procedure SetTitles(Value: TStrings);
protected
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
published
property ComboboxItems: TStrings read GetComboboxItems write
SetComboboxItems;
property ComboBoxLocation: TPoint read FComboBoxLocation write
SetComboBoxLocation;
property Titles: TStrings read GetTitles write SetTitles;
end;

TFieldPanel = class (TCustomPanel)
private
FCaptionEditor: TEdit;
FCtl3D: Boolean;
FFieldListEditor: TFieldListEditor;
FFonts: TFont;
FTitleCaptions: TStrings;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetCaption: string;
function GetCaptionColor: TColor;
function GetColumnCount: Byte;
function GetComboBoxsLocation: TPoint;
function GetFieldType: TStrings;
function GetRowColor: TColor;
function GetTitleColor: TColor;
function GetTitles: TStrings;
procedure MoveControl(Shift: TShiftState; X, Y: Integer);
procedure SetCaption(const Value: string);
procedure SetCaptionColor(Value: TColor);
procedure SetColumnCount(Value: Byte);
procedure SetComboBoxsLocation(Value: TPoint);
procedure SetCtl3D(Value: Boolean);
procedure SetFieldType(Value: TStrings);
procedure SetFonts(Value: TFont);
procedure SetRowColor(Value: TColor);
procedure SetTitleColor(Value: TColor);
procedure SetTitles(Value: TStrings);
protected
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
property ComboBoxsLocation: TPoint read GetComboBoxsLocation write
SetComboBoxsLocation;
property FieldListEditor: TFieldListEditor read FFieldListEditor;
published
property Align;
property Anchors;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderStyle;
property BorderWidth;
property Caption: string read GetCaption write SetCaption;
property CaptionColor: TColor read GetCaptionColor write SetCaptionColor;
property Color;
property ColumnCount: Byte read GetColumnCount write SetColumnCount;
property Constraints;
property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property FieldType: TStrings read GetFieldType write SetFieldType;
property Fonts: TFont read FFonts write SetFonts;
property Locked;
property RowColor: TColor read GetRowColor write SetRowColor;
property TitleColor: TColor read GetTitleColor write SetTitleColor;
property Titles: TStrings read GetTitles write SetTitles;
end;

implementation

{ TFieldPanel }

{
********************************* TFieldPanel **********************************
}
constructor TFieldPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCtl3D := True;
Self.Width := 350;
Self.Height := 330;

FFonts := TFont.Create;

FCaptionEditor := TEdit.Create(AOwner);
FCaptionEditor.Parent := Self;
FCaptionEditor.Align := alTop;
FCaptionEditor.Text := 'TableCaption';
FCaptionEditor.OnMouseMove := Self.DoMouseMove;

FFieldListEditor := TFieldListEditor.Create(AOwner);
FFieldListEditor.Parent := Self;
FFieldListEditor.Align := alClient;
FFieldListEditor.ColCount := 4;
FFieldListEditor.DefaultRowHeight := 18;
FFieldListEditor.Titles.CommaText := '第一列 第二列 第三列 第四列';
//FFieldListEditor.OnMouseMove := Self.DoMouseMove;


end;

destructor TFieldPanel.Destroy;
begin
FFonts.Free;
FTitleCaptions.Free;
FCaptionEditor.Free;
FFieldListEditor.Free;
inherited Destroy;
end;

procedure TFieldPanel.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
if Not Locked then Self.MoveControl(Shift, X, Y);
end;

function TFieldPanel.GetCaption: string;
begin
Result := FCaptionEditor.Text;
end;

function TFieldPanel.GetCaptionColor: TColor;
begin
Result := FCaptionEditor.Color;
end;

function TFieldPanel.GetColumnCount: Byte;
begin
Result := FFieldListEditor.ColCount;
end;

function TFieldPanel.GetComboBoxsLocation: TPoint;
begin
Result := FFieldListEditor.ComboBoxLocation;
end;

function TFieldPanel.GetFieldType: TStrings;
begin
Result := FFieldListEditor.ComboboxItems;
end;

function TFieldPanel.GetRowColor: TColor;
begin
Result := FFieldListEditor.Color;
end;

function TFieldPanel.GetTitleColor: TColor;
begin
Result := FFieldListEditor.FixedColor;
end;

function TFieldPanel.GetTitles: TStrings;
begin
Result := FFieldListEditor.Titles;
end;

procedure TFieldPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if Not Locked then Self.MoveControl(Shift, X, Y);
end;

procedure TFieldPanel.MoveControl(Shift: TShiftState; X, Y: Integer);

const
Precision = 5;
var
SC_MANIPULATE: Word;

begin
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最左侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (X <= Precision) and (Y > Precision) and (Y < Self.Height - Precision) then
begin
SC_MANIPULATE := $F001;
Self.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最右侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X >= Self.Width - Precision) and (Y > Precision) and (Y < Self.Height - Precision)
then
begin
SC_MANIPULATE := $F002;
Self.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最上侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X > Precision) and (X < Self.Width - Precision) and (Y <= Precision)
then
begin
SC_MANIPULATE := $F003;
Self.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X <= Precision) and (Y <= Precision)
then
begin
SC_MANIPULATE := $F004;
Self.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X >= Self.Width - Precision) and (Y <= Precision)
then
begin
SC_MANIPULATE := $F005;
Self.Cursor := crSizeNESW;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最下侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X > Precision) and (X < Self.Width - Precision) and (Y >= Self.Height - Precision)
then
begin
SC_MANIPULATE := $F006;
Self.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X <= Precision) and (Y >= Self.Height - Precision)
then
begin
SC_MANIPULATE := $F007;
Self.Cursor := crSizeNESW;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X >= Self.Width - Precision) and (Y >= Self.Height - Precision)
then
begin
SC_MANIPULATE := $F008;
Self.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的客户区（移动整个控件）******************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X > 5) and (Y > 5) and (X < Self.Width - 5) and (Y < Self.Height - 5)
then
begin
SC_MANIPULATE := $F009;
Self.Cursor := crSizeAll;
end
else
begin
SC_MANIPULATE := $F000;
Self.Cursor := crDefault;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if Shift = [ssLeft] then
begin
ReleaseCapture;
Self.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
end;

procedure TFieldPanel.SetCaption(const Value: string);
begin
FCaptionEditor.Text := Value;
end;

procedure TFieldPanel.SetCaptionColor(Value: TColor);
begin
FCaptionEditor.Color := Value;
end;

procedure TFieldPanel.SetColumnCount(Value: Byte);
begin
FFieldListEditor.ColCount := Value;
end;

procedure TFieldPanel.SetComboBoxsLocation(Value: TPoint);
begin
FFieldListEditor.ComboBoxLocation := Value;
end;

procedure TFieldPanel.SetCtl3D(Value: Boolean);
begin
if FCtl3D <> Value then
begin
FCtl3D := Value;
FFieldListEditor.Ctl3D := Value;
FCaptionEditor.Ctl3D := Value;
Perform(CM_CTL3DCHANGED, 0, 0);
end;
end;

procedure TFieldPanel.SetFieldType(Value: TStrings);
begin
FFieldListEditor.ComboboxItems.Assign(Value);
end;

procedure TFieldPanel.SetFonts(Value: TFont);
begin
FFonts := Value;
FFieldListEditor.Font := Value;
FCaptionEditor.Font := Value;
end;

procedure TFieldPanel.SetRowColor(Value: TColor);
begin
FFieldListEditor.Color := Value;
end;

procedure TFieldPanel.SetTitleColor(Value: TColor);
begin
FFieldListEditor.FixedColor := Value;
end;

procedure TFieldPanel.SetTitles(Value: TStrings);
begin
FFieldListEditor.Titles.Assign(Value);
end;

{ TFieldListEditor }

{
******************************* TFieldListEditor *******************************
}
constructor TFieldListEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FixedCols := 0;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs];

FComboBoxLocation.X := 2;
FComboBoxLocation.Y := 1;
[red] /////////////////////////////////////////////////改成这样
FTComboBox := TComboBox.Create(AOwner);
FTComboBox.Ctl3D := False;
FTComboBox.Visible := False;

OnSelectCell := Self.DoSelectCell;
FTComboBox.OnCloseUp := Self.CloseUp;
/////////////////////////////////////////////////改成这样[/red]
end;

destructor TFieldListEditor.Destroy;
begin
FTComboBox.Free;
end;

procedure TFieldListEditor.CloseUp(Sender: TObject);
begin
Cells[Col, Row] := FTComboBox.Items.Strings[FTComboBox.ItemIndex];
FTComboBox.Visible := False;
end;

procedure TFieldListEditor.DoSelectCell(Sender: TObject; ACol, ARow: Longint;
var CanSelect: Boolean);
var
index: Integer;
begin
[red][blue]/////////////////////////////////////////////////改成这样

if (ACol = FComboBoxLocation.X) and (ARow >= FComboBoxLocation.Y) and (CanSelect) then
begin
FTComboBox.Parent:=Self.Parent;
FTComboBox.Left :=Self.Left + Self.CellRect(ACol,ARow).Left+Self.GridLineWidth;
FTComboBox.Top :=Self.Top+ Self.CellRect(ACol,ARow).Top+Self.GridLineWidth;
FTComboBox.Width := Self.CellRect(ACol,ARow).Right -Self.CellRect(ACol,ARow).Left;
FTComboBox.ItemHeight := Self.CellRect(ACol,ARow).Bottom -Self.CellRect(ACol,ARow).Top -5;

index := FTComboBox.Items.IndexOf(Cells[ACol, ARow]);
if index > -1 then
FTComboBox.ItemIndex := index
else
FTComboBox.ItemIndex := -1;
FTComboBox.Visible := True;
FTComboBox.BringToFront;
end;
/////////////////////////////////////////////////改成这样[/blue][/red]

end;

function TFieldListEditor.GetComboboxItems: TStrings;
begin
Result := FTComboBox.Items;
end;

function TFieldListEditor.GetTitles: TStrings;
begin
Result := Self.Rows[0];
end;

procedure TFieldListEditor.KeyPress(var Key: Char);
begin
if Key = #13 then
begin
if Col < ColCount - 1 then
Col := Col + 1
else
begin
if Row < RowCount - 1 then
begin
Row := Row + 1;
Col := 0;
end
else
begin
RowCount := RowCount + 1;
Row := RowCount - 1;
Col := 0;
end;
end;
end;
inherited KeyPress(Key);
end;

procedure TFieldListEditor.SetComboboxItems(Value: TStrings);
begin
FTComboBox.Items.Assign(Value);
end;

procedure TFieldListEditor.SetComboBoxLocation(Value: TPoint);
begin
if Value.X > Self.ColCount then
FComboBoxLocation.X := ColCount - 1
else
FComboBoxLocation.X := Value.X;
if Value.Y > RowCount then
FComboBoxLocation.Y := RowCount - 1
else
FComboBoxLocation.Y := Value.Y;
end;

procedure TFieldListEditor.SetTitles(Value: TStrings);
begin
Self.Rows[0].Assign(Value);
end;

end.

但又有一点问题,注册控件后不能在TForm中生成