分享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;