Delphi留下记忆

const SELDIRHELP=1000;

//目录选择

procedure TForm1.SpeedButton1Click(Sender: TObject);
var dir:String;
begin
dir:='D:';
if SelectDirectory(dir,[sdAllowCreate,sdPerformCreate,sdPrompt],SELDIRHELP) then PathEdt.Text := dir;
end;

//文件遍历

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
DirectoryEdt.Lines.Clear;
ChDir(PathEdt.Text);
MakeTree;
end;

procedure TForm1.MakeTree;
var
Sr: TSearchRec;
Err: Integer;
FilePath: string;
begin
Err := FindFirst('*.*',$37,Sr); //$37为除Volumn ID Files外的所有文件
// 如果找到文件
while (Err = 0) do
begin
if Sr.Name[1] <> '.' then
begin
//找到文件
if (Sr.Attr and faDirectory) = 0 then
begin
FilePath := Sr.Name;
memo2.Lines.Add(FilePath);
end;
//找到子目录
if (Sr.Attr and faDirectory) = 16 then
begin
FilePath := ExpandFileName(Sr.Name);
DirectoryEdt.Lines.Add(FilePath);
ChDir(Sr.Name);
MakeTree;
ChDir('..');
end;
end;

//结束递归
Err := FindNext(Sr);
end;
end;

function DeleteDirectory(NowPath: string): Boolean; //删除整个目录函数，目录下有文件子目录
var
search: TSearchRec;
ret: integer;
key: string;
begin
if NowPath[Length(NowPath)] <> '/' then
NowPath := NowPath + '/';
key := Nowpath + '*.*';
ret := findFirst(key, faanyfile, search);
while ret = 0 do begin
if ((search.Attr and fadirectory) = faDirectory)
then begin
if (Search.Name <> '.') and (Search.name <> '..') then
DeleteDirectory(NowPath + Search.name);
end else begin
if ((search.attr and fadirectory) <> fadirectory) then begin
deletefile(NowPath + search.name);
end;
end;
ret := FindNext(search);
end;
findClose(search);
removedir(NowPath);
result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
Function Copy_Dir(SourceDir,DestDir:String;nLx:Integer):Boolean;
Var
Opstruc: TshFileOpStruct;
frombuf,tobuf: Array[0..128] of Char;
begin
FillChar(frombuf,Sizeof(frombuf),0);
FillChar(tobuf,Sizeof(tobuf),0);
StrPcopy(frombuf,SourceDir);
Case nLx of
1:StrPcopy(tobuf,DestDir);
end;
//Case nLx of
//1: wFunc:=FO_COPY;//拷贝
//2: wFunc:=FO_DELETE;//删除
//Else wFunc:=FO_COPY;
//end;
With Opstruc Do
Begin
Wnd:=0;
Case nLx of
1: wFunc:=FO_COPY;
2: wFunc:=FO_DELETE;
Else wFunc:=FO_COPY;
end;
pFrom:=@frombuf;
pTo:=@tobuf;
fFlags:=FOF_NOCONFIRMATION;// or FOF_SIMPLEPROGRESS;//or FOF_SILENT;
fAnyOperationsAborted:=False;
hNameMappings:=Nil;
lpszProgressTitle:=Nil;
end;
try
ShFileOperation(OpStruc);
Result := True;
except
Result:=False;
end;
end;
var SourceDir, TagDir, times : String;
begin
///删除数据库服务器上前两天的数据
label3.Caption:='..............';
form1.Refresh;
label3.Caption :='删除三天前的源数据......';
form1.Refresh;
times := formatdatetime('yyyymmdd',now-3);
SourceDir := Edit1.Text+'/'+times;
if DirectoryExists(SourceDir) then
begin
application.ProcessMessages;
Copy_Dir(SourceDir,'',2)
end;
////目的源数据
times := formatdatetime('yyyymmdd',now-7);
TagDir := Edit2.Text+'/'+times;
if DirectoryExists(TagDir) then
begin
application.ProcessMessages;
Copy_Dir(TagDir,'',2)
end;
/////文件拷贝
label3.Caption :='拷贝当前数据......';
form1.Refresh;
times := formatdatetime('yyyymmdd',now);
SourceDir := Edit1.Text+'/'+times;
TagDir := Edit2.Text+'/'+times;
if DirectoryExists(TagDir) then
begin
//RemoveDir(TagDir);// 删除空目录
//DeleteDirectory(TagDir);//删除非空目录
Copy_Dir(TagDir,'',2)
end;
//Copy_Dir(SourceDir,TagDir,1);
//label3.Caption :='文件数据拷贝完成！'
if Copy_Dir(SourceDir,TagDir,1)=False Then label3.Caption :='文件数据拷贝失败！' else label3.Caption :='文件数据拷贝完成！';
end;

