码迷,mamicode.com
首页 > Windows程序 > 详细

分享Delphi处理EXCEL源码

时间:2015-03-20 11:06:47      阅读:246      评论:0      收藏:0      [点我收藏+]

标签:pictures   excel   

分享Delphi处理EXCEL源码,源码如下:
 (****************************************************************************************)
var
  FExcelApp:Variant;                                         // Excel App  FCellRange:Variant;                                        // Excel Range  FPicture:Variant;                                          // pictures  FCellNo:string;                                            // Cell Strings  g_strHeaderSQL: string;                                    // Special Header Dataset SQL  g_strDetailSQL: string;                                    // Special Detail Dataset SQL  g_TemplateFile: string;                                    // Special Filename  g_iCopies:integer;                                         // Special PrintCopies
  g_strDefaultPath:string = ‘D:\\\\测试\\\\‘;                      // Default Path  g_strSpecialFile:string = ‘MARK & SPENCER UK WORD.XLS‘;    // Special File Name  (****************************************************************************************)
procedure TNewLabdipQuery.btnPrintSampleCardClick(Sender: TObject);var  i,j:integer;  TemplateFile,tTemplateFile,iniTemplateFile: string;       grid_Color_Code, grid_Customer, grid_Submit:string;     // *色号 *客户名 *Shape  iCopies:Integer;                                        // *打印份数  iSheetCount:Integer;                                    // *工作表数量  bNeedmultiSheet:Boolean;                                // *是否需要处理多个文档  bOpenLabDataSource:Boolean;                             // *是否成功打开数据源  ibSpecialCount: Integer;                                // *特殊色号数量  bSpecial:Boolean;                                       (* *标识某些需要特殊处理的客户: 把这些客户的数据保存到一个Dataset,                                                              最后再处理,主要是为了让"多个LD当只交1个SAHDE时 ,尽可能打在一张纸上" *)  bEnablePrinted, bEnableSave:Boolean;                    // *For Debugbegin  bNeedmultiSheet    := false;  ibSpecialCount     := 0;  bOpenLabDataSource := True;     g_strHeaderSQL     := ‘‘;  g_strDetailSQL     := ‘‘;  g_TemplateFile     := ‘‘;
  // 是否打印 Or 是否保存文件  bEnablePrinted     := True;  bEnableSave        := False;
  if (not asp_GetNewcolorCode.Active) or (asp_GetNewcolorCode.Eof) then  begin    Application.Messagebox(Pchar(‘没有要处理的数据,请先查询后打印送样卡!‘),                    Pchar(‘提示‘),Mb_IconInforMation+MB_OK);    exit;     end;
  // 增加个提示,防止误点击  if Application.Messagebox(Pchar(‘你真的要打印送样卡吗?‘),                   Pchar(‘提示‘),Mb_IconInforMation+MB_YESNO) = id_no then exit;
  // 如打印较多,增加个提示  if ds_GetNewcolorCode.DataSet.RecordCount>10 then    if Application.Messagebox(Pchar(‘当前打印的色号超过 10 个,你确认要打印吗?‘),                       Pchar(‘提示‘),Mb_IconInforMation+MB_YESNO) = id_no then exit;
  try                 
    try      // 获取模板存放路径      iniTemplateFile    := ReadTemplatePath(‘PTMParameters‘,                                             ‘LabDip‘,                                             ‘TemplatePath‘,                                             g_strDefaultPath);
      g_strSpecialFile   := iniTemplateFile +                            ReadTemplatePath(‘PTMParameters‘,                                             ‘LabDip‘,                                             ‘SpecialFile‘,                                             g_strSpecialFile);    except      on e:Exception do      begin        Screen.Cursor := crDefault;        raise Exception.Create(‘获取模板存放路径出现错误!‘);      end;    end;
    Screen.Cursor := crSQLWait;
    AddSampleCardInfoToSB(‘开始打印送样卡...‘);
    // 开始遍历处理记录中的每个色号    ds_GetNewcolorCode.DataSet.First;    while not ds_GetNewcolorCode.DataSet.Eof do    begin      bSpecial := false;
      grid_Color_Code := UpperCase(Trim(ds_GetNewcolorCode.DataSet.FieldByName(‘Color_Code‘).Value));      grid_Customer   := UpperCase(Trim(ds_GetNewcolorCode.DataSet.FieldByName(‘Customer‘).Value));      grid_Submit     := UpperCase(Trim(ds_GetNewcolorCode.DataSet.FieldByName(‘Submit‘).Value));
      // 需要特殊处理,暂只有一个特殊客户      if (grid_Customer=‘MARK & SPENCER UK‘) AND (Length(grid_Submit)=1) then      //if (grid_Customer=‘MARK & SPENCER UK‘) then      begin        inc(ibSpecialCount);        bSpecial := True;        //ShowMessage(‘ibSpecialCount‘);      end;
      AddSampleCardInfoToSB(‘正在处理客户 [‘ + grid_Customer + ‘] 的资料...‘);
      // 获取 Excel 模板格式名      TemplateFile  := Trim(GetSampleCardInfo(grid_Customer, grid_Submit, 0));      tTemplateFile := TemplateFile;      TemplateFile  := iniTemplateFile+ TemplateFile + ‘.xls‘;
      if bSpecial then      begin        g_TemplateFile := TemplateFile;        TemplateFile   := g_strSpecialFile;      end;
      // 如果返回空的格式名,则不处理,继续下一个色号      if TemplateFile=‘‘ then      begin        ds_GetNewcolorCode.DataSet.Next;        Continue;      end;       
      // 获取打印份数      iCopies := GetSampleCardInfo(grid_Customer, grid_Submit, 1);      if bSpecial then      begin        g_iCopies := iCopies;        iCopies   := 1;      end;
      //***      //Memo1.Lines.Text := Memo1.Lines.Text + grid_Color_Code+#13#10+ grid_Customer+#13#10+grid_Submit+#13#10+Inttostr(iCopies);  //    Exit;      // 打开 EXCEL 模板文件      AddSampleCardInfoToSB(‘正在处理客户 [‘ + grid_Customer + ‘] 的资料(打开 EXCEL 模板文件)...‘);      try        if not OpenExcelTemplate(TemplateFile, 1) then        begin          FreeExcelApp;          ds_GetNewcolorCode.DataSet.Next;          Continue;        end;      except        on e:Exception do        begin          FreeExcelApp;          Screen.Cursor := crDefault;          raise Exception.Create(‘打开 EXCEL 模板文件出现错误(检查文件名与系统设定是否一致)!‘);        end;      end;
      // 打开 LabDip 数据源 (色号信息 & 对色仪导出的颜色值)      //if not OpenLabDataSource(‘11220GNFD01‘, ‘A‘) then exit;      AddSampleCardInfoToSB(‘正在处理客户 [‘ + grid_Customer + ‘] 的资料(打开 色号信息 & 对色仪导出的颜色值)...‘);      try               // 如果需要特殊处理的数据,只处理附带的那个文件,同时返回SQL指令给全局变数        if bSpecial then bOpenLabDataSource := OpenLabDataSource(grid_Color_Code, grid_Submit,1);        bOpenLabDataSource := OpenLabDataSource(grid_Color_Code, grid_Submit,0);
        if not bOpenLabDataSource then        begin          FreeExcelApp;          ds_GetNewcolorCode.DataSet.Next;          Continue;        end;      except        on e:Exception do        begin          FreeExcelApp;          Screen.Cursor := crDefault;          raise Exception.Create(‘打开 LabDip数据源出现错误!‘);        end;      end;
      // 获取当前工作表的数量      if bSpecial then iSheetCount := 1      else          iSheetCount := FExcelApp.WorkSheets.Count;
      // 某些情况需要处理多个文档,加个回圈      for i:=1 to iSheetCount do      begin        // 寻找 Range Cell 并输出数据        AddSampleCardInfoToSB(‘正在处理客户 [‘ + grid_Customer + ‘] 的资料(寻找 Range Cell 并输出数据)...‘);        try          if not ExportDataToExcel(adoqryColorCode, adoqryColorInformation, i) then          begin            FreeExcelApp;            ds_GetNewcolorCode.DataSet.Next;            Continue;          end;        except          on e:Exception do          begin            FreeExcelApp;            Screen.Cursor := crDefault;            raise Exception.Create(‘输出数据出现错误!‘);          end;        end;      end;
      // 打印      if bEnablePrinted then      begin        for i:=1 to iSheetCount do        begin          FExcelApp.WorkSheets[i].Activate;          for j:=1 to iCopies do          begin            FExcelApp.ActiveSheet.PrintOut;          end        end;      end;
      if bEnableSave then        FExcelApp.ActiveWorkBook.SaveAs(iniTemplateFile+ tTemplateFile + ‘_副本.xls‘);
      FreeExcelApp;
      ds_GetNewcolorCode.DataSet.Next;
    end;
    (* ************************************** *)    (* 处理特殊客户,多个色号打印在一张纸上   *)    (* 基本上与上面处理流程一样,只是没有回圈 *)    (* ************************************** *)        if ibSpecialCount > 0 then    begin      AddSampleCardInfoToSB(‘正在处理特殊色号的资料...‘); 
      //打开数据集      g_strHeaderSQL := LeftStr(g_strHeaderSQL, Length(g_strHeaderSQL)-10);      g_strDetailSQL := LeftStr(g_strDetailSQL, Length(g_strDetailSQL)-10);
      //Memo1.Lines.Text := g_strHeaderSQL + #13#10+ #13#10+g_strDetailSQL+#13#10+Inttostr(g_iCopies);  //Exit;
      if not OpenDataSet(adoqryColorCode, g_strHeaderSQL, 0, false) then      begin        Screen.Cursor := crDefault;        exit;      end;      if not OpenDataSet(adoqryColorInformation, g_strDetailSQL, 1, false) then      begin        Screen.Cursor := crDefault;        exit;      end;     
      // 打开 EXCEL 模板文件      AddSampleCardInfoToSB(‘正在处理特殊色号的资料(打开 EXCEL 模板文件)...‘);      try        if not OpenExcelTemplate(g_TemplateFile, 1) then FreeExcelApp;      except        on e:Exception do        begin          FreeExcelApp;          Screen.Cursor := crDefault;          raise Exception.Create(‘打开 EXCEL 模板文件出现错误(检查文件名与系统设定是否一致)!‘);        end;      end;            // 依据多少个色号记录,计算多少个电子档      // 一张纸只打印 4 个色号,小于4条记录就 默认一个电子档      if ibSpecialCount>4 then      begin        if (ibSpecialCount mod 4)=0 then          ibSpecialCount := ibSpecialCount div 4        else          ibSpecialCount := (ibSpecialCount div 4) + 1;      end      else        ibSpecialCount := 1;
      AddSampleCardInfoToSB(‘正在处理特殊色号的资料(寻找 Range Cell 并输出数据)...‘);      // 寻找 Range Cell 并输出数据                                                          try        if not ExportDataToExcel(adoqryColorCode, adoqryColorInformation, 1, True) then FreeExcelApp;          except        on e:Exception do        begin          FreeExcelApp;          Screen.Cursor := crDefault;          raise Exception.Create(‘输出数据出现错误!‘);        end;      end;
      // 打印      if bEnablePrinted then      begin        for i:=1 to ibSpecialCount do        begin          FExcelApp.WorkSheets[i].Activate;          for j:=1 to g_iCopies do          begin            FExcelApp.ActiveSheet.PrintOut;          end        end;      end;
      if bEnableSave then        FExcelApp.ActiveWorkBook.SaveAs(g_TemplateFile + ‘_副本.xls‘);              FreeExcelApp;     
    end;
  except  on e:Exception do    begin      if not VarIsEmpty(FExcelApp) then      begin        FExcelApp.Quit;        Screen.Cursor := crDefault;        FExcelApp := Unassigned;      end;      //raise Exception.Create(‘打印送样卡出现错误!‘);    end;  end;
  ds_GetNewcolorCode.DataSet.First;  AddSampleCardInfoToSB(‘成功打印送样卡...‘);
  Screen.Cursor := crDefault;
