在控件中事件为何不响应?(100分)

  • 主题发起人 主题发起人 旱秧田
  • 开始时间 开始时间

旱秧田

Unregistered / Unconfirmed
GUEST, unregistred user!
自已做了了个控件,将数个控件集中在一起,代码如下:
unit TjPanel;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,StdCtrls,ComCtrls,Grids;

const
WM_ButtonClick = WM_App+1;

type
TDownButton = class(TButton)
public
LinkCol:Integer;
LinkRow:Integer;
constructor Create(AOwner: TComponent); override;
procedure ButtonClick(Sender:TObject);
end;
TDownButtons = array of array of TDownButton;

TTjPanel = class(TPanel)
ZbLabel : TLabel;
lbJcrq: TLabel;
dtJcrq: TDateTimePicker;
lbDoctor : TLabel;
edDoctor : TEdit;
lbXj : TLabel;
edXj : TEdit;
InputGrid:TStringGrid;
SelectList:TListBox;
private
FZbCode : integer;
FZbCaption:String;
FRowCount:Integer;
FSelectCol,FSelectRow:Integer;
FSelectStrings:TStringList;
FedDoctorExit:TNotifyEvent;
FInputGridDrawCell:TDrawCellEvent;
Function GetDownButtonVisible(ACol,ARow:Integer):Boolean;
procedure SetDownButtonVisible(ACol,ARow:Integer;Status:boolean);
procedure SetSelectStrings(Value:TStringList);
public
ItemCodeList:array of array of Integer;
ResultList:array of array of String;
DownButtons:TDownButtons;
constructor Create(AOwner: TComponent); override;
procedure CreateDownButton;
procedure InputGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure InputGridResize(Sender:TObject);
procedure SetZbCaption(ZbCaption:String);
procedure DownButtonClick(var Msg:TMessage);Message WM_ButtonClick;
procedure MyButtonClick(Sender:TObject);
procedure edDoctorExit(Sender:TObject);
procedure SelectListExit(Sender:TObject);
procedure SelectListClick(Sender:TObject);
procedure RemerberResult;
procedure SetRowCount(NewCount:Integer);
property DownButtonVisible[ACol,ARow:Integer]:boolean read GetDownButtonVisible write SetDownButtonVisible;
published
property ZbCode:Integer read FZbCode write FZbCode;
property ZbCaption:String read FZbCaption write SetZbCaption;
property RowCount:Integer read FRowCount write SetRowCount;
property SelectStrings:TStringList read FSelectStrings write SetSelectStrings;
property OnedDoctorExit:TNotifyEvent read FedDoctorExit write FedDoctorExit;
property OnInputGridDrawCell:TDrawCellEvent read FInputGridDrawCell write FInputGridDrawCell;
end;
procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples',[TTjPanel]);
end;

constructor TDownButton.Create(AOwner: TComponent);
begin
inherited ;
Caption := '▼';
Width := 18;
Font.Size := 9;
OnClick := ButtonClick;{此处指定OnClick过程}
end;

procedure TDownButton.ButtonClick(Sender:TObject);
begin
showmessage('2');{这个过程根本没进入}
SendMessage(TWinControl(TDownButton(Sender).Owner).Handle,WM_ButtonClick,LinkCol,LinkRow);
end;

procedure TTjPanel.CreateDownButton;
var
i,j:Integer;
begin
for i := 0 to Length(DownButtons)-1 do
for j := 0 to Length(DownButtons)-1 do
DownButtons[i,j].Free;
with InputGrid do
begin
SetLength(DownButtons,2);
SetLength(DownButtons[0],RowCount-1);
SetLength(DownButtons[1],RowCount-1);
for i := 0 to RowCount-2 do
begin
DownButtons[0,i] := TDownButton.Create(Self);
DownButtons[0,i].Parent := InputGrid;{???此处如果InputGrid改为Self,则OnClick事件能得到响应,
但是这样,当网格滚动时,小按钮会显示不正常}
DownButtons[0,i].Left := -100;
DownButtons[0,i].Top := -100;
DownButtons[1,i] := TDownButton.Create(Self);
DownButtons[1,i].Parent := InputGrid;
DownButtons[1,i].Left := -100;
DownButtons[1,i].Top := -100;
end;
end;
end;