//ExcelFile文件

unit ExcelFile;

interface

Uses Windows, Excel97, classes, ComObj, Dialogs, Forms, OleServer, Sysutils, Variants;

Type
TExcelFile = Class
Private
FExcelApp, FWorkSheet, FRange : Variant;
FWorkBookName, FApplicationName, FExcelFile : String;
FRow : Integer;
Private
Public
Constructor Create(Flag : Integer = 0);
Procedure StartConnect;
Procedure CloseConnect;
Function OpenExcelFile(Flag : Integer = 1) : String;
Procedure SetTitleFont(ColRange : String; FontSize : Integer = 12; FontBold : Boolean = True; FontItalic : Boolean = True);
{函数功能: 设置标题字体大小}
Procedure SetCellLine(StartCol: String; EndCol : Integer = 0; nRowCount : String = '');
{函数功能: 设置单元格边框}
Procedure SetCellData(DataList : TStringList);
{函数功能: 填充单元格数据}
//2003-09-16
Function NumChgChar(NumNo : Integer) : Char;
{函数功能:根据输入值转换为字符。}
Procedure SetCellFormat(StartColName : Integer; StartRow : String; EndColName : Integer = 0;
EndRow : String = ''; DefNum : Integer = 0;FrmStr : String ='@');
{函数功能说明:根据输入要求设置相应单元格的数据显示格式。如设定单元格格式ColRange = 'A1:B2'
输入函数说明:StartColName : 单元格的起始列名
StartRow : 单元格的起始列的起始行
EndColName : 单元格的结束列名
EndRow : 单元格的结束列的终止行
DefNum : 默认的数据格式为文本格式
FrmStr : 默认的文本格式@
}
Procedure SetColWidth(StartCol, EndCol : Integer; DefWidth : Integer = 0);
{函数功能说明:设置单元格的宽度
输入参数说明: StartCol, EndCol : 单元格的起始终止列
DefWidth : 默认宽度，为0时自动调整为适合宽度。
}
// 2003-12-13
Procedure SetRowHeight(StartRow, EndRow : Integer; DefWidth : Integer = 0);
{函数功能说明:设置单元格的高度
输入参数说明: StartRow, EndRow : 单元格的起始终止列
DefWidth : 默认宽度，为0时自动调整为适合宽度。
}

Procedure SetCellMerge(ColRange : String; NewCol : Integer);
{函数功能说明: 纵向合并单元格
}
//2003-09-17
Procedure SetTextAlign(StartRowCol: String; EndRowCol : Integer = 0;
nEndRow : Integer = 1; Align : Integer = 0);
{函数功能说明: 设置单元格中文本对齐方式
输入参数说明: StartRowCol, EndRowCol : 起始行列、终止行列
nEndRow : 终止行数。
Align : 对齐方式是靠上或居中
}
Procedure SetMergeCol(StartColName : Char; StartRow : String; EndColName : Char = '#'; EndRow : String = '';
MergeCol : Integer = 999; StepBy : Integer = 0);
{函数功能说明: 在一组列范围内按相应的列间隔中将每几列合并为一列。
输入参数说明:
StartColName : 起始列名
StartRow : 起始行
EndColName : 终止列名
EndRow : 终止行
MergeCol:每几列合并，StepBy : 列间隔
如:从E列到I列按如下格式合并,E与F合并为列,H与I合并为列
}
Procedure SetMergeRow(StartColName : Char; StartRow : String; EndColName : Char = '#'; EndRow : String = '');
{函数功能说明: 横向合并单元格}

Property WorkBookName : String Read FWorkBookName Write FWorkBookName;
Property ApplicationName : String Read FApplicationName Write FApplicationName;
Property nStartRow : Integer Read FRow Write FRow;
Property ExFileName : String Read FExcelFile Write FExcelFile;
End;