end;
// 打开模板文件function TNewLabdipQuery.OpenExcelTemplate(vFilename: string;  iTabsheet: Integer): Boolean;begin  Result := false;          
  try    FExcelApp := CreateOleObject(‘Excel.Application‘);  except    on e:Exception do    begin      Application.Messagebox(Pchar(‘无法创建Excel元件,请检查这台电脑是否正常安装Excel软件!‘+e.Message),                      Pchar(‘警告‘),MB_ICONWARNING+MB_OK);    end;  end;
  FExcelApp.WorkBooks.Open(vFilename);  FExcelApp.application.DisplayAlerts := false;  FExcelApp.WorkSheets[iTabsheet].Activate;
  Result := true;end;
// 打开数据源// iType=0 正常处理 iType>0 特殊处理function TNewLabdipQuery.OpenLabDataSource(vColor_name,  vShape: string;iType:Byte): Boolean;  // 设置SQL语句  function SetDataSourceSQL(AColor_name,AShape: string; i:Byte; bMergerUnion:Boolean):string;  var    strmergerSQL:string;    strMath:String;  begin      Result := ‘‘;
    strmergerSQL := ‘‘;    if bMergerUnion then strmergerSQL := ‘ UNION ALL ‘;
    if i=0 then      Result := strmergerSQL +                ‘SELECT DISTINCT TOP  1 a.color_code + ‘‘ ‘‘ + ‘‘‘ + AShape + ‘‘‘ AS Batch_Name, ‘ +                ‘b.Comment,a.*,b.submit,customerName=c.customer, PrintDate=getdate() ‘ +                ‘FROM artdb..rtcolorhead a ‘ +                ‘INNER JOIN systemdb..pbcustomerlist c on c.customer_code=a.customer ‘ +                ‘LEFT JOIN artdb.dbo.RtColorLabDIP b on a.color_code=b.color_code and b.times=(‘ +                ‘SELECT MAX(times) FROM artdb.dbo.RtColorLabDIP where color_code=b.color_code) ‘ +                ‘WHERE a.color_code=‘‘‘ + AColor_name + ‘‘‘ ‘    else    begin      // 计算 DC & DH 列      strMath := ‘ DC = ROUND( ‘ +                 ‘          SQRT(SQUARE(CIE_a) + SQUARE(CIE_b)) -  ‘ +                 ‘          SQRT(SQUARE(CIE_a-CIE_da) + SQUARE(CIE_b-CIE_db)), ‘ +                 ‘          2), ‘ +
                 ‘ DH = ROUND(  ‘ +                 ‘                  SQRT( ‘ +                 ‘                  SQUARE(CIE_DE) - ‘ +                 ‘                  SQUARE  ‘ +                 ‘                   (      ‘ +                 ‘                          SQRT(SQUARE(CIE_a) + SQUARE(CIE_b)) - ‘ +                 ‘                          SQRT(SQUARE(CIE_a-CIE_da) + SQUARE(CIE_b-CIE_db)) ‘ +                 ‘                    ) -   ‘ +                 ‘                  SQUARE(CIE_DL) ‘ +                 ‘                  ), ‘ +                 ‘                  2  ‘ +                 ‘      )  ‘ ;
      Result := strmergerSQL +                ‘SELECT *, ‘ + strMath +                 ‘FROM [Esquel].[dbo].[DTEBatch] WHERE Batch_Name=‘‘‘ +                AColor_name + ‘ ‘ + AShape + ‘‘‘ ‘;    end;  end;  // 打开数据集  function OpenDataSet(adoqry:TADOQuery; strSQL:string; i:byte; bHits:Boolean=true):Boolean;  begin    Result := false;    adoqry.Close;    adoqry.SQL.Clear;    adoqry.SQL.Add(strSQL);     try      adoqry.Open;        except      on e:Exception do      begin        Application.Messagebox(Pchar(‘打开数据集出现错误!‘+e.Message),                        Pchar(‘提示‘),MB_ICONWARNING+MB_OK);        exit;      end;    end;
    // 是否提示     if bHits then    begin      if adoqry.Eof then      begin      if i=0 then        ShowMessage(‘色号不存在!‘)      else         ShowMessage(‘颜色信息不存在!‘);      end;      end;    Result := true;  end;var  strHeaderSQL: string;  strDetailSQL: string;  strmergerSQL: string;  bManyShape: Boolean;         // 多个Shape ?  minShape, MaxShape: string;  i, j, k:integer;begin
  Result := false;
  bManyShape := False;
  if vShape=‘‘ then  begin    Application.Messagebox(Pchar(‘色号[‘ + vColor_name + ‘] Shape至少为一个,请检查这个色号是否正为试样!‘),                    Pchar(‘提示‘),MB_ICONWARNING+MB_OK);    exit;  end;
  minShape := LeftStr(vShape, 1);
  if Pos(‘-‘, vShape) > 0 then  begin    bManyShape := True;    MaxShape := RightStr(vShape, 1);  end;
  // 设置数据源的SQL语句  strHeaderSQL := SetDataSourceSQL(vColor_name,minShape,0, False);  strDetailSQL := SetDataSourceSQL(vColor_name,minShape,1, False);
  // 某些特殊的情况需要不打开数据集,累计所有SQL指令,在本函数外一次性打开  if iType>0 then  begin    g_strHeaderSQL := g_strHeaderSQL + strHeaderSQL + ‘ UNION ALL ‘;    g_strDetailSQL := g_strDetailSQL + strDetailSQL + ‘ UNION ALL ‘;  end;
  (* Debug *)
