请看我的程序(行数太多,截取部分),这个软件可以打开多个StringGrid(仿照Excel的Sheet)
************************
procedure TfrmMain.dmOpenExecute(Sender: TObject); // 这是生成Grid的程序
var
i, idx: Integer;
ps: ^TSheet;
Node: TTreeNode;
begin
Node := tvCatalog.Selected;
idx := Node.AbsoluteIndex;
// 及时更改当前的单位ID、报表ID
fRep := TstringList(Node.Parent.Data^);
WorkUID := String(Node.Parent.Parent.Data^);
WorkRID := fRep.Values['RID'];
// 第一次打开某报表的任一期时,都要读取报表定义
if fRep.IndexOfName('FieldNum') < 0 then
if not GetRepDefine(WorkRID, fRep) then
Exit;
New(ps);
Node.Data := ps;
Sheets.Add(ps);
ps^.SG := TStringGrid.Create(frmMain);
ps^.SG.Visible := False;
ps^.SG.Parent := frmMain;
ps^.SG.Options := [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,
goDrawFocusSelected,goEditing];
ps^.SG.Name := 'Node' + IntToStr(idx); // 建立一个有标记的名字
ps^.Status := ssNormal;
ps^.OldCol := 0;
ps^.OldRow := 0;
ps^.BaseData := TStringList.Create;
{
Status:基数提取状态,0:未提取;-1:提取不成功; 1:成功提取
}
ps^.BaseData.Add('Status=0');
ps^.Node := Node;
ps^.UpTime := WorkYear + Copy(Node.Text, 2, 2);
ps^.SQL := 'Select * from ' + fRep.Values['Table']
+ ' Where ID_Unit=''' + WorkUID + ''''
+ ' and ReportUpTime=''' + ps^.UpTime + ''''
+ ' Order By IndexCode';
DrawSheet(ps^);
for i := 1 to StrToInt(fRep.Values['FieldNum'])-1 do
if fRep.Values['Field'+IntToStr(i)+'.Validity'] = '2' then
begin
ps^.SG.Col := FCols + i - 1;
Break;
end;
ps^.SG.Visible := True;
ps^.SG.SetFocus;
// 增加Tab
if DM.IsAdmin(DM.CurrID) then
tcRepCatalog.Tabs.Add('<' + Node.Parent.Parent.Text + '> '
+ Node.Parent.Text + Node.Text)
else
tcRepCatalog.Tabs.Add(Node.Parent.Text + Node.Text);
tcRepCatalog.TabIndex := tcRepCatalog.Tabs.Count-1;
tcRepCatalogChange(dmOpen);
Node.ImageIndex := 4; // 报表打开时的图标
Node.SelectedIndex := 4;
end;
procedure TfrmMain.dmCloseExecute(Sender: TObject); // 关闭一个Sheet
var
i: Integer;
begin
if (WorkSheet.Status = ssEdited) and
(Application.MessageBox('当前报表数据已被修改,是否保存?', '提示',
MB_OKCANCEL+MB_ICONQUESTION) = idOK) then // 提问是否保存数据
dmSaveExecute(Sender);
FreeSheet(WorkSheet);
i := tcRepCatalog.TabIndex;
Dispose(Sheets.Items);
Sheets.Remove(Sheets.Items);
tcRepCatalog.Tabs.Delete(i);
if Sheets.Count > 0 then
begin
if i > tcRepCatalog.Tabs.Count-1 then
tcRepCatalog.TabIndex := tcRepCatalog.Tabs.Count-1
else
tcRepCatalog.TabIndex := i;
tcRepCatalogChange(dmClose); // 更新WorkSheet;
end;
end;
procedure TfrmMain.FreeSheet(ASheet: TSheet);
begin
with ASheet do
begin
SG.OnDrawCell := nil;
SG.OnKeyPress := nil;
SG.OnSelectCell := nil;
SG.OnSetEditText := nil;
SG.Free;
BaseData.Free;
Node.ImageIndex := 3;
Node.SelectedIndex := 3;
Node.Data := nil;
end;
end;
procedure TfrmMain.DrawSheet(ASheet: TSheet);
var
i, j, k, fNum, iNum: Integer;
rep: TStringList;
fn: String;
begin
rep := TstringList(ASheet.Node.Parent.Data^);
with ASheet.SG do
begin
SendToBack; // 放在后台处理
DefaultRowHeight := 20;
Align := alClient;
OnDrawCell := sgDrawCell;
OnKeyPress := sgKeyPress;
OnSelectCell := sgSelectCell;
OnSetEditText := sgSetEditText;
// 初始化设置
RowCount := FRows + 1;
ColCount := FCols + 1;
Rows[0].Text := '';
Rows[1].Text := '';
Cols[0].Text := '';
Cols[1].Text := '';
Cols[2].Text := '';
Cells[0, 0] := '序号';
Cells[1, 0] := rep.Values['Field0.Desc'];
ColWidths[0] := 30;
ColWidths[1] := 260;
FixedRows := FRows;
FixedCols := FCols;
// 处理标题行
fNum := StrToInt(rep.Values['FieldNum']); // 报表字段数量
// for i := 0 to fNum-1 do // 不能从0开始,因为0是IndexDesc,见上面的应用
for i := 1 to fNum-1 do
begin
fn := rep.Values['Field'+IntToStr(i)+'.Name'];
if not FldIsValid(fn, rep) then
Continue;
Cells[ColCount-1, 0] := rep.Values['Field'+IntToStr(i)+'.Desc'];
ColWidths[ColCount-1] := 80;
ColCount := ColCount + 1;
end;
ColCount := ColCount - 1; // 去掉最后一个空列
// 填充报表数据
CanCalc := False; // 禁止单元格计算能力
with DM.qryTemp do
begin
Close;
SQL.Text := ASheet.SQL;
Open;
if RecordCount = 0 then // 没有当期数据的处理,只显示前导字符
begin
ASheet.IsNew := True; // 只有这种情况才可以提取基数
FixedColor := clSkyBlue;
iNum := StrToInt(rep.Values['IndexNum']); // 报表指标定义数量
for i := 0 to iNum-1 do
begin
fn := rep.Values['Index'+IntToStr(i)+'.Code'];
Cells[0, RowCount-1] := RightStr(' '+IntToStr(RowCount-1), 4);
Cells[1, RowCount-1] := rep.Values['Index'+IntToStr(i)+'.Desc'];
for j := 1 to fNum-1 do
Cells[j+1, RowCount-1] := GetModePart(rep.Values['Index'
+IntToStr(i)+'.Mode.'
+rep.Values['Field'+IntToStr(j)+'.Name']], 2);
RowCount := RowCount + 1;
end;
end
else
begin
ASheet.IsNew := False;
FixedColor := clBtnFace;
First;
i := 1;
while not Eof do
begin
k := GetIndexNo(FieldByName('IndexCode').AsString, 0, rep);
Cells[0, i] := RightStr(' '+IntToStr(i), 4);
Cells[1, i] := rep.Values['Index'+IntToStr(k)+'.Desc'];
for j := 1 to fNum-1 do
Cells[j+1, i] := FieldByName(rep.Values['Field'+IntToStr(j)+'.Name']).AsString;
RowCount := RowCount + 1;
Inc(i);
Next;
end;
end;
end;
RowCount := RowCount - 1; // 去掉最后一个空行
CanCalc := True;
end;
end;
**************************
请帮忙分析,谢谢!