implementation

{ TExcelFile }

procedure TExcelFile.CloseConnect;
begin
FExcelApp.Quit;
//FExcelApp.Disconnect;
end;

constructor TExcelFile.Create(Flag : Integer = 0);
begin
Inherited Create;
Try
if not VarIsEmpty(FExcelApp) Then
begin
FExcelApp.DisplayAlerts := False;
CloseConnect;
end;

FExcelApp := CreateOleObject('Excel.Application');
FRow := 1;
if Flag = 0 Then
begin
FExcelApp.WorkBooks.Add(xlwbatworkSheet);
FWorkSheet := FExcelApp.WorkBooks[1].WorkSheets[1];
end;

//FExcelApp.WorkBooks[1].WorkSheets[1].Name := 'WorkSheet';
//FExcelApp.Application.Caption := 'Excel File';
Except
Application.MessageBox('Excel软件未安装! 无法导入数据，请稍后再试!','提示信息',MB_OK+MB_ICONERROR);
Raise;
end;
end;

function TExcelFile.NumChgChar(NumNo: Integer): Char;
var i, Value : Integer;
begin
Result := 'Z';
For i := 1 to 26 do
begin
if NumNo = i Then
begin
Value := 64 + i;
Result := Chr(Value);
Break;
end;
end;
end;

Function TExcelFile.OpenExcelFile(Flag : Integer = 1 ) : String;
begin
FExcelApp.WorkBooks.Open(FExcelFile);
Result := FExcelApp.WorkBooks[1].WorkSheets[1].Name;
if Flag = 1 Then FExcelApp.Visible := True
else CloseConnect;
end;

procedure TExcelFile.SetCellData(DataList: TStringList);
var k : Integer;
begin
if DataList.Count = 0 Then Exit;
For k := 1 to DataList.Count do
begin
FExcelApp.Cells[FRow,k] := DataList.Strings[k-1];
end;
FRow := FRow + 1;
end;

Procedure TExcelFile.SetCellFormat(StartColName : Integer; StartRow : String; EndColName : Integer = 0;
EndRow : String = ''; DefNum : Integer = 0;FrmStr : String ='@'); {设定单元格格式ColRange = 'A1:B2'}
var ColRange : String;
begin
ColRange := NumChgChar(StartColName)+StartRow;
if EndColName <> 0 Then
ColRange := ColRange + ':'+NumChgChar(EndColName)+EndRow;

if DefNum = 1 Then FWorkSheet.Range[ColRange].NumberFormat := '#,###0'
else if DefNum = 2 Then FWorkSheet.Range[ColRange].NumberFormat := '#,##0.00'
else
FWorkSheet.Range[ColRange].NumberFormat := FrmStr;
end;

procedure TExcelFile.SetCellLine(StartCol: String; EndCol : Integer = 0; nRowCount : String = '');
var Range : Variant; ColRange : String;
begin
ColRange := StartCol;
if EndCol <> 0 Then
ColRange := ColRange + ':'+NumChgChar(EndCol)+nRowCount;
Range := FWorkSheet.Range[ColRange];
Range.Borders.LineStyle := xlContinuous;
end;

procedure TExcelFile.SetCellMerge(ColRange : String; NewCol: Integer);
begin
FWorkSheet.Range[ColRange].Merge(NewCol);
end;

procedure TExcelFile.SetColWidth(StartCol, EndCol, DefWidth: Integer);
var ColumnRange : Variant; i : Integer;
begin
ColumnRange := FWorkSheet.Columns;
For i := StartCol to EndCol do
begin
if DefWidth = 0 Then ColumnRange.Columns[i].AutoFit
else ColumnRange.Columns[i].ColumnWidth := DefWidth;
end;
end;

procedure TExcelFile.SetMergeCol(StartColName : Char; StartRow : String; EndColName : Char ; EndRow : String;
MergeCol : Integer; StepBy : Integer);
var i, j : Integer; ColRange : String;
begin
if MergeCol = 999 Then
begin
ColRange := StartColName + StartRow + ':'+EndColName+EndRow;
FWorkSheet.Range[ColRange].Merge();
end
else begin
j := 0;
For i := Ord(StartColName) to Ord(EndColName) do
begin
j := j + 1;
if j = MergeCol Then
begin
ColRange := Chr(i-MergeCol+1)+StartRow;
if EndColName <> '#' Then ColRange := ColRange + ':'+Chr(i)+EndRow;
FWorkSheet.Range[ColRange].Merge();
j := -1*StepBy;
end;
end;
end;
end;