//  Memo1.Clear;//  Memo1.Lines.Text := strHeaderSQL;
//  strDetailSQL := SetDataSourceSQL(vColor_name,minShape,1, False);//  Memo1.Lines.Text := Memo1.Lines.Text + chr(13)+chr(10)+strDetailSQL;//  exit; }  (* Debug *)
  // 有多个Shape时,循环处理  if bManyShape then  begin    i := ord(minShape[1])+1;    j := Ord(MaxShape[1]);    for k := i to j do    begin      strHeaderSQL := strHeaderSQL + SetDataSourceSQL(vColor_name,chr(i),0, True);      strDetailSQL := strDetailSQL + SetDataSourceSQL(vColor_name,chr(j),1, True);      {* 暂没有多个Shape的需求 *}      {if iType>0 then      begin        g_strHeaderSQL := g_strHeaderSQL + strHeaderSQL + ‘ UNION ALL ‘;        g_strDetailSQL := g_strDetailSQL + strDetailSQL + ‘ UNION ALL ‘;      end;}    end;  end;
  // 打开数据集  if iType=0 then  begin    if not OpenDataSet(adoqryColorCode, strHeaderSQL, 0, false) then exit;    if not OpenDataSet(adoqryColorInformation, strDetailSQL,1, false) then exit;  end;      Result := true;
