|
|
//***********以下保存为unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure StringGrid1MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
WeekDayName :Array[1..7] of
String=('星期一','星期二','星期三','星期四','星期五','星期六','星期日')
;
var
X_Pos,Y_Pos:integer;//鼠标在窗体的位置
Col_Pos,Row_Pos:integer;//单元位置
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
Application.HintPause:=100;
Font.Size :=10;
Caption:='STring岩石程序';
StringGrid1.ShowHint :=True;
StringGrid1.ColCount :=8;
StringGrid1.RowCount :=12;
StringGrid1.Cells[0,0]:='第18周';
for i:=1 to StringGrid1.ColCount -1 do
StringGrid1.Cells[i,0]:=WeekDayName[i];
for i:=1 to StringGrid1.RowCount -1 do
StringGrid1.Cells[0,i]:=InttoStr(i+7)+':00';
StringGrid1.Options
:=StringGrid1.Options+[goTabs,goROwSizing,goColSizing]-[goEditing];
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
SchemeItem:String;
begin
StringGrid1.MouseToCell(X_Pos,Y_Pos,Col_Pos,Row_Pos) ;
//转换到单位位置
if (Col_Pos<0 )or (Row_Pos<0 ) then
Exit;
if (StringGrid1.Cells[Col_Pos,Row_Pos]<>'' ) then //取消计划概要
begin
StringGrid1.Cells[Col_Pos,Row_Pos]:='';
Exit;
end;
SchemeItem:=InputBox('提示','请输入计划概要：','会议');
StringGrid1.Cells[Col_Pos,Row_Pos]:=SchemeItem;
End;
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
X_Pos:=x;
Y_Pos:=y;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
StringGrid1.MouseToCell(X_Pos,Y_Pos,Col_Pos,Row_Pos);//转化到单元位置
StringGrid1.Hint
:=StringGrid1.Cells[Col_Pos,Row_Pos];//暂时借用该特性显示工作计划
end;
end.
//*******以下保存为unit1.dfm
object Form1: TForm1
Left = 192
Top = 107
Width = 544
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object StringGrid1: TStringGrid
Left = 0
Top = 0
Width = 536
Height = 348
Align = alClient
TabOrder = 0
OnClick = StringGrid1Click
OnDblClick = StringGrid1DblClick
OnMouseDown = StringGrid1MouseDown
end
end
|
|