procedure TExcelFile.SetMergeRow(StartColName : Char; StartRow : String; EndColName : Char = '#'; EndRow : String = '');
var i : Integer; ColRange : String;
begin
For i := Ord(StartColName) to Ord(EndColName) do
begin
ColRange := Chr(i)+StartRow;
if EndColName <> '#' Then
ColRange := ColRange + ':'+Chr(i)+EndRow;
FWorkSheet.Range[ColRange].MergeCells := True;
end;
end;

procedure TExcelFile.SetRowHeight(StartRow, EndRow, DefWidth: Integer);
var i : Integer;
begin
For i := StartRow to EndRow do
begin
if DefWidth = 0 Then FWorkSheet.Rows[i].RowHeight := 2*FWorkSheet.Rows[i].StandardHeight
else FWorkSheet.Rows[i].RowHeight := DefWidth;
end;
end;

procedure TExcelFile.SetTextAlign(StartRowCol: String;
EndRowCol : Integer = 0; nEndRow : Integer = 1; Align : Integer = 0);
var ColRange : String;
begin
ColRange := StartRowCol;
if EndRowCol <> 0 Then
ColRange := ColRange + ':'+NumChgChar(EndRowCol)+IntToStr(nEndRow);
if Align = 0 Then
begin
FWorkSheet.Range[ColRange].VerticalAlignment := xlVAlignCenter;
FWorkSheet.Range[ColRange].HorizontalAlignment := xlCenter;
end
else FWorkSheet.Range[ColRange].VerticalAlignment := xlVAlignTop
end;

procedure TExcelFile.SetTitleFont(ColRange: String; FontSize: Integer; FontBold : Boolean ; FontItalic : Boolean);
var Range : Variant;
begin
Range := FWorkSheet.Range[ColRange];
Range.Font.Bold := FontBold;
Range.Font.Italic := FontItalic;
Range.Font.Size := FontSize;
end;

procedure TExcelFile.StartConnect;
begin
//FExcelApp.Connect;
FExcelApp.WorkBooks[1].WorkSheets[1].Name := FWorkBookName;
FExcelApp.Application.Caption := FApplicationName;
FExcelApp.Visible := True;
end;

end.

unit Pas_CallExcel_Fun;

interface

Uses SysUtils, Dbgrids, DbTables, Grids, Classes, DB, Dialogs, ExcelFile;

Procedure DBGridToExcel(DBGrid : TDBGrid; Query : TDataSet;
Title : String; Text : String = ''; StartRow : String = '2'; FormBz : String = '';
SetRowId : Boolean = True);
{函数功能: 将TDBGrid网格数据传送到Excel进行打印。
输入参数说明: DBGrid : TDBGrid;
Query : TQuery;
Title : Excel正文标题
FormBz : 不同的表单
SetRowId : 是否带有序号
}

Procedure StrGridToExcel(StrGrid : TStringGrid; Query : TDataSet;
Title : String; Text : String = ''; StartRow : String = '2';
MemoList : TStringList = nil; TextCol : String = '0:0';
IntCol : String = '0:0'; RealCol : String = '0:0';
FormBz : String = '');
{函数功能: 将TStringGrid网格数据传送到Excel进行打印。
输入参数说明: StrGrid : TDBGrid;
Query : TQuery;
Title : Excel正文标题
Text : 页头数据
StartRow : 正文表格起始行
MemoList : 汇总栏数据
TextCol : 文本列; IntCol : 整型列; RealCol : 实数列;
FormBz : 不同的表单
}

Procedure SetCellFormat_GridtEx(ExcelFile : TExcelFile; nNumFormat : Integer;
nCells : String; StartRow_In, EndRow_In : String);
{函数功能: 按照要求设置数据相应的显示格式。
输入参数说明: ExcelFile : TExcelFile;
nNumFormat : Integer 数据显示格式;默认为文本
nCells : String : 所要设定的单元格
StartRow_In, EndRow_In : 起始行**注意下标从1开始,终止行
}

