Delphi留下记忆

最新推荐文章于 2023-03-20 20:41:21 发布

amaryh

最新推荐文章于 2023-03-20 20:41:21 发布

阅读量1.1k

点赞数

文章标签： delphi integer string excel query sql server

本文链接：https://blog.csdn.net/amaryh/article/details/5433673

版权

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));

//网格标题栏
    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;

amaryh

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
Delphi留下记忆

const SELDIRHELP=1000;//目录选择procedure TForm1.SpeedButton1Click(Sender: TObject);var dir:String;begin dir:=D:; if SelectDirectory(dir,[sdAllowCreate,sdPerformCreate,sdPrompt],SELDIRHELP) then
复制链接

扫一扫