306 lines
7.4 KiB
ObjectPascal
306 lines
7.4 KiB
ObjectPascal
unit U_ReportImgSet1;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
|
||
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
|
||
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
|
||
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
|
||
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
|
||
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
|
||
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
|
||
RM_Preview, RM_Dataset, RM_Class, RM_GridReport, RM_e_Graphic, RM_e_Jpeg;
|
||
|
||
type
|
||
TfrmReportImgSet1 = class(TfrmBaseHelp)
|
||
ToolBar1: TToolBar;
|
||
ADO_1: TADOQuery;
|
||
ADOQueryTemp: TADOQuery;
|
||
ADOQueryCmd: TADOQuery;
|
||
TBSave: TToolButton;
|
||
TBClose: TToolButton;
|
||
ToolButton1: TToolButton;
|
||
ADOConnection1: TADOConnection;
|
||
ImageList1: TImageList;
|
||
ThreeColorBase: TcxStyleRepository;
|
||
SHuangSe: TcxStyle;
|
||
SkyBlue: TcxStyle;
|
||
Default: TcxStyle;
|
||
QHuangSe: TcxStyle;
|
||
Red: TcxStyle;
|
||
FontBlue: TcxStyle;
|
||
TextSHuangSe: TcxStyle;
|
||
FonePurple: TcxStyle;
|
||
FoneClMaroon: TcxStyle;
|
||
FoneRed: TcxStyle;
|
||
RowColor: TcxStyle;
|
||
handBlack: TcxStyle;
|
||
cxBlue: TcxStyle;
|
||
SHuangSeCu: TcxStyle;
|
||
RMPreview1: TRMPreview;
|
||
RMLabel: TRMGridReport;
|
||
RMDB_Label: TRMDBDataSet;
|
||
ADOQueryLabel: TADOQuery;
|
||
RMJPEGExport1: TRMJPEGExport;
|
||
procedure FormCreate(Sender: TObject);
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
procedure FormShow(Sender: TObject);
|
||
procedure ToolButton1Click(Sender: TObject);
|
||
procedure FormDestroy(Sender: TObject);
|
||
procedure TV1DblClick(Sender: TObject);
|
||
procedure TBCloseClick(Sender: TObject);
|
||
procedure TBSaveClick(Sender: TObject);
|
||
private
|
||
FFilePath, FFileName: string;
|
||
procedure DownloadLabel();
|
||
procedure InitLabel();
|
||
function SaveData(): Boolean;
|
||
{ Private declarations }
|
||
public
|
||
FDataID, FLabelName: string;
|
||
{ Public declarations }
|
||
end;
|
||
|
||
var
|
||
frmReportImgSet1: TfrmReportImgSet1;
|
||
|
||
implementation
|
||
|
||
uses
|
||
U_DataLink, U_RTFun;
|
||
|
||
{$R *.dfm}
|
||
|
||
function TfrmReportImgSet1.SaveData(): Boolean;
|
||
var
|
||
MaxId, FImagePath1, FImagePath2: string;
|
||
FJStream: TMemoryStream;
|
||
begin
|
||
|
||
with RMLabel do
|
||
begin
|
||
// LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('Files')));
|
||
FImagePath1 := ExtractFilePath(Application.ExeName) + 'image\label0001.jpg';
|
||
if FileExists(FImagePath1) then
|
||
DeleteFile(FImagePath1);
|
||
|
||
FImagePath2 := ExtractFilePath(Application.ExeName) + 'image\label.jpg';
|
||
PrepareReport;
|
||
ExportTo(RMjpegExport1, FImagePath2);
|
||
end;
|
||
|
||
try
|
||
FJStream := TMemoryStream.Create;
|
||
|
||
FJStream.LoadFromFile(FImagePath1);
|
||
|
||
ADOQueryCmd.Connection.BeginTrans;
|
||
if Trim(FDataID) = '' then
|
||
begin
|
||
if GetLSNo(ADOQueryCmd, MaxId, 'R', 'BS_Img_Label', 4, 1) = False then
|
||
begin
|
||
raise Exception.Create('ȡ<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>!');
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
MaxId := Trim(FDataID);
|
||
end;
|
||
|
||
with ADOQueryCmd do
|
||
begin
|
||
Close;
|
||
SQL.Clear;
|
||
sql.Add('select * from BS_Img_Label where LabelId=''' + Trim(FDataID) + '''');
|
||
Open;
|
||
end;
|
||
|
||
with ADOQueryCmd do
|
||
begin
|
||
if Trim(FDataID) = '' then
|
||
begin
|
||
Append;
|
||
FieldByName('Filler').Value := Trim(DName);
|
||
end
|
||
else
|
||
begin
|
||
Edit;
|
||
FieldByName('Editer').Value := Trim(DName);
|
||
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
|
||
end;
|
||
FieldByName('LabelId').Value := Trim(MaxId);
|
||
FieldByName('DataID').Value := Trim(FDataID);
|
||
tblobfield(FieldByName('LabelFile')).LoadFromFile(FFilePath);
|
||
tblobfield(FieldByName('ImgFile')).LoadFromStream(FJStream);
|
||
Post;
|
||
end;
|
||
ADOQueryCmd.Connection.CommitTrans;
|
||
FJStream.Free;
|
||
Result := True;
|
||
except
|
||
Result := false;
|
||
FJStream.Free;
|
||
ADOQueryCmd.Connection.RollbackTrans;
|
||
application.MessageBox(PChar(Exception(ExceptObject).Message), '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.DownloadLabel();
|
||
var
|
||
ff: TADOBlobstream;
|
||
Stream: TMemoryStream;
|
||
begin
|
||
|
||
if FileExists(FFilePath) then
|
||
begin
|
||
DeleteFile(FFilePath);
|
||
end;
|
||
|
||
with ADOQueryLabel do
|
||
begin
|
||
close;
|
||
sql.Clear;
|
||
sql.Add(' select * from BS_Img_Label ');
|
||
sql.Add(' where DataId= ' + quotedstr(FDataId));
|
||
Open;
|
||
end;
|
||
if not ADOQueryLabel.IsEmpty then
|
||
begin
|
||
ff := TADOBlobstream.create(ADOQueryLabel.fieldByName('LabelFile') as TblobField, bmRead);
|
||
|
||
if ff <> nil then
|
||
begin
|
||
try
|
||
|
||
Stream := TMemoryStream.create;
|
||
ff.SaveToStream(Stream);
|
||
Stream.SaveToFile(FFilePath);
|
||
finally
|
||
Stream.Free;
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.InitLabel();
|
||
begin
|
||
with RMLabel do
|
||
begin
|
||
Clear;
|
||
LoadFromFile(FFilePath);
|
||
Preview := RMPreview1;
|
||
ShowReport;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.FormCreate(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
try
|
||
with ADOConnection1 do
|
||
begin
|
||
Connected := false;
|
||
ConnectionString := DConString;
|
||
Connected := true;
|
||
end;
|
||
ADOQueryBaseCmd.Connection := ADOConnection1;
|
||
ADOQueryBaseTemp.Connection := ADOConnection1;
|
||
except
|
||
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ');
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
|
||
Action := cafree;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.FormShow(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
self.Caption := FLabelName;
|
||
with ADO_1 do
|
||
begin
|
||
close;
|
||
sql.Clear;
|
||
sql.Add(' select x=1');
|
||
Open;
|
||
end;
|
||
FFilePath := ExtractFilePath(Application.ExeName) + 'report\' + trim(FDataID) + '.rmf';
|
||
FFileName := trim(FDataID) + '.rmf';
|
||
|
||
if not FileExists(FFilePath) then
|
||
begin
|
||
ExportFtErpFile(FLabelName + '.rmf', ADOQueryTemp);
|
||
CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\' + FLabelName + '.rmf'), PChar(FFilePath), False);
|
||
end;
|
||
|
||
DownloadLabel();
|
||
Initlabel();
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.TBCloseClick(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
Close;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.TBSaveClick(Sender: TObject);
|
||
begin
|
||
if SaveData() then
|
||
begin
|
||
ModalResult := 1;
|
||
end
|
||
else
|
||
begin
|
||
Application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>!', '<27><>ʾ', 0);
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.ToolButton1Click(Sender: TObject);
|
||
begin
|
||
|
||
|
||
//
|
||
// MLabelID := TRIM(CDS_Label.fieldByName('LabelID').asString);
|
||
// MLabelCaption := TRIM(CDS_Label.fieldByName('LabelCaption').asString);
|
||
// ExportFtErpFile(MLabelCaption + '.rmf', ADOQueryTemp);
|
||
// fPrintFile := ExtractFilePath(Application.ExeName) + 'report\' + MLabelCaption + '.rmf';
|
||
//
|
||
// if not FileExists(fPrintFile) then
|
||
// CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\ģ<><C4A3><EFBFBD><EFBFBD>ǩ.rmf'), PChar(fPrintFile), False);
|
||
|
||
with RMLabel do
|
||
begin
|
||
RMLabel.Clear;
|
||
RMDB_Label.DataSet := nil;
|
||
Dictionary.FieldAliases.Clear;
|
||
Dictionary.FieldAliases['RMDB_Label'] := '<27><>ǩ<EFBFBD><C7A9><EFBFBD><EFBFBD>';
|
||
// RMDB_Label.DataSet := ADO_1;
|
||
LoadFromFile(FFilePath);
|
||
application.ProcessMessages;
|
||
DesignReport();
|
||
end;
|
||
InitLabel();
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.TV1DblClick(Sender: TObject);
|
||
begin
|
||
ModalResult := 1;
|
||
end;
|
||
|
||
procedure TfrmReportImgSet1.FormDestroy(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
frmReportImgSet1 := nil;
|
||
end;
|
||
|
||
end.
|
||
|