Procedure SetCellFormat_DBtEx(ExcelFile : TExcelFile; DBGrid : TDBGrid;
StartRow_In, EndRow_In : String);
{函数功能: 根据数据类型设置相应的显示格式。
输入参数说明: ExcelFile : TExcelFile;
DBGrid : TDBGrid;
StartRow_In, EndRow_In : 起始行**注意下标从1开始,终止行
}

Function OpenExcelFile(FileName : String; Flag : Integer = 1) : String;

implementation

Function OpenExcelFile(FileName : String;Flag : Integer = 1) : String;
var ExcelApp : TExcelFile;
begin
try
ExcelApp := TExcelFile.Create(1);
except
Exit;
end;
ExcelApp.ExFileName := FileName;
Result := ExcelApp.OpenExcelFile(Flag);
end;

Procedure DBGridToExcel(DBGrid : TDBGrid; Query : TDataSet;
Title : String; Text : String = ''; StartRow : String = '2';
FormBz : String = '';SetRowId : Boolean = True);//DBGrid数据导入Excel类文件;
var
i, k, CellCol : Integer;
DataList : TStringList;
ExcelApp : TExcelFile;
begin
if not Query.Active Then Exit;
try
ExcelApp := TExcelFile.Create;
except
Exit;
end;

//设置单元格显示格式
SetCellFormat_DBtEx(ExcelApp,DBGrid,'3',IntToStr(Query.RecordCount+3));

DataList := TStringList.Create;
//正文标题
ExcelApp.WorkBookName := Title;
ExcelApp.ApplicationName := Title;
DataList.Add(' '+Title+' ');
ExcelApp.SetCellData(DataList);

if Text <> '' Then
begin
DataList.Clear;
DataList.Add(Text);
ExcelApp.SetCellData(DataList);
end;

//网格标题栏
DataList.Clear;
CellCol := 0;

if SetRowId Then
begin
DataList.Add('序号');
CellCol := CellCol + 1;
end;

For i := 0 to DBGrid.Columns.Count - 1 do
begin
if DBGrid.Columns[i].Visible = True Then
begin
DataList.Add(DBGrid.Columns[i].Title.Caption);
CellCol := CellCol + 1;
end;
end;
ExcelApp.SetCellData(DataList);
//空行
DataList.Clear;
ExcelApp.SetCellData(DataList);
//数据行
With Query do
begin
DisableControls;
First;
For k := 0 to RecordCount - 1 do
begin
DataList.Clear;
DataList.Add(IntToStr(k+1));
For i := 0 to DBGrid.Columns.Count - 1 do
begin
if DBGrid.Columns[i].Visible = True Then
begin
if FieldByName(DBGrid.Columns[i].FieldName).asString = '0' Then DataList.Add('')
else DataList.Add(FieldByName(DBGrid.Columns[i].FieldName).asString);
end;
end;
ExcelApp.SetCellData(DataList);
Next;
end;
EnableControls;
end;
//格式设置
With Excelapp do
begin
//设置标题
SetMergeCol('A','1',NumChgChar(CellCol),'1'); //合并单元格
SetTitleFont('A1',18); //标题字体
SetTextAlign('A1'); //文本对齐

if Text <> '' Then SetMergeCol('A','2',NumChgChar(CellCol),'2'); //合并单元格

SetCellLine('A'+StartRow,CellCol,IntToStr(Query.RecordCount+3)); //画线
SetTextAlign('A'+StartRow,CellCol,StrToInt(StartRow)); //文本对齐
SetColWidth(1,CellCol); //自动调整宽度
StartConnect;
//SetMergeRow('A','2',NumChgChar(nEndCol),'3'); //合并单元格
//?该合并单元格语句不能放在前面执行
end;
DataList.Free;
end;

Procedure StrGridToExcel(StrGrid : TStringGrid; Query : TDataSet;
Title : String; Text : String = ''; StartRow : String = '2';
MemoList : TStringList = nil; TextCol : String = '0:0';
IntCol : String = '0:0'; RealCol : String = '0:0';
FormBz : String = '');//StrGrid数据导入Excel类文件;
var
DataList : TStringList;
ExcelApp : TExcelFile;
i, k, CellCol, GS_Row,
StrListCount, StartColRow, EndColRow : Integer;
begin
try
ExcelApp := TExcelFile.Create;
except
Exit;
end;