end;
// 汇出资料到 Excel function TNewLabdipQuery.ExportDataToExcel(HeadDS,  DetailDS: TDataSet; iTabSheet:Integer; bSpecial:boolean): Boolean;var  iHDRField, iDTLField, iHDRRecord, iDTLRecord: Integer;   begin
  Result := false;
  try      HeadDS.First;    iHDRRecord:=0;
    //循环主表的每一条记录    while Not HeadDS.Eof do    begin      iHDRRecord := iHDRRecord +1;
      // 需要特殊处理的客户,自动切换工作表      if bSpecial then      begin        if iHDRRecord mod 4 = 0 then inc(iTabSheet);      end;
      //循环当前记录的每一个字段      for iHDRField := 0 to HeadDS.FieldCount - 1  do      begin                 // 填充主表内容        FCellNo := HeadDS.Fields[iHDRField].FieldName + ‘_H_‘ + IntToStr(iHDRRecord);        //根据CellNo的值查找Excel相关栏位赋值        FCellRange := FExcelApp.WorkSheets[iTabSheet].Cells.Find(FCellNo);        While not VarIsClear(FCellRange) do        begin          FCellRange.Value := HeadDS.Fields[iHDRField].AsString;          FCellRange := FExcelApp.WorkSheets[iTabSheet].Cells.Find(FCellNo);        end;      end;
      //填充当前主表的子表内容
      DetailDS.Filtered := true;      DetailDS.Filter := ‘Batch_Name = ‘‘‘ +      HeadDS.FieldByName(‘Batch_Name‘).AsString + ‘‘‘‘;
      DetailDS.First;      iDTLRecord := 0;
      // 处理明细表      while Not DetailDS.Eof do      begin        iDTLRecord := iDTLRecord + 1;
        if bSpecial then        begin          if iDTLRecord mod 4 = 0 then inc(iTabSheet);        end;
        for iDTLField := 0 to DetailDS.FieldCount - 1  do        begin          FCellNo := DetailDS.Fields[iDTLField].FieldName + ‘_D_‘+IntToStr(iHDRRecord)+‘_‘+IntToStr(iDTLRecord);
          FCellRange := FExcelApp.WorkSheets[iTabSheet].Cells.Find(FCellNo);          While not VarIsClear(FCellRange) do          begin            FCellRange.Value := DetailDS.Fields[iDTLField].AsString;            FCellRange := FExcelApp.WorkSheets[iTabSheet].Cells.Find(FCellNo);          end;        end;        DetailDS.Next;      end;               HeadDS.Next;    end;      DetailDS.Filtered := False;
  except    on e:Exception do    begin      FExcelApp.Quit;      FExcelApp := Unassigned;      Application.Messagebox(Pchar(‘定位资料到Excel出现错误!‘+e.Message),                      Pchar(‘提示‘),Mb_IconInforMation+MB_OK);      exit;                    end;  end;  
  Result := True;
