分享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 Debug
begin
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 Info
procedure 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 DataSet
procedure 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;
(*
14342BLFM02
14381BLFD02
12163GNFM01
4930BRFD01
*)
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/1622433
原文地址：http://kinwar.blog.51cto.com/3723399/1622433
