www.pudn.com > Fr3ReportDLL.rar > JLKReportImpl.pas
unit JLKReportImpl;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows,
ActiveX,
Classes,
Controls,
Graphics,
Menus,
Forms,
StdCtrls,
ComServ,
StdVCL,
AXCtrls,
JLKReportControl_TLB,
SysUtils,
ExtCtrls,
ADODB,
DB,
Dialogs,
JLKProcedureUnit,
ComObj,
ADOInt;
type
TJLKReport = class(TActiveXControl, IJLKReport, IUnknown)
private
{ Private declarations }
FDelphiControl: TPanel;
FEvents: IJLKReportEvents;
bConnObj: _Connection;
procedure CanResizeEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
var Resize: Boolean);
procedure ClickEvent(Sender: TObject);
procedure ConstrainedResizeEvent(Sender: TObject; var MinWidth, MinHeight,
MaxWidth, MaxHeight: Integer);
procedure DblClickEvent(Sender: TObject);
procedure ResizeEvent(Sender: TObject);
protected
{ Protected declarations }
procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure InitializeControl; override;
function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
function Get_AlignDisabled: WordBool; safecall;
function Get_Alignment: TxAlignment; safecall;
function Get_AutoSize: WordBool; safecall;
function Get_BevelInner: TxBevelCut; safecall;
function Get_BevelOuter: TxBevelCut; safecall;
function Get_BorderStyle: TxBorderStyle; safecall;
function Get_Caption: WideString; safecall;
function Get_Color: OLE_COLOR; safecall;
function Get_Ctl3D: WordBool; safecall;
function Get_Cursor: Smallint; safecall;
function Get_DockSite: WordBool; safecall;
function Get_DoubleBuffered: WordBool; safecall;
function Get_DragCursor: Smallint; safecall;
function Get_DragMode: TxDragMode; safecall;
function Get_Enabled: WordBool; safecall;
function Get_Font: IFontDisp; safecall;
function Get_FullRepaint: WordBool; safecall;
function Get_HelpKeyword: WideString; safecall;
function Get_HelpType: TxHelpType; safecall;
function Get_Locked: WordBool; safecall;
function Get_ParentColor: WordBool; safecall;
function Get_ParentCtl3D: WordBool; safecall;
function Get_UseDockManager: WordBool; safecall;
function Get_Visible: WordBool; safecall;
function Get_VisibleDockClientCount: Integer; safecall;
function IsRightToLeft: WordBool; safecall;
function UseRightToLeftReading: WordBool; safecall;
function UseRightToLeftScrollBar: WordBool; safecall;
procedure _Set_Font(var Value: IFontDisp); safecall;
procedure InitiateAction; safecall;
procedure Set_Alignment(Value: TxAlignment); safecall;
procedure Set_AutoSize(Value: WordBool); safecall;
procedure Set_BevelInner(Value: TxBevelCut); safecall;
procedure Set_BevelOuter(Value: TxBevelCut); safecall;
procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
procedure Set_Caption(const Value: WideString); safecall;
procedure Set_Color(Value: OLE_COLOR); safecall;
procedure Set_Ctl3D(Value: WordBool); safecall;
procedure Set_Cursor(Value: Smallint); safecall;
procedure Set_DockSite(Value: WordBool); safecall;
procedure Set_DoubleBuffered(Value: WordBool); safecall;
procedure Set_DragCursor(Value: Smallint); safecall;
procedure Set_DragMode(Value: TxDragMode); safecall;
procedure Set_Enabled(Value: WordBool); safecall;
procedure Set_Font(const Value: IFontDisp); safecall;
procedure Set_FullRepaint(Value: WordBool); safecall;
procedure Set_HelpKeyword(const Value: WideString); safecall;
procedure Set_HelpType(Value: TxHelpType); safecall;
procedure Set_Locked(Value: WordBool); safecall;
procedure Set_ParentColor(Value: WordBool); safecall;
procedure Set_ParentCtl3D(Value: WordBool); safecall;
procedure Set_UseDockManager(Value: WordBool); safecall;
procedure Set_Visible(Value: WordBool); safecall;
procedure SetSubComponent(IsSubComponent: WordBool); safecall;
procedure AddConnectionStr(const ConnectionStr: WideString); safecall;
procedure AddSqlCommand(const CommandSQL: WideString); safecall;
procedure ClearAllSqlCommand; safecall;
procedure CloseADOConnect; safecall;
procedure DesignReport(const ReportPath: WideString); safecall;
procedure FreeReport; safecall;
procedure PrintReport(const ReportPath: WideString); safecall;
procedure ExportRTF(const ReportPath, FileName: WideString); safecall;
procedure SetMainADOQ(CurIndex: Integer); safecall;
procedure DownLoadReportFile(const SqlCommandStr, FiledName,
FileAllPath: WideString); safecall;
procedure UpLoadReportFile(const TableName, WhereStr, FileAllPath,
FiledName, FiledNameList, ValuesList: WideString); safecall;
procedure OpenADOQ(var TempADOQ: TADOQuery; const CommandSQL: WideString);
procedure CloseADOQ(var TempADOQ: TADOQuery);
procedure DesignReportNOConnect(const ReportPath: WideString); safecall;
procedure InitialNoConnect; safecall;
procedure AddParameterName(ProcedureNameIndex: Integer;
const ParameterName: WideString); safecall;
procedure AddParameterValue(ProcedureNameIndex: Integer;
const AddParameterValue: WideString; AddParameterIndex: Integer);
safecall;
procedure AddProcedureName(ProcedureNameIndex: Integer;
const ProcedureName: WideString); safecall;
procedure ExecProc(ProcedureNameIndex: Integer); safecall;
procedure CloseProc; safecall;
procedure AddParameterNameValue(ProcedureNameIndex: Integer;
const AddParameterName, AddParameterValue: WideString); safecall;
procedure ExportXLS(const ReportPath, FileName: WideString); safecall;
procedure ExportXML(const ReportPath, FileName: WideString); safecall;
procedure ExportPDF(const ReportPath, FileName: WideString); safecall;
procedure ExportBMP(const ReportPath, FileName: WideString); safecall;
procedure PrintReportEx(const ReportPath: WideString; bPrintView,
bShowDialog: SYSINT); safecall;
procedure ExportHTML(const ReportPath, FileName: WideString); safecall;
procedure ExportJPEG(const ReportPath, FileName: WideString); safecall;
procedure ExportTIFF(const ReportPath, FileName: WideString); safecall;
procedure ExportTXT(const ReportPath, FileName: WideString); safecall;
procedure ExportFile(const ReportPath, FileName, FileType: WideString;
bExportSet: SYSINT); safecall;
function Get_xlsExportStyles: WordBool; safecall;
procedure Set_xlsExportStyles(Value: WordBool); safecall;
function Get_xlsExportPictures: WordBool; safecall;
function Get_xlsMergeCells: WordBool; safecall;
function Get_xlsWysiwyg: WordBool; safecall;
procedure Set_xlsExportPictures(Value: WordBool); safecall;
procedure Set_xlsMergeCells(Value: WordBool); safecall;
procedure Set_xlsWysiwyg(Value: WordBool); safecall;
function Get_ReportName: WideString; safecall;
procedure Set_ReportName(const Value: WideString); safecall;
function Get_xmlExportStyles: WordBool; safecall;
procedure Set_xmlExportStyles(Value: WordBool); safecall;
function Get_xlsOpenExcelAfterExport: WordBool; safecall;
function Get_xlsShowDialog: WordBool; safecall;
function Get_xlsShowProgress: WordBool; safecall;
function Get_xmlExportPageBreaks: WordBool; safecall;
function Get_xmlOpenExcelAfterExport: WordBool; safecall;
function Get_xmlShowDialog: WordBool; safecall;
function Get_xmlShowProgress: WordBool; safecall;
function Get_xmlWysiwyg: WordBool; safecall;
procedure Set_xlsOpenExcelAfterExport(Value: WordBool); safecall;
procedure Set_xlsShowDialog(Value: WordBool); safecall;
procedure Set_xlsShowProgress(Value: WordBool); safecall;
procedure Set_xmlExportPageBreaks(Value: WordBool); safecall;
procedure Set_xmlOpenExcelAfterExport(Value: WordBool); safecall;
procedure Set_xmlShowDialog(Value: WordBool); safecall;
procedure Set_xmlShowProgress(Value: WordBool); safecall;
procedure Set_xmlWysiwyg(Value: WordBool); safecall;
function Get_PrintOptionCollate: WordBool; safecall;
function Get_PrintOptionCopies: Integer; safecall;
function Get_PrintOptionPageNumbers: WideString; safecall;
function Get_PrintOptionPrinter: WideString; safecall;
function Get_PrintOptionShowDialog: WordBool; safecall;
procedure Set_PrintOptionCollate(Value: WordBool); safecall;
procedure Set_PrintOptionCopies(Value: Integer); safecall;
procedure Set_PrintOptionPageNumbers(const Value: WideString); safecall;
procedure Set_PrintOptionPrinter(const Value: WideString); safecall;
procedure Set_PrintOptionShowDialog(Value: WordBool); safecall;
procedure AddRecordset(vRecordset: OleVariant); safecall;
procedure ClearAllRecordset; safecall;
function Get_ConnectionObj: OleVariant; safecall;
procedure Set_ConnectionObj(Value: OleVariant); safecall;
function Get_RSCName: WideString; safecall;
procedure Set_RSCName(const Value: WideString); safecall;
{ TODO: Change all instances of type [IReportPanelX307Events] to [IJLKReportEvents].}
end;
var
ConIsOK : Boolean;
NoConIsOK : Boolean;
CurSQLNum : Integer;
DatasetNum : Integer;
implementation
uses UnitMain;
{ TJLKReport }
procedure TJLKReport.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
end;
procedure TJLKReport.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IJLKReportEvents;
end;
procedure TJLKReport.InitializeControl;
begin
FDelphiControl := Control as TPanel;
FDelphiControl.OnCanResize := CanResizeEvent;
FDelphiControl.OnClick := ClickEvent;
FDelphiControl.OnConstrainedResize := ConstrainedResizeEvent;
FDelphiControl.OnDblClick := DblClickEvent;
FDelphiControl.OnResize := ResizeEvent;
if not Assigned(FrmMain) then
FrmMain := TFrmMain.Create(nil);
FrmMain.Width := 0;
FrmMain.Height := 0;
end;
function TJLKReport.DrawTextBiDiModeFlagsReadingOnly: Integer;
begin
Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
end;
function TJLKReport.Get_AlignDisabled: WordBool;
begin
Result := FDelphiControl.AlignDisabled;
end;
function TJLKReport.Get_Alignment: TxAlignment;
begin
Result := Ord(FDelphiControl.Alignment);
end;
function TJLKReport.Get_AutoSize: WordBool;
begin
Result := FDelphiControl.AutoSize;
end;
function TJLKReport.Get_BevelInner: TxBevelCut;
begin
Result := Ord(FDelphiControl.BevelInner);
end;
function TJLKReport.Get_BevelOuter: TxBevelCut;
begin
Result := Ord(FDelphiControl.BevelOuter);
end;
function TJLKReport.Get_BorderStyle: TxBorderStyle;
begin
Result := Ord(FDelphiControl.BorderStyle);
end;
function TJLKReport.Get_Caption: WideString;
begin
Result := WideString(FDelphiControl.Caption);
end;
function TJLKReport.Get_Color: OLE_COLOR;
begin
Result := OLE_COLOR(FDelphiControl.Color);
end;
function TJLKReport.Get_Ctl3D: WordBool;
begin
Result := FDelphiControl.Ctl3D;
end;
function TJLKReport.Get_Cursor: Smallint;
begin
Result := Smallint(FDelphiControl.Cursor);
end;
function TJLKReport.Get_DockSite: WordBool;
begin
Result := FDelphiControl.DockSite;
end;
function TJLKReport.Get_DoubleBuffered: WordBool;
begin
Result := FDelphiControl.DoubleBuffered;
end;
function TJLKReport.Get_DragCursor: Smallint;
begin
Result := Smallint(FDelphiControl.DragCursor);
end;
function TJLKReport.Get_DragMode: TxDragMode;
begin
Result := Ord(FDelphiControl.DragMode);
end;
function TJLKReport.Get_Enabled: WordBool;
begin
Result := FDelphiControl.Enabled;
end;
function TJLKReport.Get_Font: IFontDisp;
begin
GetOleFont(FDelphiControl.Font, Result);
end;
function TJLKReport.Get_FullRepaint: WordBool;
begin
Result := FDelphiControl.FullRepaint;
end;
function TJLKReport.Get_HelpKeyword: WideString;
begin
Result := WideString(FDelphiControl.HelpKeyword);
end;
function TJLKReport.Get_HelpType: TxHelpType;
begin
Result := Ord(FDelphiControl.HelpType);
end;
function TJLKReport.Get_Locked: WordBool;
begin
Result := FDelphiControl.Locked;
end;
function TJLKReport.Get_ParentColor: WordBool;
begin
Result := FDelphiControl.ParentColor;
end;
function TJLKReport.Get_ParentCtl3D: WordBool;
begin
Result := FDelphiControl.ParentCtl3D;
end;
function TJLKReport.Get_UseDockManager: WordBool;
begin
Result := FDelphiControl.UseDockManager;
end;
function TJLKReport.Get_Visible: WordBool;
begin
Result := FDelphiControl.Visible;
end;
function TJLKReport.Get_VisibleDockClientCount: Integer;
begin
Result := FDelphiControl.VisibleDockClientCount;
end;
function TJLKReport.IsRightToLeft: WordBool;
begin
Result := FDelphiControl.IsRightToLeft;
end;
function TJLKReport.UseRightToLeftReading: WordBool;
begin
Result := FDelphiControl.UseRightToLeftReading;
end;
function TJLKReport.UseRightToLeftScrollBar: WordBool;
begin
Result := FDelphiControl.UseRightToLeftScrollBar;
end;
procedure TJLKReport._Set_Font(var Value: IFontDisp);
begin
SetOleFont(FDelphiControl.Font, Value);
end;
procedure TJLKReport.CanResizeEvent(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
TempNewWidth : Integer;
TempNewHeight : Integer;
TempResize : WordBool;
begin
TempNewWidth := Integer(NewWidth);
TempNewHeight := Integer(NewHeight);
TempResize := WordBool(Resize);
if FEvents <> nil then
FEvents.OnCanResize(TempNewWidth, TempNewHeight, TempResize);
NewWidth := Integer(TempNewWidth);
NewHeight := Integer(TempNewHeight);
Resize := Boolean(TempResize);
end;
procedure TJLKReport.ClickEvent(Sender: TObject);
begin
if FEvents <> nil then
FEvents.OnClick;
end;
procedure TJLKReport.ConstrainedResizeEvent(Sender: TObject;
var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
var
TempMinWidth : Integer;
TempMinHeight : Integer;
TempMaxWidth : Integer;
TempMaxHeight : Integer;
begin
TempMinWidth := Integer(MinWidth);
TempMinHeight := Integer(MinHeight);
TempMaxWidth := Integer(MaxWidth);
TempMaxHeight := Integer(MaxHeight);
if FEvents <> nil then
FEvents.OnConstrainedResize(TempMinWidth, TempMinHeight, TempMaxWidth, TempMaxHeight);
MinWidth := Integer(TempMinWidth);
MinHeight := Integer(TempMinHeight);
MaxWidth := Integer(TempMaxWidth);
MaxHeight := Integer(TempMaxHeight);
end;
procedure TJLKReport.DblClickEvent(Sender: TObject);
begin
if FEvents <> nil then
FEvents.OnDblClick;
end;
procedure TJLKReport.InitiateAction;
begin
FDelphiControl.InitiateAction;
end;
procedure TJLKReport.ResizeEvent(Sender: TObject);
begin
if FEvents <> nil then
FEvents.OnResize;
end;
procedure TJLKReport.Set_Alignment(Value: TxAlignment);
begin
FDelphiControl.Alignment := TAlignment(Value);
end;
procedure TJLKReport.Set_AutoSize(Value: WordBool);
begin
FDelphiControl.AutoSize := Value;
end;
procedure TJLKReport.Set_BevelInner(Value: TxBevelCut);
begin
FDelphiControl.BevelInner := TBevelCut(Value);
end;
procedure TJLKReport.Set_BevelOuter(Value: TxBevelCut);
begin
FDelphiControl.BevelOuter := TBevelCut(Value);
end;
procedure TJLKReport.Set_BorderStyle(Value: TxBorderStyle);
begin
FDelphiControl.BorderStyle := TBorderStyle(Value);
end;
procedure TJLKReport.Set_Caption(const Value: WideString);
begin
FDelphiControl.Caption := TCaption(Value);
end;
procedure TJLKReport.Set_Color(Value: OLE_COLOR);
begin
FDelphiControl.Color := TColor(Value);
end;
procedure TJLKReport.Set_Ctl3D(Value: WordBool);
begin
FDelphiControl.Ctl3D := Value;
end;
procedure TJLKReport.Set_Cursor(Value: Smallint);
begin
FDelphiControl.Cursor := TCursor(Value);
end;
procedure TJLKReport.Set_DockSite(Value: WordBool);
begin
FDelphiControl.DockSite := Value;
end;
procedure TJLKReport.Set_DoubleBuffered(Value: WordBool);
begin
FDelphiControl.DoubleBuffered := Value;
end;
procedure TJLKReport.Set_DragCursor(Value: Smallint);
begin
FDelphiControl.DragCursor := TCursor(Value);
end;
procedure TJLKReport.Set_DragMode(Value: TxDragMode);
begin
FDelphiControl.DragMode := TDragMode(Value);
end;
procedure TJLKReport.Set_Enabled(Value: WordBool);
begin
FDelphiControl.Enabled := Value;
end;
procedure TJLKReport.Set_Font(const Value: IFontDisp);
begin
SetOleFont(FDelphiControl.Font, Value);
end;
procedure TJLKReport.Set_FullRepaint(Value: WordBool);
begin
FDelphiControl.FullRepaint := Value;
end;
procedure TJLKReport.Set_HelpKeyword(const Value: WideString);
begin
FDelphiControl.HelpKeyword := string(Value);
end;
procedure TJLKReport.Set_HelpType(Value: TxHelpType);
begin
FDelphiControl.HelpType := THelpType(Value);
end;
procedure TJLKReport.Set_Locked(Value: WordBool);
begin
FDelphiControl.Locked := Value;
end;
procedure TJLKReport.Set_ParentColor(Value: WordBool);
begin
FDelphiControl.ParentColor := Value;
end;
procedure TJLKReport.Set_ParentCtl3D(Value: WordBool);
begin
FDelphiControl.ParentCtl3D := Value;
end;
procedure TJLKReport.Set_UseDockManager(Value: WordBool);
begin
FDelphiControl.UseDockManager := Value;
end;
procedure TJLKReport.Set_Visible(Value: WordBool);
begin
FDelphiControl.Visible := Value;
end;
procedure TJLKReport.SetSubComponent(IsSubComponent: WordBool);
begin
FDelphiControl.SetSubComponent(IsSubComponent);
end;
procedure TJLKReport.OpenADOQ(var TempADOQ: TADOQuery; const CommandSQL: WideString);
begin
try
if not ConIsOK then
exit;
TempADOQ.Close;
TempADOQ.SQL.Clear;
TempADOQ.SQL.Text := CommandSQL;
TempADOQ.Open;
TempADOQ.First;
FDelphiControl.Caption := 'T';
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
end;
end;
end;
procedure TJLKReport.CloseADOQ(var TempADOQ: TADOQuery);
begin
try
if Assigned(TempADOQ) then begin
TempADOQ.Close;
TempADOQ.SQL.Clear;
end;
FDelphiControl.Caption := 'T';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.AddConnectionStr(const ConnectionStr: WideString);
begin
try
ConIsOK := False;
FrmMain.JLKADOConn.ConnectionObject := bConnObj;
FrmMain.JLKADOConn.Connected := False;
FrmMain.JLKADOConn.ConnectionString := ConnectionStr;
FrmMain.JLKADOConn.LoginPrompt := False;
FrmMain.JLKADOConn.Connected := true;
ConIsOK := true;
FDelphiControl.Caption := '连接数据库成功！';
except
on E: Exception do begin
ConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
procedure TJLKReport.AddSqlCommand(const CommandSQL: WideString);
begin
try
if not ConIsOK then
exit;
Inc(CurSQLNum);
if (CurSQLNum > 0) and (CurSQLNum < QueryNum) then begin
FrmMain.frxReport1.DataSets.Clear;
OpenADOQ(FrmMain.JLKADOQ[CurSQLNum], CommandSQL);
FrmMain.frxReport1.DataSets.Add(FrmMain.frxDataSet[CurSQLNum]);
if Trim(FrmMain.vRSCName) <> '' then begin
FrmMain.frxDataSet[CurSQLNum].UserName := FrmMain.vRSCName;
FrmMain.vRSCName := '';
end
else
FrmMain.frxDataSet[CurSQLNum].UserName := '数据集' + IntToStr(CurSQLNum);
end;
FDelphiControl.Caption := '增加数据集成功！';
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
MessageBox(Application.Handle, '未连接至数据库！', '错误', MB_OK + MB_ICONWARNING);
end;
end;
end;
procedure TJLKReport.ClearAllSqlCommand;
var
i : Integer;
begin
try
if not ConIsOK then
exit;
for i := 0 to QueryNum do begin
CloseADOQ(FrmMain.JLKADOQ[i]);
end;
CurSQLNum := 0;
FDelphiControl.Caption := 'T';
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
end;
end
end;
procedure TJLKReport.CloseADOConnect;
begin
try
if Assigned(FrmMain.JLKADOConn) then begin
ConIsOK := False;
FrmMain.JLKADOConn.ConnectionString := '';
FrmMain.JLKADOConn.Connected := False;
FrmMain.Free;
FrmMain := nil;
end;
except
end;
end;
procedure TJLKReport.DesignReport(const ReportPath: WideString);
begin
try
// if not ConIsOK then
// begin
// FDelphiControl.Caption := '没有连接数据库';
// exit;
// end;
if FileExists(ReportPath) then begin
FrmMain.frxReport1.LoadFromFile(ReportPath);
FrmMain.frxReport1.DesignReport;
FDelphiControl.Caption := 'T';
end
else begin
FDelphiControl.Caption := '文件:' + ReportPath + ' 没找到.'
end;
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.FreeReport;
begin
try
if Assigned(FrmMain) then begin
try
FrmMain.Free;
FrmMain := nil;
FDelphiControl.Caption := 'T';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
except
end;
end;
procedure TJLKReport.PrintReport(const ReportPath: WideString);
begin
try
if not ConIsOK then
exit;
if FileExists(ReportPath) then begin
FrmMain.frxReport1.LoadFromFile(ReportPath);
FrmMain.frxReport1.PrintOptions.ShowDialog := true;
FrmMain.frxReport1.ShowReport;
FDelphiControl.Caption := 'T';
end
else begin
FrmMain.frxReport1.FileName := ReportPath;
FrmMain.frxReport1.DesignReport;
FDelphiControl.Caption := '文件:' + ReportPath + ' 没找到.';
end;
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportRTF(const ReportPath,
FileName: WideString);
safecall;
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxRTFExport1.ShowDialog := False;
frxRTFExport1.FileName := FileName;
frxReport1.Export(frxRTFExport1);
frxRTFExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.SetMainADOQ(CurIndex: Integer);
begin
end;
procedure TJLKReport.DownLoadReportFile(const SqlCommandStr,
FiledName, FileAllPath: WideString);
var
TmpAdoQuery : TADOQuery;
begin
//从数据库中下载报表文件
try
if ConIsOK then begin
try
TmpAdoQuery := TADOQuery.Create(nil);
TmpAdoQuery.Connection := FrmMain.JLKADOConn;
with TmpAdoQuery do begin
Close;
SQL.Text := SqlCommandStr;
Open;
if recordcount = 1 then begin
try
TBlobField(FieldByName(FiledName)).SaveToFile(FileAllPath); // .SaveToStream(TempStream);
finally
end;
end;
end; // with
finally
TmpAdoQuery.Close;
TmpAdoQuery.Free;
end;
end; //如果当前连接了数据库的
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.UpLoadReportFile(const TableName, WhereStr,
FileAllPath, FiledName, FiledNameList, ValuesList: WideString);
var
TmpAdoQuery : TADOQuery;
begin
try
if ConIsOK and (FileExists(FileAllPath)) then begin
try
TmpAdoQuery := TADOQuery.Create(nil);
TmpAdoQuery.Connection := FrmMain.JLKADOConn;
with TmpAdoQuery do begin
Close;
SQL.Text := 'Select * From ' + TableName + ' Where ' + WhereStr;
Open;
FDelphiControl.Caption := '选择';
if recordcount = 1 then begin
try
edit;
TBlobField(FieldByName(FiledName)).LoadFromFile(FileAllPath); // .SaveToStream(TempStream);
post;
except
end;
end
else begin
if recordcount = 0 then begin
if (FiledNameList <> '') and (ValuesList <> '') then begin
Close;
SQL.Text := 'Insert Into ' + TableName + '(' + FiledNameList + ') Values (' + ValuesList + ')';
ExecSQL;
Close;
SQL.Text := 'Select * From ' + TableName + ' Where ' + WhereStr;
Open;
if recordcount = 1 then begin
try
edit;
TBlobField(FieldByName(FiledName)).LoadFromFile(FileAllPath); // .SaveToStream(TempStream);
post;
FDelphiControl.Caption := '完毕！';
except
FDelphiControl.Caption := '出错!';
end;
end;
end
else begin
FDelphiControl.Caption := '字段列表或值列表没有初始化';
end;
end
else begin
FDelphiControl.Caption := '多与一条记录';
end;
end;
end; // with
finally
TmpAdoQuery.Close;
TmpAdoQuery.Free;
end;
end
else begin
FDelphiControl.Caption := '没连接';
end; //如果当前连接了数据库的
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.DesignReportNOConnect(
const ReportPath: WideString);
begin
try
if not NoConIsOK then begin
FDelphiControl.Caption := '请先执行:InitialNoConnect';
exit;
end;
if FileExists(ReportPath) then begin
FrmMain.frxReport1.LoadFromFile(ReportPath);
FrmMain.frxReport1.DesignReport;
end
else begin
FrmMain.frxReport1.FileName := ReportPath;
FrmMain.frxReport1.DesignReport;
end;
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.InitialNoConnect;
begin
try
if NoConIsOK then
exit;
Application.CreateForm(TFrmMain, FrmMain);
FrmMain.Show;
FrmMain.Height := 0;
FrmMain.Width := 0;
FrmMain.Visible := False;
NoConIsOK := true;
FDelphiControl.Caption := 'T';
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
//-------------------------------------------------------------------------------
//执行存储过程并返回到存储数据集1-5
//date:2005-04-07
//-------------------------------------------------------------------------------
//添加存储过程参数名称
procedure TJLKReport.AddParameterName(ProcedureNameIndex: Integer;
const ParameterName: WideString);
begin
try
JLKAddParameterName(ProcedureNameIndex, ParameterName);
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
//添加存储过程参数值
procedure TJLKReport.AddParameterValue(ProcedureNameIndex: Integer;
const AddParameterValue: WideString; AddParameterIndex: Integer);
begin
try
JLKAddParameterValue(ProcedureNameIndex, AddParameterValue, AddParameterIndex);
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
//添加存储过程名称
procedure TJLKReport.AddProcedureName(ProcedureNameIndex: Integer;
const ProcedureName: WideString);
begin
try
JLKAddProcedureName(ProcedureNameIndex, ProcedureName);
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
//执行存储过程
procedure TJLKReport.ExecProc(ProcedureNameIndex: Integer);
begin
try
JLKExecProc(ProcedureNameIndex);
FrmMain.frxReport1.DataSets.Clear;
FrmMain.frxReport1.DataSets.Add(FrmMain.frxDBDataset[ProcedureNameIndex]);
if Trim(FrmMain.vRSCName) <> '' then begin
FrmMain.frxDBDataset[ProcedureNameIndex].UserName := FrmMain.vRSCName;
FrmMain.vRSCName := '';
end
else
FrmMain.frxDBDataset[ProcedureNameIndex].UserName := '存储数据集' + IntToStr(ProcedureNameIndex);
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
//关闭存储过程
procedure TJLKReport.CloseProc;
var
i : Integer;
begin
try
for i := 0 to QueryNum do begin
if Assigned(FrmMain.ADOStoredProc[i]) then begin
FrmMain.ADOStoredProc[i].Active := False;
FrmMain.ADOStoredProc[i].ProcedureName := '';
end;
end;
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
end;
end;
end;
procedure TJLKReport.AddParameterNameValue(
ProcedureNameIndex: Integer; const AddParameterName,
AddParameterValue: WideString);
begin
try
JLKAddParameterNameValue(ProcedureNameIndex, AddParameterName, AddParameterValue);
except
on E: Exception do begin
NoConIsOK := False;
FDelphiControl.Caption := E.message;
end;
end;
end;
procedure TJLKReport.ExportXLS(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxXLSExport1.ShowDialog := False;
frxXLSExport1.FileName := FileName;
frxReport1.Export(frxXLSExport1);
frxXLSExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportXML(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxXMLExport1.ShowDialog := False;
frxXMLExport1.FileName := FileName;
frxReport1.Export(frxXMLExport1);
frxXMLExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportPDF(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxPDFExport1.ShowDialog := False;
frxPDFExport1.FileName := FileName;
frxReport1.Export(frxPDFExport1);
frxPDFExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportBMP(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxBMPExport1.ShowDialog := False;
frxBMPExport1.FileName := FileName;
frxReport1.Export(frxBMPExport1);
frxBMPExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.PrintReportEx(const ReportPath: WideString;
bPrintView, bShowDialog: SYSINT);
begin
try
if not ConIsOK then
exit;
if FileExists(ReportPath) then begin
FrmMain.frxReport1.LoadFromFile(ReportPath);
FrmMain.frxReport1.PrintOptions.ShowDialog := true;
if bPrintView <> 0 then begin
if bShowDialog = 0 then
FrmMain.frxReport1.PrintOptions.ShowDialog := False;
FrmMain.frxReport1.ShowReport;
end
else begin
if bShowDialog = 0 then
FrmMain.frxReport1.PrintOptions.ShowDialog := False;
FrmMain.frxReport1.PrepareReport();
FrmMain.frxReport1.Print;
end;
FDelphiControl.Caption := 'T';
end
else begin
FrmMain.frxReport1.FileName := ReportPath;
FrmMain.frxReport1.DesignReport;
FDelphiControl.Caption := '文件:' + ReportPath + ' 没找到.';
end;
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportHTML(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxHTMLExport1.ShowDialog := False;
frxHTMLExport1.FileName := FileName;
frxReport1.Export(frxHTMLExport1);
frxHTMLExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportJPEG(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxJPEGExport1.ShowDialog := False;
frxJPEGExport1.FileName := FileName;
frxReport1.Export(frxJPEGExport1);
frxJPEGExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportTIFF(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxTIFFExport1.ShowDialog := False;
frxTIFFExport1.FileName := FileName;
frxReport1.Export(frxTIFFExport1);
frxTIFFExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportTXT(const ReportPath,
FileName: WideString);
begin
try
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
frxTXTExport1.ShowDialog := False;
frxTXTExport1.FileName := FileName;
frxReport1.Export(frxTXTExport1);
frxTXTExport1.ShowDialog := true;
end;
end
else
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.ExportFile(const ReportPath, FileName,
FileType: WideString; bExportSet: SYSINT);
var
sFileType : WideString;
begin
try
if ConIsOK = False then
exit;
if FileExists(ReportPath) then begin
with FrmMain do begin
frxReport1.LoadFromFile(ReportPath);
frxReport1.PrepareReport();
sFileType := UpperCase(FileType);
if bExportSet = 0 then begin
frxXLSExport1.ShowDialog := False;
frxXMLExport1.ShowDialog := False;
frxTXTExport1.ShowDialog := False;
frxHTMLExport1.ShowDialog := False;
frxRTFExport1.ShowDialog := False;
frxBMPExport1.ShowDialog := False;
frxJPEGExport1.ShowDialog := False;
frxTIFFExport1.ShowDialog := False;
frxPDFExport1.ShowDialog := False;
end;
frxXLSExport1.FileName := FileName;
frxXMLExport1.FileName := FileName;
frxTXTExport1.FileName := FileName;
frxHTMLExport1.FileName := FileName;
frxRTFExport1.FileName := FileName;
frxBMPExport1.FileName := FileName;
frxJPEGExport1.FileName := FileName;
frxTIFFExport1.FileName := FileName;
frxPDFExport1.FileName := FileName;
if sFileType = 'XLS' then
frxReport1.Export(frxXLSExport1)
else
if sFileType = 'XML' then
frxReport1.Export(frxXMLExport1)
else
if sFileType = 'TXT' then
frxReport1.Export(frxTXTExport1)
else
if sFileType = 'BMP' then
frxReport1.Export(frxBMPExport1)
else
if sFileType = 'JPEG' then
frxReport1.Export(frxJPEGExport1)
else
if sFileType = 'PDF' then
frxReport1.Export(frxPDFExport1)
else
if sFileType = 'TIFF' then
frxReport1.Export(frxTIFFExport1)
else
if sFileType = 'HTML' then
frxReport1.Export(frxHTMLExport1)
else
if sFileType = 'RTF' then
frxReport1.Export(frxRTFExport1);
frxXLSExport1.ShowDialog := true;
frxXMLExport1.ShowDialog := true;
frxTXTExport1.ShowDialog := true;
frxHTMLExport1.ShowDialog := true;
frxRTFExport1.ShowDialog := true;
frxBMPExport1.ShowDialog := true;
frxJPEGExport1.ShowDialog := true;
frxTIFFExport1.ShowDialog := true;
frxPDFExport1.ShowDialog := true;
end;
end
else begin
FrmMain.frxReport1.FileName := ReportPath;
FrmMain.frxReport1.DesignReport;
FDelphiControl.Caption := '文件：' + ReportPath + ' 没找到.';
end;
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
function TJLKReport.Get_xlsExportStyles: WordBool;
begin
Result := FrmMain.frxXLSExport1.ExportStyles;
end;
procedure TJLKReport.Set_xlsExportStyles(Value: WordBool);
begin
FrmMain.frxXLSExport1.ExportStyles := Value;
end;
function TJLKReport.Get_xlsExportPictures: WordBool;
begin
Result := FrmMain.frxXLSExport1.ExportPictures;
end;
function TJLKReport.Get_xlsMergeCells: WordBool;
begin
Result := FrmMain.frxXLSExport1.MergeCells;
end;
function TJLKReport.Get_xlsWysiwyg: WordBool;
begin
Result := FrmMain.frxXLSExport1.Wysiwyg;
end;
procedure TJLKReport.Set_xlsExportPictures(Value: WordBool);
begin
FrmMain.frxXLSExport1.ExportPictures := Value;
end;
procedure TJLKReport.Set_xlsMergeCells(Value: WordBool);
begin
FrmMain.frxXLSExport1.MergeCells := Value;
end;
procedure TJLKReport.Set_xlsWysiwyg(Value: WordBool);
begin
FrmMain.frxXLSExport1.Wysiwyg := Value;
end;
function TJLKReport.Get_ReportName: WideString;
begin
Result := FrmMain.frxReport1.FileName;
end;
procedure TJLKReport.Set_ReportName(const Value: WideString);
begin
try
if FrmMain.frxReport1.LoadFromFile(Value) then
FDelphiControl.Caption := 'T'
else
FDelphiControl.Caption := '文件：' + Value + ' 没找到.';
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
function TJLKReport.Get_xmlExportStyles: WordBool;
begin
Result := FrmMain.frxXMLExport1.ExportStyles;
end;
procedure TJLKReport.Set_xmlExportStyles(Value: WordBool);
begin
FrmMain.frxXMLExport1.ExportStyles := Value;
end;
function TJLKReport.Get_xlsOpenExcelAfterExport: WordBool;
begin
Result := FrmMain.frxXLSExport1.OpenExcelAfterExport;
end;
function TJLKReport.Get_xlsShowDialog: WordBool;
begin
Result := FrmMain.frxXLSExport1.ShowDialog;
end;
function TJLKReport.Get_xlsShowProgress: WordBool;
begin
Result := FrmMain.frxXLSExport1.ShowProgress;
end;
function TJLKReport.Get_xmlExportPageBreaks: WordBool;
begin
Result := FrmMain.frxXMLExport1.ExportPageBreaks;
end;
function TJLKReport.Get_xmlOpenExcelAfterExport: WordBool;
begin
Result := FrmMain.frxXMLExport1.OpenExcelAfterExport;
end;
function TJLKReport.Get_xmlShowDialog: WordBool;
begin
Result := FrmMain.frxXMLExport1.ShowDialog;
end;
function TJLKReport.Get_xmlShowProgress: WordBool;
begin
Result := FrmMain.frxXMLExport1.ShowProgress;
end;
function TJLKReport.Get_xmlWysiwyg: WordBool;
begin
Result := FrmMain.frxXMLExport1.Wysiwyg;
end;
procedure TJLKReport.Set_xlsOpenExcelAfterExport(Value: WordBool);
begin
FrmMain.frxXLSExport1.OpenExcelAfterExport := Value;
end;
procedure TJLKReport.Set_xlsShowDialog(Value: WordBool);
begin
FrmMain.frxXLSExport1.ShowDialog := Value;
end;
procedure TJLKReport.Set_xlsShowProgress(Value: WordBool);
begin
FrmMain.frxXLSExport1.ShowProgress := Value;
end;
procedure TJLKReport.Set_xmlExportPageBreaks(Value: WordBool);
begin
FrmMain.frxXMLExport1.ExportPageBreaks := Value;
end;
procedure TJLKReport.Set_xmlOpenExcelAfterExport(Value: WordBool);
begin
FrmMain.frxXMLExport1.OpenExcelAfterExport := Value;
end;
procedure TJLKReport.Set_xmlShowDialog(Value: WordBool);
begin
FrmMain.frxXMLExport1.ShowDialog := Value;
end;
procedure TJLKReport.Set_xmlShowProgress(Value: WordBool);
begin
FrmMain.frxXMLExport1.ShowProgress := Value;
end;
procedure TJLKReport.Set_xmlWysiwyg(Value: WordBool);
begin
FrmMain.frxXMLExport1.Wysiwyg := Value;
end;
function TJLKReport.Get_PrintOptionCollate: WordBool;
begin
Result := FrmMain.frxReport1.PrintOptions.Collate;
end;
function TJLKReport.Get_PrintOptionCopies: Integer;
begin
Result := FrmMain.frxReport1.PrintOptions.Copies;
end;
function TJLKReport.Get_PrintOptionPageNumbers: WideString;
begin
Result := FrmMain.frxReport1.PrintOptions.PageNumbers;
end;
function TJLKReport.Get_PrintOptionPrinter: WideString;
begin
Result := FrmMain.frxReport1.PrintOptions.Printer;
end;
function TJLKReport.Get_PrintOptionShowDialog: WordBool;
begin
Result := FrmMain.frxReport1.PrintOptions.ShowDialog;
end;
procedure TJLKReport.Set_PrintOptionCollate(Value: WordBool);
begin
FrmMain.frxReport1.PrintOptions.Collate := Value;
end;
procedure TJLKReport.Set_PrintOptionCopies(Value: Integer);
begin
FrmMain.frxReport1.PrintOptions.Copies := Value;
end;
procedure TJLKReport.Set_PrintOptionPageNumbers(const Value: WideString);
begin
FrmMain.frxReport1.PrintOptions.PageNumbers := Value;
end;
procedure TJLKReport.Set_PrintOptionPrinter(const Value: WideString);
begin
FrmMain.frxReport1.PrintOptions.Printer := Value;
end;
procedure TJLKReport.Set_PrintOptionShowDialog(Value: WordBool);
begin
FrmMain.frxReport1.PrintOptions.ShowDialog := Value;
end;
procedure TJLKReport.AddRecordset(vRecordset: OleVariant);
begin
try
Inc(DatasetNum);
if (DatasetNum > 0) and (DatasetNum < QueryNum) then begin
FrmMain.dsJLKADOQ[DatasetNum].Recordset := _Recordset(IUnknown(vRecordset));
FrmMain.dsfrxDataSet[DatasetNum].DataSet := FrmMain.dsJLKADOQ[DatasetNum];
FrmMain.frxReport1.DataSets.Clear;
FrmMain.frxReport1.DataSets.Add(FrmMain.dsfrxDataSet[DatasetNum]);
if Trim(FrmMain.vRSCName) <> '' then begin
FrmMain.dsfrxDataSet[DatasetNum].UserName := FrmMain.vRSCName;
FrmMain.vRSCName := '';
end
else
FrmMain.dsfrxDataSet[DatasetNum].UserName := 'RS数据集' + IntToStr(DatasetNum);
end;
FDelphiControl.Caption := '增加数据集成功！';
ConIsOK := true;
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
ConIsOK := False;
end;
end;
end;
procedure TJLKReport.ClearAllRecordset;
var
i : Integer;
begin
try
for i := 0 to QueryNum do begin
if Assigned(FrmMain.dsJLKADOQ[i]) then
CloseADOQ(FrmMain.dsJLKADOQ[i]);
end;
DatasetNum := 0;
FDelphiControl.Caption := 'T';
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
end;
end
end;
function TJLKReport.Get_ConnectionObj: OleVariant;
begin
try
Result := OleVariant(IUnknown(FrmMain.JLKADOConn));
except
on E: Exception do
FDelphiControl.Caption := E.message;
end;
end;
procedure TJLKReport.Set_ConnectionObj(Value: OleVariant);
var
i : Integer;
begin
try
ConIsOK := False;
FrmMain.JLKADOConn.Connected := False;
bConnObj := FrmMain.JLKADOConn.ConnectionObject;
FrmMain.JLKADOConn.ConnectionObject := _Connection(IUnknown(Value));
FrmMain.JLKADOConn.LoginPrompt := False;
FrmMain.JLKADOConn.Connected := true;
ConIsOK := true;
FDelphiControl.Caption := '连接数据库成功！';
except
on E: Exception do begin
FDelphiControl.Caption := E.message;
MessageBox(Application.Handle, '未连接至数据库！', '错误', MB_OK + MB_ICONWARNING);
ConIsOK := False;
end;
end;
end;
function TJLKReport.Get_RSCName: WideString;
begin
Result := FrmMain.vRSCName;
end;
procedure TJLKReport.Set_RSCName(const Value: WideString);
begin
FrmMain.vRSCName := Value;
end;
initialization
TActiveXControlFactory.Create(
ComServer,
TJLKReport,
TPanel,
CLASS_JLKReport,
1,
'',
//'{E4D36020-7F8B-466E-B903-9E60331CECC2}',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.