end;
// 获取 格式名称 & 打印份数function TNewLabdipQuery.GetSampleCardInfo(vcustomer, vShape: string; iType:Byte): Variant;var  j: integer;  strSQL,strCondition :string;  minShape, MaxShape: string;begin
  if iType=0 then    Result := ‘‘  else    Result := 1;      minShape := LeftStr(vShape, 1);  j := 1;                                      // 默认1个Shape
  // 同一客户正常只有2种格式,要么1个Shape,要么大于1的Shape  strCondition := ‘AND shape=:shape ‘;    // 多少个Shape A-C  if Pos(‘-‘, vShape) > 0 then  begin    MaxShape := RightStr(vShape, 1);    j := Ord(MaxShape[1]) - ord(minShape[1]) + 1;  end;
  if j > 1 then    strCondition := ‘AND shape>:shape ‘;
  strSQL := ‘SELECT TOP 1 FormatName, PrintCopies FROM dbo.LabDipSampleCardFormat ‘ +            ‘WHERE customer=:customer ‘ +            strCondition;
  with ADOQuery do  begin    close;    SQL.Clear;    SQL.Add(strSQL);    Parameters.ParamByName(‘customer‘).Value := vcustomer;//    Parameters.ParamByName(‘shape‘).Value := j;    Parameters.ParamByName(‘shape‘).Value := 1;    try      Active := True;      if IsEmpty or Eof then      begin        Application.Messagebox(Pchar(‘系统不存在此格式,验证错误!‘),                        Pchar(‘提示‘),MB_ICONWARNING+MB_OK);        exit;      end;
    except      on e:exception do      begin        Application.Messagebox(Pchar(‘打开[送样格式表]出现错误!‘+e.Message),                        Pchar(‘提示‘),MB_ICONWARNING+MB_OK);        exit;                      end;    end;  end;
  if iType=0 then    Result := ADOQuery.fieldbyname(‘FormatName‘).Value  else    Result := ADOQuery.fieldbyname(‘PrintCopies‘).Value;