constructor TTjPanel.Create(AOwner: TComponent);
var
tmpTop : Integer;
i,j : Integer;
begin
inherited Create(AOwner);
ZbLabel := TLabel.Create(Application);
with ZbLabel do
begin
Parent := Self;
Left := 10;
Top := 10;
Font.Name := '宋体';
Font.Size := 20;
tmpTop := Top+(Height div 2)-5;
end;
lbJcrq := TLabel.Create(Application);
with lbJcrq do
begin
Parent := Self;
Caption := '检查日期';
Left := ZbLabel.Left+ZbLabel.Width+40;
Top := tmpTop-(Height div 2);
end;
dtJcrq := TDateTimePicker.Create(Self);
with dtJcrq do
begin
Parent := Self;
Date := Date;
Left := lbJcrq.Left+lbJcrq.Width+20;
Top := tmpTop-(Height div 2);
end;
lbDoctor := TLabel.Create(Self);
with lbDoctor do
begin
Parent := Self;
lbDoctor.Caption := '医生';
Left := dtJcrq.Left+dtJcrq.Width+40;
Top := tmpTop-(Height div 2);
end;
edDoctor := TEdit.Create(Application);
with edDoctor do
begin
Parent := Self;
Left :=lbDoctor.Left+lbDoctor.Width+10;
Top := tmpTop-(Height div 2);
OnExit := edDoctorExit;
end;

InputGrid := TStringGrid.Create(Self);
with InputGrid do
begin
Parent := Self;
ScrollBars := ssBoth;
DefaultRowHeight := 24;
Left :=ZbLabel.Left;
Top := ZbLabel.Top+ZbLabel.Height+10;
Height := 400;
Width := 580;
OnDrawCell := InputGridDrawCell;
RowCount := 15;
ColCount := 4;
FixedCols := 0;
CreateDownButton;
Cells[0,0] := '项目';
Cells[1,0] := '结果';
Cells[2,0] := '项目';
Cells[3,0] := '结果';
SetLength(ItemCodeList,ColCount);
for i := 0 to ColCount-1 do
begin
SetLength(ItemCodeList,RowCount-1);
for j := 0 to RowCount-2 do
ItemCodeList[i,j] := -1;
end;
SetLength(ResultList,ColCount);
for i := 0 to ColCount-1 do
begin
SetLength(ResultList,RowCount-1);
for j := 0 to RowCount-2 do
ResultList[i,j] := '';
end;
end;
lbXj := TLabel.Create(Self);
with lbXj do
begin
Parent := Self;
Caption := '小结';
Left := InputGrid.Left;
Top := InputGrid.Top+InputGrid.Height+20;
end;
edXj := TEdit.Create(Self);
with edXj do
begin
Parent := Self;
Left := lbXj.Left+lbXj.Width+2;
Top := lbXj.Top;
Width := (InputGrid.Left+InputGrid.Width)-Left;
end;
FSelectStrings := TStringList.Create;
SelectList := TListBox.Create(Self);
with SelectList do
begin
Visible := False;
Parent := Self;
OnExit := SelectListExit;
OnClick := SelectListClick;
end;
OnResize := InputGridResize;
end;

procedure TTjPanel.SetZbCaption(ZbCaption:String);
begin
FZbCaption := ZbCaption;
ZbLabel.Caption := FZbCaption;
end;

procedure TTjPanel.DownButtonClick(var Msg:TMessage);
var
Rect : TRect;
Point : TPoint;
DownButton : TDownButton;
begin
DownButton := DownButtons[(Msg.WParam div 2),(Msg.LParam-1)];
Showmessage('1');
with DownButton do
begin
FSelectCol := LinkCol;
FSelectRow := LinkRow;
end;
with SelectList do
begin
Visible := True;
Rect := InputGrid.CellRect(FSelectCol,FSelectRow);
Point.x := Rect.Left;
Point.y := Rect.Top;
Point := Self.ScreenToClient(InputGrid.ClientToScreen(Point));
Width := Rect.Right-Rect.Left;
Height := InputGrid.Height div 2;
Left := Point.x;
Top := Point.y+(Rect.Bottom-Rect.Top)+2;
if Top+Height > InputGrid.Top+InputGrid.Height then
Top := Top-Height-(Rect.Bottom-Rect.Top)-2;
end;
end;

procedure TTjPanel.MyButtonClick(Sender:TObject);
begin
ShowMessage('bai');
end;