//设置单元格显示格式
GS_Row := StrToIntDef(StartRow,2)+1;
SetCellFormat_GridtEx(ExcelApp,0,TextCol,IntToStr(GS_Row),IntToStr(StrGrid.RowCount+GS_Row));
SetCellFormat_GridtEx(ExcelApp,1,IntCol, IntToStr(GS_Row),IntToStr(StrGrid.RowCount+GS_Row));
SetCellFormat_GridtEx(ExcelApp,2,RealCol,IntToStr(GS_Row),IntToStr(StrGrid.RowCount+GS_Row));

DataList := TStringList.Create;
//正文标题
ExcelApp.WorkBookName := Title;
ExcelApp.ApplicationName := Title;
DataList.Add(' '+Title+' ');
ExcelApp.SetCellData(DataList);

//网格标题栏
if Text <> '' Then
begin
DataList.Clear;
DataList.Add(Text);
ExcelApp.SetCellData(DataList);
end;
//网格标题栏
DataList.Clear;
CellCol := 0;
For i := 0 to StrGrid.ColCount - 1 do
begin
if StrGrid.ColWidths[i] > -1 Then
begin
DataList.Add(StrGrid.Cells[i,0]);
CellCol := CellCol + 1;
end;
end;
ExcelApp.SetCellData(DataList);
//空行
DataList.Clear;
ExcelApp.SetCellData(DataList);
//数据行
For k := 1 to StrGrid.RowCount - 1 do
begin
DataList.Clear;
For i := 0 to StrGrid.ColCount - 1 do
begin
if StrGrid.ColWidths[i] > -1 Then
begin
if StrGrid.Cells[i,k] = '0' Then DataList.Add('')
else DataList.Add(StrGrid.Cells[i,k]);
end;
end;
ExcelApp.SetCellData(DataList);
end;

//总结栏
StrListCount := 0;
if Assigned(MemoList) Then
begin
StrListCount := MemoList.Count;
For i := 0 to MemoList.Count - 1 do
begin
DataList.Clear;
DataList.Add(MemoList.Strings[i]);
ExcelApp.SetCellData(DataList);
end;
end;

//格式设置
With Excelapp do
begin
//设置标题
SetMergeCol('A','1','F','1'); //合并单元格
SetTitleFont('A1',18); //标题字体
SetTextAlign('A1'); //文本对齐
if Text <> '' Then SetMergeCol('A','2',NumChgChar(CellCol),'2'); //合并单元格

SetCellLine('A'+StartRow,CellCol,IntToStr(StrGrid.RowCount+GS_Row+StrListCount-2)); //画线
SetTextAlign('A'+StartRow,CellCol,StrtoInt(StartRow)); //文本对齐
//合并总结栏
if Assigned(MemoList) Then
begin
StartColRow := StrGrid.RowCount+GS_Row-1;
EndColRow := StartColRow;//+StrListCount+1;
For k := StartColRow to EndColRow do
begin
SetMergeCol('A',IntToStr(k),NumChgChar(CellCol),IntToStr(k)); //合并单元格
end;

//SetRowHeight(StrGrid.RowCount+2,StrGrid.RowCount+2,200); //自动调整宽度
SetTextAlign('A'+IntToStr(StartColRow),0,0,1); //文本对齐
end;

SetColWidth(1,CellCol); //自动调整宽度
SetRowHeight(2,GS_Row,15); //自动调整宽度
StartConnect;
//SetMergeRow('A','2',NumChgChar(nEndCol),'3'); //合并单元格
//?该合并单元格语句不能放在前面执行
end;
DataList.Free;
end;

