I have a crystal report (.RPT File) which has been created by a POS system, I need to get all the records from this report into a database so I can use it in my program. The problem is that it is grouped and have headers and footers, when exporting jut like this it exports a lot of nonsense to the ODBD database. I would like to suppress all Groups and headers and only export the details. In crystal designer I can do this by clicking on each group and suppressing them. I need to do this from within Delphi. See my working code for viewing the data, and currently exporting everything to Excel.
`unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleServer,
CrystalActiveXReportViewerLib14_TLB, Vcl.OleCtrls, OleAuto,
CrystalReportViewerExportLib_TLB;
type
TForm2 = class(TForm)
CrystalRpt: TCrystalActiveXReportViewer;
Button1: TButton;
Button2: TButton;
CrystalExport: TCrystalReportExport;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var
oApp : variant ;
begin
oApp := CreateOleObject('CrystalRuntime.Application') ;
crystalrpt.ReportSource := oApp.OpenReport('c:\guess.rpt',1);
{crystalrpt.ShowGroup('Group Header #1') ;}
crystalrpt.ViewReport ;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
cry : TCrystalActiveXReportViewer;
oRpt, oApp : variant;
i : integer;
begin
//Export the report to a file
oApp := CreateOleObject('CrystalRuntime.Application');
oRpt := oApp.OpenReport('c:\guess.rpt',1);
oRpt.ExportOptions.FormatType := 29; //excel 8
oRpt.ExportOptions.DiskFileName := 'c:\output.xls';
oRpt.ExportOptions.DestinationType := 1; //file destination
oRpt.ExportOptions.
//Export(False) => do NOT prompt.
//Export(True) will give runtime prompts for export options.
oRpt.Export(false);
end;
end.`
Related
I have an application with multiple forms and a separate taskbar button for each form.
Let's say form2 displays an OpenDialog, I click away to another maximized application covering the full screen area, then I go back to form2 by selecting it's taskbar button. Voila! The OpenDialog is hidden behind the other application I selected, and I have to click on the now non-accessible form2 to bring the dialog back to the front. This is really annoying and may confuse the user.
Here is some code to illustrate the issue:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
end;
end.
________________
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure CreateParams(var Params: TCreateParams); override;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
end.
Is it possible maybe to get the handle of the visible opendialog? It used to be possible, but with the new Vista style OpenDialog if I trap OnDialogShow the OpenDialog reverts back to the old style which is a no go for me now.
Any ideas?
TOpenDialog.Execute() has an optional parameter that lets you specify a parent window that the dialog is not allowed to fall behind:
procedure TForm2.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute(Self.Handle);
end;
If you do not specify a parent window, the active Form's window is used if Application.ModalPopupMode is not pmNone, otherwise the Application.MainForm window is used instead.
So I've figured out how to bring the dialog to the front, but there is still one problem: the focus is on Form2, not the dialog. If someone can tell me how to put the focus on the opendialog instead of Form2 and post it as an answer, I'll accept it.
Here are the code excerpts to add to the original:
type
TForm1 = class(TForm)
private
procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
public
{ Public declarations }
end;
var
Form1: TForm1;
DialogFormHandle: HWnd;
...
procedure TForm1.WMActivate(var Msg: TWMActivate);
begin
inherited;
if DialogFormHandle <> 0 then
begin
BringWindowToTop(DialogFormHandle);
exit;
end;
end;
...
procedure TForm2.Button1Click(Sender: TObject);
begin
try
DialogFormHandle := Handle;
OpenDialog1.Execute(Handle);
finally
DialogFormHandle := 0;
end;
end;
Thanks!
These two days I start to write some codes for ping some other devices using Delphi XE5. To my pleasure, I find there's a component named IcmpClient can be used for ping. Here's the code, mostly from some web resource.
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin,
Vcl.ExtCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
IdIcmpClient;
type
TfrmPing = class(TForm)
edtHost: TEdit;
btnPing: TButton;
ICMP: TIdIcmpClient;
Label1: TLabel;
Panel1: TPanel;
spnPing: TSpinEdit;
lstReplies: TListBox;
procedure btnPingClick(Sender: TObject);
procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmPing: TfrmPing;
implementation
{$R *.dfm}
procedure TfrmPing.btnPingClick(Sender: TObject);
var
i: integer;
begin
ICMP.OnReply := ICMPReply;
ICMP.ReceiveTimeout := 1000;
btnPing.Enabled := False; try
ICMP.Host := edtHost.Text;
for i := 1 to spnPing.Value do begin
ICMP.Ping;
Application.ProcessMessages;
end;
finally btnPing.Enabled := True; end;
end;
procedure TfrmPing.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
var
sTime: string;
begin
// TODO: check for error on ping reply (ReplyStatus.MsgType?)
if (ReplyStatus.MsRoundTripTime = 0) then
sTime := '<1'
else
sTime := '=';
lstReplies.Items.Add(Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
[ReplyStatus.BytesReceived,
ReplyStatus.FromIpAddress,
ReplyStatus.SequenceId,
ReplyStatus.TimeToLive,
sTime,
ReplyStatus.MsRoundTripTime]));
end;
end.
After solving the problem of Error #10013 (by giving the administrator privilege ), I met with the second error #10040.
According to one post here, some people said that happens after upgrading from xe3 to xe4, and Remy Lebeau said it was on fixing. But after a few months, we are still meeting with the errors with XE5.
Should I just abandon Indy 10 and look for some other way to PING, or waiting for the fixes?
I have problem with host application, which loads DLL form and interfaceing some function and properties.
The purpose is load a dll, show name as module name, set connection to ADOTable component and show form with data. Everything is working fine. But after close the host app a host app crashed and I get windows that hostapp.exe stopped working.
I do not know whether it is by freeing library or setting nil for interface.
Do you have any solution? Thanks.
Interface CODE
unit u_baseplugin_intf;
interface
uses Data.Win.ADODB, Data.DB;
type
IBaseModuleInterface = interface
['{060A9C46-B3CF-4BA4-B025-2DC1D9F45076}']
function GetModuleName: Ansistring;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
procedure showF;stdcall;
procedure freeF;stdcall;
property ModuleName: Ansistring read GetModuleName;
property Connection : TAdoConnection write SetConn;
end;
implementation
end.
DLL code
library profileslist;
uses
System.SysUtils,
System.Classes,
u_baseplugin_intf,
u_profileslist in 'u_profileslist.pas' {Form_DLL};
{$R *.res}
function LoadModule:IBaseModuleInterface;stdcall;
begin
result:=TForm_DLL.Create(nil);
end;
exports
LoadModule;
begin
end.
DLL Form code
unit u_profileslist;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls,
u_baseplugin_intf, Data.DB,Data.Win.ADODB;
type
TForm_DLL = class(TForm, IBaseModuleInterface)
DBGrid1: TDBGrid;
ADOTable1: TADOTable;
DataSource1: TDataSource;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
{Interface methods implementation}
function GetModuleName: AnsiString;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
public
{ Public declarations }
{Interface methods implementation}
procedure ShowF;stdcall;
procedure FreeF;stdcall;
end;
var
Form_DLL: TForm_DLL;
implementation
{$R *.dfm}
{Interface methods implementation}
function TForm_DLL.GetModuleName;
begin
Result := 'Profiles list';
end;
procedure TForm_DLL.SetConn(sConn: TAdoConnection);
begin
AdoTable1.Connection:=sConn;
end;
procedure TForm_DLL.ShowF;
begin
ShowModal;
end;
procedure TForm_DLL.FreeF;
begin
FreeAndNil(Form_DLL);
end;
{Form_DLL methods implementation}
procedure TForm_DLL.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AdoTable1.Active:=false;
end;
procedure TForm_DLL.FormShow(Sender: TObject);
begin
AdoTable1.Active:=true;
end;
end.
HOST app code
program hostapp;
uses
Vcl.Forms,
u_hostapp in 'u_hostapp.pas' {Form1},
u_baseplugin_intf in 'u_baseplugin_intf.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Host app FORM code
unit u_hostapp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
u_baseplugin_intf,
Data.Win.ADODB, Data.DB;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TModuleInterface = function:IBaseModuleInterface; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
aModuleIntf : IBaseModuleInterface;
dllHandle : cardinal;
procedure LoadModule( aLibName : pWideChar );
var
lModule : TModuleInterface;
begin
dllHandle := LoadLibrary(aLibName) ;
if dllHandle <> 0 then
begin
#lModule := GetProcAddress(dllHandle, 'LoadModule') ;
if Assigned (lModule) then
aModuleIntf := lModule //call the function
else
begin
ShowMessage('GetModuleIntf not found.') ;
FreeLibrary(dllHandle) ;
end;
end
else
begin
ShowMessage(aLibName+' not found.') ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aModuleIntf.Connection:=AdoConnection1;
aModuleIntf.ShowF;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
aModuleIntf.Connection:=nil;
aModuleIntf.freeF;
aModuleIntf:=nil;
FreeLibrary(dllHandle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadModule('profileslist.dll');
Label1.Caption:=aModuleIntf.ModuleName;
end;
end.
You never assign to Form_DLL. This means that when you call FreeF, you then perform FreeAndNil(Form_DLL). Since Form_DLL is nil, this does nothing, and the form still exists.
Fix that by changing LoadModule:
function LoadModule:IBaseModuleInterface;stdcall;
begin
Assert(not Assigned(Form_DLL));
Form_DLL:=TForm_DLL.Create(nil);
result:=Form_DLL;
end;
Although, I'd probably change the design completely by removing Form_DLL altogether. The host app maintains a reference to the form, on which the call to Free can be made. In other words, remove Form_DLL and implement FreeF like this:
procedure TForm_DLL.FreeF;
begin
Free; // or Destroy
end;
Or even better, use reference counted interfaces on the implementing object and let aModuleIntf:=nil take the form down.
I am having one Delphi XE2 project to show scrolling text. My code is as follows :
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption := 'This is right scrolling text ';
Timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
S: String;
begin
S := Label1.Caption;
S := S[Length(S)] + Copy(S, 1, Length(S) - 1);
Label1.Caption := S;
end;
end.
Using the following code the text scrolls perfectly in 2d along to Y axis.
How to scroll text in Sinusoidal Wave ?
Angus Johnson's excellent GR32_Text extension to the fine graphics32 library appears to do what you need. The demos that you can download from the link above show just the effect you are asking for. All that remains is for you to animate the text in a paint box or similar control.
Im trying to make a FMX form in a dll, after about 17 hours (of trying diffrent approches) i got it working, except i get a exception trying to unload the dll. I have no idea how to make it work, maybe someone could help me and point out what im doing wrong?
side note:
i cant have a FMX form in my VCL application becouse of the AA drawing, i just need it on my text while drawing on a canvas and while having a FMX form on a VCL application, i dont get that cleartype on text :( im trying to make a some sort of OSD/HUD.
Project showing my problem:
exe unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL, Winapi.GDIPOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
exe unitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
implementation
initialization
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
#showme := GetProcAddress(DllHandle,'showme');
#closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
finalization
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end.
dll project1.dpr
library Project1;
uses
FMX.Forms,
System.SysUtils,
System.Classes,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
procedure showme(); stdcall export;
begin
TForm1.showme;
end;
procedure closeme(); stdcall export;
begin
TForm1.closeme;
end;
exports
showme, closeme;
begin
end.
dll unit1.pas
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs;
type
TForm1 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
class procedure showme();
class procedure closeme();
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
class procedure TForm1.showme();
begin
Form1 := TForm1.Create(Application);
Form1.Show;
end;
class procedure TForm1.closeme();
begin
Form1.Free;
end;
end.
EDIT (FIX):
All answers ware helpfull, but what i've done is, that the GDI+ was shutdown BEFORE the dll unload... that appear's to be the problem.
new unitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
function LoadLib : Boolean;
procedure UnloadLib;
implementation
function LoadLib : Boolean;
begin
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
#showme := GetProcAddress(DllHandle,'showme');
#closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
Result := DllHandle <> 0;
end;
procedure UnloadLib;
begin
if DLLHandle <> 0 then begin
FreeLibrary(DLLHandle);
DllHandle := 0;
end;
end;
initialization
LoadLib;
finalization
UnloadLib;
end.
new unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.GDIPOBJ;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
in unit1.pas i moved the Winapi.GDIPOBJ to "uses" just after interface directive, and it worked...
Thank you all for your answers! See you soon! very soon...
Does it help if you import sharemem on both sides?
You are not using packages, so both sides probably have an own instance all RTL state, as well as VMT tables (though that is only a problem with certain IS and AS cases). And the memory manager is RTL state :-)