procedure TTjPanel.SetRowCount(NewCount:Integer);
begin
if NewCount <= InputGrid.FixedRows then
Exit;
FRowCount := NewCount;
InputGrid.RowCount := FRowCount;
CreateDownButton;
end;

Function TTjPanel.GetDownButtonVisible(ACol,ARow:Integer):Boolean;
begin
Result := False;
if (ACol < 0) or(ARow < 0 ) then
Exit;
if (ACol mod 2) = 0 then
Exit;
if (ACol div 2) > (Length(DownButtons)-1) then
Exit;
if ARow > Length(DownButtons[0]) then
Exit;
Result := DownButtons[(ACol div 2),ARow-1].Visible;
end;

procedure TTjPanel.SetDownButtonVisible(ACol,ARow:Integer;Status:boolean);
begin
if (ACol < 0) or(ARow < 0 ) then
Exit;
if (ACol mod 2) = 0 then
Exit;
if (ACol div 2) > (Length(DownButtons)-1) then
Exit;
if ARow > Length(DownButtons[0]) then
Exit;
DownButtons[(ACol div 2),ARow-1].Visible := Status;
end;

procedure TTjPanel.SetSelectStrings(Value:TStringList);
begin
FSelectStrings.Assign(Value);
SelectList.Items.Assign(Value);
end;

procedure TTjPanel.edDoctorExit(Sender:TObject);
begin
if Assigned(FedDoctorExit) then
FedDoctorExit(Sender);
end;

procedure TTjPanel.SelectListExit(Sender:TObject);
begin
SelectList.Visible := False;
end;

procedure TTjPanel.SelectListClick(Sender:TObject);
var
i : integer;
begin
with SelectList do
for i := 0 to Items.Count-1 do
if Selected then
begin
InputGrid.Cells[FSelectCol,FSelectRow] := Items;
InputGrid.SetFocus;
InputGrid.Col := FSelectCol;
InputGrid.Row := FSelectRow;
end;
end;

procedure TTjPanel.InputGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
tmpLeft : Integer;
tmpTop : Integer;
Point:TPoint;
DownButton : TDownButton;
begin
with TStringGrid(Sender) do
begin
if gdFixed in State then
begin
Canvas.Brush.Color := clTeal;
Canvas.Font.Size := 11;
Canvas.Font.Color := clYellow;
end
else
begin
Case ACol of
0,2 :
begin
Canvas.Brush.Color := clInfoBk;
Canvas.Font.Color := clWindowText;
end;
else
begin
Canvas.Brush.Color := clWindow;
DownButton := DownButtons[(ACol div 2),ARow-1];
DownButton.Height :=Rect.Bottom-Rect.Top;

DownButton.Top := Rect.Top;
DownButton.Left := Rect.Left+(Rect.Right-Rect.Left)-DownButton.Width;
{Point.x := Rect.Left;
Point.y := Rect.Top;
Point := Self.ScreenToClient(ClientToScreen(Point));
DownButton.Top := Point.y;
DownButton.Left := Point.x+(Rect.Right-Rect.Left)-DownButton.Width; }
DownButton.LinkCol := ACol;
DownButton.LinkRow := ARow;
end;
end;
Canvas.Font.Size := 9;
end;
Canvas.FillRect(Rect);
//标题栏置中
if gdFixed in State then
tmpLeft := Rect.Left+(Rect.Right-Rect.Left-Canvas.TextWidth(Cells[ACol,ARow])) div 2
else
tmpLeft := Rect.Left+3;
//end
tmpTop := Rect.Top+(Rect.Bottom-Rect.Top-Canvas.TextHeight(Cells[ACol,ARow])) div 2;
Canvas.TextOut(tmpLeft,tmpTop,Cells[ACol,ARow]);
end;
if Assigned(FInputGridDrawCell) then
FInputGridDrawCell(Sender,ACol,ARow,Rect,State);
end;

procedure TTjPanel.InputGridResize(Sender:TObject);
begin
with InputGrid do
begin
Height := Self.Height-100;
Width := Self.Width-10;
ColWidths[0] := (Width div 18)*5-8;
ColWidths[1] := (Width div 9)*2-8;
ColWidths[2] := (Width div 18)*5-8;
ColWidths[3] := (Width div 9)*2-8;
lbXj.Left := InputGrid.Left;
lbXj.Top := InputGrid.Top+InputGrid.Height+20;
edXj.Left := lbXj.Left+lbXj.Width+5;
edXj.Top := lbXj.Top;
edXj.Width := (Left+Width)-edXj.Left;
lbJcrq.Left := ZbLabel.Left+ZbLabel.Width+40;
dtJcrq.Left := lbJcrq.Left+lbJcrq.Width+5;
lbDoctor.Left := dtJcrq.Left+dtJcrq.Width+40;
edDoctor.Left :=lbDoctor.Left+lbDoctor.Width+5;
Repaint;
end;
end;