end;
// Added StatusBar Infoprocedure TNewLabdipQuery.AddSampleCardInfoToSB(vInfo: string);begin  SB1.SimpleText := ‘ ‘ + vInfo;  SB1.Refresh;end;
procedure TNewLabdipQuery.N3Click(Sender: TObject);begin   with asp_GetNewcolorCode do   begin      close;      //Parameters.ParamByName(‘@CondStr‘).Value :=‘b.Complete_Date is Null and a.cancel_date is null and a.Dip_Mode in (‘‘新样‘‘,‘‘重打‘‘,‘‘试样‘‘,‘‘复板‘‘,‘‘公用色号‘‘) and Restore_Time is Null ‘;      //Parameters.ParamByName(‘@CondStr‘).Value :=‘a.color_code=‘‘11220GNFD01‘‘ or a.color_code=‘‘13044BLFD01‘‘ AND b.Complete_Date is Null and a.cancel_date is null and a.Dip_Mode in (‘‘新样‘‘,‘‘重打‘‘,‘‘试样‘‘,‘‘复板‘‘,‘‘公用色号‘‘) and Restore_Time is Null ‘;      Parameters.ParamByName(‘@CondStr‘).Value :=‘a.color_code=‘‘13044BLFD01‘‘ AND b.Complete_Date is Null and a.cancel_date is null and a.Dip_Mode in (‘‘新样‘‘,‘‘重打‘‘,‘‘试样‘‘,‘‘复板‘‘,‘‘公用色号‘‘) and Restore_Time is Null ‘;      Open;   end;   asp_GetNewColorCode.Filter:=‘‘;   asp_GetNewcolorCode.Filtered:=false;end;
// 使 cxGrid 的过滤与数据集同步procedure TNewLabdipQuery.cxGrid1DBTableView1DataControllerFilterBeforeChange(  Sender: TcxDBDataFilterCriteria; ADataSet: TDataSet;  const AFilterText: String);begin  asp_GetNewcolorCode.Filtered:=false;  asp_GetNewcolorCode.Filter:=AFilterText;  end;
procedure TNewLabdipQuery.cxGrid1DBTableView1DataControllerFilterChanged(  Sender: TObject);begin  asp_GetNewcolorCode.Filtered:=true;end;
// 释放 Excell App 元件procedure TNewLabdipQuery.FreeExcelApp;begin  if not VarIsEmpty(FExcelApp) then  begin    FExcelApp.Quit;    FExcelApp := Unassigned;  end;end;
// 读取 Ini 文件中的模板路径function TNewLabdipQuery.ReadTemplatePath(vIniName, vSection, vIden,vdefValue: string): string;var  iniFile:Tinifile;  strIniFile: string;  iHandle:Integer;  bReset:Boolean;begin
  Result := vdefValue;  bReset := false;    strIniFile := ExtractFilePath(Application.ExeName) + vIniName + ‘.ini‘;
  if not FileExists(strIniFile) then  begin    iHandle := FileCreate(strIniFile);    bReset := true;    FileClose(iHandle);  end;    try    iniFile := Tinifile.Create(strIniFile);    if bReset then    begin      // Writed some Parameters       // iniFile.WriteString(vSection, vIden, vdefValue)      inifile.WriteString(‘LabDip‘, ‘TemplatePath‘, g_strDefaultPath);      inifile.WriteString(‘LabDip‘, ‘SpecialFile‘,  g_strSpecialFile);    end    else      Result := iniFile.ReadString(vSection, vIden, vdefValue);  finally    iniFile.Free;  end;         