Procedure SetCellFormat_DBtEx(ExcelFile : TExcelFile; DBGrid : TDBGrid; StartRow_In, EndRow_In : String);
var
StartRow, EndRow : String;
i,nStartCol, nEndCol, nNumFormat : Integer;
begin
With DBGrid, ExcelFile do
begin
nStartCol := 0;
nEndCol := 0;
nNumFormat := 0;
For i := 0 to Columns.Count - 1 do
begin
//设置显示格式
if Columns[i].Visible = True Then
begin
nStartCol := nStartCol + 1;
nEndCol := nEndCol + 1;
StartRow := StartRow_In;
EndRow := EndRow_In;
if Fields[i].DataType = ftInteger Then
begin
nNumFormat := 1;
end
else if (Fields[i].DataType = ftFloat) or (Fields[i].DataType = ftCurrency) Then
begin
nNumFormat := 2;
end
else if Fields[i].DataType = ftString Then
begin
StartRow := '';
nNumFormat := 0;
EndRow := '';
end;
SetCellFormat(nStartCol,StartRow,nEndCol,EndRow,nNumFormat);//调用TExcelFile类
end;
end;
end;
end;

Procedure SetCellFormat_GridtEx(ExcelFile : TExcelFile; nNumFormat : Integer;
nCells : String; StartRow_In, EndRow_In : String);
var
StartRow, EndRow : String;
nStartCol, nEndCol : Integer;
begin
//说明：nNumFormat，0 -文本，1 -整型，2 -浮点
With ExcelFile do
begin
nStartCol := StrToIntDef(Copy(nCells,1,Pos(':',nCells)-1),0);
nEndCol := StrToIntDef(Copy(nCells,Pos(':',nCells)+1,MaxInt),0);
StartRow := StartRow_In;
EndRow := EndRow_In;
SetCellFormat(nStartCol,StartRow,nEndCol,EndRow,nNumFormat);//调用TExcelFile类
end;
end;

end.

//写注册表

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('/Software/ODBC/ODBC.INI/ODBC Data Sources', True) then
begin
Reg.WriteString('HMF','SQL Server');
Reg.CloseKey;
end;
if not Reg.OpenKey('/Software/ODBC/ODBC.INI/HMF', False) then
begin
Reg.CreateKey('HMF');
end;
if Reg.OpenKey('/Software/ODBC/ODBC.INI/HMF', True) then
begin
Reg.WriteString('Datebase','mydb');
Reg.WriteString('Driver','C:/WINNT/System32/sqlsrv32.dll');
Reg.WriteString('Server','HL-71-HMF');
Reg.WriteString('LastUser','sa');
end;
finally
Reg.Free;
inherited;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var IniFileName, DbName_yd, DbName_lt,
StrODBC_yd, UserName_yd, StrODBC_lt, UserName_lt,
SerName_yd, SerName_lt : String;
begin
IniFileName := ExtractFilePath(paramstr(0))+'Sysname.Ini';
DbName_yd := GetIniFile(IniFileName,'ODBC','ydDB');
StrODBC_yd := GetIniFile(IniFileName,'ODBC','ydODBC');
UserName_yd := GetIniFile(IniFileName,'ODBC','ydUser');
SerName_yd := GetIniFile(IniFileName,'ODBC','ydSer');

DbName_lt := GetIniFile(IniFileName,'ODBC','ltDB');
StrODBC_lt := GetIniFile(IniFileName,'ODBC','ltODBC');
UserName_lt := GetIniFile(IniFileName,'ODBC','ltUser');
SerName_lt := GetIniFile(IniFileName,'ODBC','ltSer');

if StrODBC_yd <> '' Then CreateRegKey(DbName_yd,StrODBC_yd,SerName_yd,UserName_yd);
if StrODBC_lt <> '' Then CreateRegKey(DbName_lt,StrODBC_lt,SerName_lt,UserName_lt);
end;

procedure TForm1.CreateRegKey(DbName, StrODBC, SerName, UserName: String);
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('/Software/ODBC/ODBC.INI/ODBC Data Sources', True) then
begin
Reg.WriteString(StrODBC,'SQL Server');
Reg.CloseKey;
end;
if not Reg.OpenKey('/Software/ODBC/ODBC.INI/'+StrODBC, False) then
begin
Reg.CreateKey(StrODBC);
if Reg.OpenKey('/Software/ODBC/ODBC.INI/'+StrODBC, True) then
begin
Reg.WriteString('Database',dbName);
Reg.WriteString('Driver','C:/WINNT/System32/sqlsrv32.dll');
Reg.WriteString('Server',SerName);
Reg.WriteString('LastUser',UserName);
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;