RTFormwork/项目代码/RTBasicsV1/A00通用窗体/U_ReportImgSet.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

302 lines
7.1 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_ReportImgSet;
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,
RM_BarCode, RM_Designer, RM_DsgGridReport;
type
TfrmReportImgSet = 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;
RMDB_Label: TRMDBDataSet;
ADOQueryLabel: TADOQuery;
RMJPEGExport1: TRMJPEGExport;
RMLabel: TRMGridReport;
RMBarCodeObject1: TRMBarCodeObject;
RMReport1: TRMReport;
RMGridReportDesigner1: TRMGridReportDesigner;
RMDesigner1: TRMDesigner;
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
frmReportImgSet: TfrmReportImgSet;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
function TfrmReportImgSet.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 TfrmReportImgSet.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 TfrmReportImgSet.InitLabel();
begin
with RMLabel do
begin
Clear;
LoadFromFile(FFilePath);
Preview := RMPreview1;
ShowReport;
end;
end;
procedure TfrmReportImgSet.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 TfrmReportImgSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmReportImgSet.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 TfrmReportImgSet.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmReportImgSet.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 TfrmReportImgSet.ToolButton1Click(Sender: TObject);
begin
// with RMLabel do
// begin
// 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;
// RMLabel.DesignReport();
// end;
RMLabel.DesignReport();
InitLabel();
end;
procedure TfrmReportImgSet.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmReportImgSet.FormDestroy(Sender: TObject);
begin
inherited;
frmReportImgSet := nil;
end;
end.