//  ShowMessage(Result);
end;
// Copies DataSetprocedure TNewLabdipQuery.CopyDataSet(SourceDS:TADOQuery; DestDS: TADODataSet;iMode:Byte);var  i:Integer;begin  if not DestDS.Active then DestDS.Active := true;  if iMode=0 then  begin    SourceDS.First;    while not SourceDS.Eof do    begin      DestDS.Append;      for i:=0 to SourceDS.FieldCount-2 do      begin        DestDS.Fields[i].Value := SourceDS.Fields[i].Value;      end;      SourceDS.Next;    end;  end  else  begin    DestDS.Recordset := SourceDS.Recordset;  end;  exit;end;
//打开数据集function TNewLabdipQuery.OpenDataSet(adoqry:TADOQuery; strSQL:string; i:byte; bHits:Boolean=true):Boolean;begin  Result := false;  adoqry.Close;  adoqry.SQL.Clear;  adoqry.SQL.Add(strSQL);   try    adoqry.Open;      except    on e:Exception do    begin      Application.Messagebox(Pchar(‘打开数据集出现错误!‘+e.Message),                      Pchar(‘提示‘),MB_ICONWARNING+MB_OK);      exit;    end;  end;
  // 是否提示   if bHits then  begin    if adoqry.Eof then    begin    if i=0 then      ShowMessage(‘色号不存在!‘)    else       ShowMessage(‘颜色信息不存在!‘);    end;    end;  Result := true;end;
procedure TNewLabdipQuery.MARKSPENCERUK1Click(Sender: TObject);begin   with asp_GetNewcolorCode do   begin      close;(*14342BLFM0214381BLFD0212163GNFM014930BRFD01*)      Parameters.ParamByName(‘@CondStr‘).Value :=‘a.color_code=‘‘5545NYFD01‘‘ AND b.Complete_Date is Null and a.cancel_date is null and a.Dip_Mode in (‘‘新样‘‘,‘‘重打‘‘,‘‘试样‘‘,‘‘复板‘‘,‘‘公用色号‘‘) and Restore_Time is Null ‘;      Open;   end;   asp_GetNewColorCode.Filter:=‘‘;   asp_GetNewcolorCode.Filtered:=false;end;

本文出自 “畅想天空” 博客,请务必保留此出处http://kinwar.blog.51cto.com/3723399/1622437

分享Delphi处理EXCEL源码

标签:pictures   excel   

原文地址:http://kinwar.blog.51cto.com/3723399/1622437

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!