procedure TTjPanel.RemerberResult;
var
co,ro : Integer;
begin
with InputGrid do
begin
for co := 0 to ColCount -1 do
for ro := 1 to RowCount-1 do
if (co mod 2) = 0 then
ResultList[co,ro-1] := ''
else
ResultList[co,ro-1] := Trim(Cells[co,ro]);
end;
end;

end.

{,如何又要按钮显示正常,OnClick事件又能得到响应?}
 
看得头都晕了,能不能再说清楚呀:-)
 
欧也看云了ZZZZzzzz......
 
不好意思,代码贴得太多,我的大致想法是:在一个StringGrid中的其中一些列上的每一
个Cell粘上一个小的按钮,要求当StringGrid上下滚动时,按钮的位置不会错位,并且能对
按钮的OnClick写响应代码;
各位大侠只要看其中的TDownButton.Create,TDownButton.ButtonClick,
TTjPanel.CreateDownButton,TTjPanel.InputGridDrawCell几个过程即可,其它不相干;
其中CreateDownButton创建按钮,指明Parent, InputGridDrawCell将各个按钮粘在网格上
 
wo ye yun le
我也晕了,,,下载了看吧,,可能有用,,,
 
怎么都说晕,就没有耐心一点的吗?
 
有可能是
消息被inputgrid截获了,
tstringgrid不像tform那样传递消息,
 
程序里没有一条注释,何人看了不晕?!
 
唉,我已说过了,代码中大部份是不相干的,只要看相关的几个过程就行!要是全看,
我也觉得该晕!
dedman:
我也觉得应该是这样,但怎么样在StringGrid中将此消息通知给Button呢?
 
可能要去研究一下twincontrol
tstringgrid不是容器呀,有点麻烦.
 
有一个方法:
1.用会屏幕异常的创建方法.
2.在tstringgrid有onclick事件,或onmousedown事件,通过坐标判定,
执行不同的tbutton上的onclick
 
an example :
/* SG_Available is Stringgrid , U can Write Code in Button1.events*/
procedure TForm1.SG_AvailableSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
CB_Rect:TRect;
begin
CB_Rect:=SG_Available.CellRect(ACol, ARow);
MyACol := ACol;
MyARow := ARow;
Button1.Left := SG_Available.Left+CB_Rect.Left;
Button1.Top := SG_Available.Top+CB_Rect.Top;
Button1.Height := CB_Rect.Bottom-CB_Rect.Top-8;
Button1.Width := CB_Rect.Right-CB_Rect.Left+4;
Button1.Visible := true;
end;
 
可不可以把简化一下:
1、StringGrid中任意时刻只显示一个Button;
2、在某一Cell处于输入状态时才显示Button,其他时刻不显示。
这样就不用同时处理多个Button,而且不用管Grid滚动时Button
对齐的问题(鼠标点击会使当前Cell脱离输入焦点)。
实现时可以利用Cell获得焦点事件显示预先方好的Button,并把他
移动到当前Cell的位置上;在失去焦点的事件中隐去Button。在加入
当前列是否需要该Button的判断就可以了。
 
另外,你为什么要把他们都放在Panel上呢?
如果你要在多处引用他们,不如创建一个Frame,把需要的构件
放好;然后,在需要的地方用Frame引用。如果只是在一个窗体
中使用的话,大可不必写得这么麻烦。
 
我们可以看出,旱秧田大侠在拿着斧头砍鼻子上的灰,要实现他说的功能
用不着使用Button数组,因为TButton为Windows控件,大量使用会占用很多
Windows资源,且不好控制,我推荐一个办法,
直接响应TStringGrid的OnGridDrawCell事件,和OnMouseDown事件,
在表格的单元内,画上按钮,并在鼠标事件中,判断所点中的按钮,如果点中
可以发出自定义的事件(可自定义一个通知事件句柄,如:OnCellButtonClick)。
 
$#%^#%$^#$%%^#^%#$^ too
 
多人接受答案了。
 
后退
顶部