| //***********以下保存为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 |