I'm trying to copy selected text, using this:
uses
Androidapi.Helpers, Androidapi.jni , AndroidAPI.JNIBridge,
Androidapi.JNI.JavaTypes, FMX.Helpers.Android,
Androidapi.JNI.GraphicsContentViewText;
procedure TForm2.Button5Click(Sender: TObject);
var
myclipboard : JClipboardManager;
s: string;
begin
myclipboard := TJClipboardManager.create;
myclipboard.getText;
showmessage(BoolToStr(myclipboard.hasText));
end;`
There are a lot of samples in Java, but i'm not enough strong yet to understand it
You are not supposed to instantiate the ClipboardManager class directly, but instead use the Content.getSystemService() method to obtain the correct manager object. The Android documentation even says so:
You do not instantiate this class directly; instead, retrieve it through getSystemService(Class).
So, you have to do this instead:
function GetClipboardManager: JClipboardManager;
var
obj: JObject;
begin
obj := SharedActivityContext.getSystemService(TJContext.JavaClass.CLIPBOARD_SERVICE);
if Assigned(obj) then
Result := TJClipboardManager.Wrap((obj as ILocalObject).GetObjectID)
else
Result := nil;
end;
procedure TForm2.Button5Click(Sender: TObject);
var
myclipboard : JClipboardManager;
begin
myclipboard := GetClipboardManager;
if Assigned(myclipboard) then
begin
//...
end;
end;
Do note that depending on which version of Android you are running on, Context.getSystemService(CLIPBOARD_SERVICE) will return either a android.content.ClipboardManager (HoneyComb+) or android.text.ClipboardManager object. Not sure how well Delphi handles that, if at all. You will have to look at the declaration of JClipboardManager to see which one it is accessing. The latter one was deprecated in Android API level 11.
Embarcadero wants you to use FMX's cross-platform IFMXClipboardService interface instead:
uses
FMX.Platform, System.Rtti;
procedure TForm2.Button5Click(Sender: TObject);
var
Clipboard: IFMXClipboardService;
value: TValue;
hasText: boolean;
s: string;
begin
hasText := False;
if PlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(Clipboard)) then
begin
value := Clipboard.GetClipboard;
hasText := value.TryAsType<String>(s);
end;
ShowMessage(BoolToStr(hasText));
if hasText then ShowMessage(s);
end;
Related
I am using an in-memory TClientDataSet with a TStringField column which contains folders path (Delphi 7).
When I create an index on this column the order is not what I am looking for.
As an example I get :
c:\foo
c:\fôo\a
c:\foo\b
when I would like this order :
c:\foo
c:\foo\b
c:\fôo\a
So I searched a way to use my own compare field function.
Based on this RRUZ answer How to change the implementation (detour) of an externally declared function I tried the following :
type
TClientDataSetHelper = class(DBClient.TClientDataSet);
...
MyCDS : TClientDataSet;
...
// My custom compare field function
function FldCmpHack
(
iFldType : LongWord;
pFld1 : Pointer;
pFld2 : Pointer;
iUnits1 : LongWord;
iUnits2 : LongWord
): Integer; stdcall;
begin
// Just to test
Result := -1;
end;
...
---RRUZ code here---
...
procedure HookDataCompare;
begin
HookProc
(
(MyCDs as TClientDataSetHelper).DSBase.FldCmp, <== do not compile !!!
#FldCmpHack,
FldCmpBackup
);
end;
When I try to compile I get an error (MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters
I do not understand why this does not compile. Could you please help me ?
Is it even possible to "detour" IDSBase.FldCmp in DSIntf.pas ? Am i totally wrong ?
Thank you
EDIT
Finally, thanks to Dsm answer, I transformed the TStringFieldcolumn into a TVarBytesField in order to avoid doubling the buffer. Plus, when a TVarBytesField is indexed the order is based on the bytes value so I get the order I want. For having all child folders after a parent folder and before the next parent folder (c:\foo.new after c:\foo\b), I patched TVarBytesFieldlike this :
TVarBytesField = class(DB.TVarBytesField)
protected
function GetAsString: string; override;
procedure GetText(var Text: string; DisplayText: Boolean); override;
procedure SetAsString(const Value: string); override;
end;
function TVarBytesField.GetAsString: string;
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
Result := '';
GetMem(vBuffer, DataSize);
try
if GetData(vBuffer) then
begin
vTaille := PWORD(vBuffer)^;
vTexte := vBuffer + 2;
SetLength(Result, vTaille);
for vI := 1 to vTaille do
begin
if vTexte^ = #2 then
begin
Result[vI] := '\';
end
else
begin
Result[vI] := vTexte^;
end;
Inc(vTexte);
end;
end;
finally
FreeMem(vBuffer);
end;
end;
procedure TVarBytesField.GetText(var Text: string; DisplayText: Boolean);
begin
Text := GetAsString;
end;
procedure TVarBytesField.SetAsString(const Value: string);
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
vBuffer := AllocMem(DataSize);
try
vTaille := WORD(Length(Value));
PWORD(vBuffer)^ := vTaille;
vTexte := vBuffer + 2;
for vI := 1 to vTaille do
begin
if Value[vI] = '\' then
begin
vTexte^ := #2
end
else
begin
vTexte^ := Value[vI];
end;
Inc(vTexte);
end;
SetData(vBuffer);
finally
FreeMem(vBuffer);
end;
end;
The message is telling you that FldCmp is a function, and it is expecting you to execute it, but it has not got enough parameters. I am sure that you already realised that and probably already tried to get the address of the function with the # (like you do for FldCmpHack) and found that that does not work.
The reason for that is, I am afraid, that FldCmp is not a normal function. DSBase is actually an interface, which will have been assigned (looking at the source code) by a class factory. What you actually need is the real function itself and for that you need the real object that the class factory creates. And I am sorry, but I can't see any realistic way of doing that.
However, the DSBase field is only created if it has not been assigned, so you could, in theory, create your own IDSBase interface object, which is the way this type of problem is meant to be handled. That is a lot of work, though, unless you know class that the class factory produces and can descend from that.
A sneakier alternative is to override the Translate property and create some sort of hash (perhaps by translating the ASCII codes to their HEX values) so that the database keeps them in the right order
TClientDataSetHelper = class(TClientDataSet)
public
function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
end;
I have 5 forms created at design time. I need to dynamically create an instance of each form and put on a tab.
My question: If the form names are in an array of strings and I call my procedure like this:
ShowForm(FormName[3]);// To show the 3rd form on a tab page.
How can I define and create the new instance for each form?
This is what I have for now:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TfrmSetupItemCategories;//***HERE IS MY PROBLEM***
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
if pProcName='ProcfrmSetupItemCategories' Then
begin
NewForm:=TfrmSetupItemCategories.Create(NewTab);
NewTab.Caption := NewForm.Caption;
end;
if pProcName='ProcfrmZones' Then
begin
NewForm:=TfrmZones.Create(NewTab);
NewTab.Caption := NewForm.Caption;
end;
.
.
.
end;
the line that reads "HERE IS MY PROBLEM" is where I need help. I can't reuse NewForm as a variable with a second form in this way...
Note: My problem is NOT the tab. Rather it's creating a new instance of the form using the same variable name.
Declare the NewForm variable as TForm:
var
NewForm: TForm;
begin
NewForm := TMyForm.Create(Tab1); //compiles OK
NewForm := TMyOtherForm.Create(Tab2); //also compiles OK
end;
I'm assuming TMyForm and TMyOtherForm both are derivatives of TForm.
DRY
You can also reduce your repeating code using a class reference variable, like this:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TForm;
ClassToUse: TFormClass;
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
if pProcName='ProcfrmSetupItemCategories' then
ClassToUse := TfrmSetupItemCategories
else if pProcName='ProcfrmZones' then
ClassToUse := TfrmZones
else
ClassToUse := nil;
if Assigned(ClassToUse) then
begin
NewForm := ClassTouse.Create(NewTab);
NewTab.Caption := NewForm.Caption;
//if you access custom properties or methods, this is the way:
if NewForm is TfrmZones then
TfrmZones(NewForm).ZoneInfo := 'MyInfo';
end;
end;
Register your classes and then create the forms from a string
As Sir Rufo points in his comment, you can even go further registering your classes (I'm not sure if this can be done in Lazarus, that exercise is up to you).
First, register the form classes you want to instantiate from the class name, previous to any call to your ShowFormOnTab method, for example:
procedure TMainForm.FormCreate(Sender: TObject);
begin
RegisterClass(TfrmSetupItemCategories);
RegisterClass(TfrmZones);
//and other classes
end;
Then, you can change the code to get the class reference from the class name string:
procedure TForm1.ShowFormOnTab(pProcName:String);
var
NewForm: TForm;
ClassToUse: TFormClass;
ClassNameToUse: string;
NewTab: TTabSheet;
FormName: String;
begin
NewTab := TTabSheet.Create(PageControl1);
NewTab.PageControl:= PageControl1;
NewTab.Caption:='hi';
PageControl1.ActivePage := NewTab;
//get rid of 'Proc' and add the T
//or even better, pass directly the class name
ClassNameToUse := 'T' + Copy(pProcName, 5, MaxInt);
ClassToUse := TFormClass(FindClass(ClassNameToUse));
if Assigned(ClassToUse) then
begin
NewForm := ClassTouse.Create(NewTab);
NewTab.Caption := NewForm.Caption;
//if you access custom properties or methods, this is the way:
if NewForm is TfrmZones then
TfrmZones(NewForm).ZoneInfo := 'MyInfo';
end;
end;
That way, the code remains the same for any number of classes.
For more info about this, take a look at Creating a Delphi form from a string in delphi.about.com.
Declare your variable as an ancestor type:
var
NewForm: TForm;
or
var
NewForm: TCustomForm;
Drawback: you'll need to cast the variable to the specific class if you want to call any methods of your form that you have declared yourself.
Use a 'soft' cast if you want to have the compiler check that NewForm is actually a TMyForm at runtime:
(NewForm as TMyForm).MyMethod;
When you are absolutely sure that NewForm is a TMyForm (like when you just created it), you can also use a 'hard' cast:
TMyForm(NewForm).MyMethod;
With registered classes, in the initialization of the used forms, you could shorten it to
Function CreateAndDock(pc:TPageControl;const FormName:String):Boolean;
begin
Result := false;
if Assigned(GetClass(FormName)) and GetClass(FormName).InheritsFrom(TCustomForm) then
With TFormClass( GetClass(FormName)).Create(pc.Owner) do
begin
ManualDock(pc);
Show;
Result := true;
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(Integer(CreateAndDock(pagecontrol1,'TDockForm'))));
ShowMessage(IntToStr(Integer(CreateAndDock(pagecontrol1,'TNotExists'))));
end;
I got quite a large application which is currently being styled up.
To save me changing all the buttons in the IDE/Object Inspector I am planning on just doing a few functions for the main objects like
procedure StyleButton(AButton : TButton)
begin
AButton.Color := clGreen;
AButton.Font.Style = [fsBold];
end;
etc etc and then add that to the forms onCreates as needed
StyleButton(Button1); whatever etc
There is no issue passing objects in params like this. It does just reference the first object right?
It works fine and I can't think of any issues, but because this is a large application which thousands of users I just want to be sure there will be no issues/memory leaks/resource consumpution issues.
Will also be doing similar things with TAdvStringGrid and TEdit/TMemo components.
Then allows just 1 place to change these settings.
Or someone have a better idea?
This is an excellent idea. The function will modify whichever object you pass to it.
You are not passing by reference. You are passing by value. The value you are passing is a reference. "Passing by reference" means you'd use the var or out keywords, which are not appropriate in this situation.
Your idea is just fine, as the other answerers have already said. Just want to propose a solution that goes even further than David's and something you may want to consider in order to avoid having to add many statements like:
StyleButton(Button1);
StyleButton(Button2);
to each and every form for each and every control you would like to style;
What I would propose is to add a single method call to for example each form's OnShow event:
procedure TForm1.FormShow(Sender: TObject);
begin
TStyler.StyleForm(Self);
end;
The TStyler could be implemented in a separate unit that looks like this:
interface
type
TStyler = class;
TStylerClass = class of TStyler;
TStyler = class(TObject)
public
class procedure StyleForm(const aForm: TCustomForm);
class procedure StyleControl(const aControl: TControl); virtual;
class function GetStyler(const aControl: TControl): TStylerClass;
end;
implementation
uses
Contnrs;
type
TButtonStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TEditStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
TLabelStyler = class(TStyler)
public
class procedure StyleControl(const aControl: TControl); override;
end;
var
_Controls: TClassList;
_Stylers: TClassList;
{ TStyler }
class function TStyler.GetStyler(const aControl: TControl): TStylerClass;
var
idx: Integer;
begin
Result := TStyler;
idx := _Controls.IndexOf(aControl.ClassType);
if idx > -1 then
Result := TStylerClass(_Stylers[idx]);
end;
class procedure TStyler.StyleForm(const aForm: TCustomForm);
procedure _StyleControl(const aControl: TControl);
var
i: Integer;
StylerClass: TStylerClass;
begin
StylerClass := TStyler.GetStyler(aControl);
StylerClass.StyleControl(aControl);
if (aControl is TWinControl) then
for i := 0 to TWinControl(aControl).ControlCount - 1 do
_StyleControl(TWinControl(aControl).Controls[i]);
end;
var
i: Integer;
begin
_StyleControl(aForm);
end;
class procedure TStyler.StyleControl(const aControl: TControl);
begin
// Do nothing. This is a catch all for all controls that do not need specific styling.
end;
{ TButtonStyler }
class procedure TButtonStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TButton then
begin
TButton(aControl).Font.Color := clRed;
TButton(aControl).Font.Style := [fsBold];
end;
end;
{ TEditStyler }
class procedure TEditStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TEdit then
begin
TEdit(aControl).Color := clGreen;
end;
end;
{ TLabelStyler }
class procedure TLabelStyler.StyleControl(const aControl: TControl);
begin
inherited;
if aControl is TLabel then
begin
TLabel(aControl).Font.Color := clPurple;
TLabel(aControl).Font.Style := [fsItalic];
end;
end;
initialization
_Controls := TClassList.Create;
_Stylers := TClassList.Create;
_Controls.Add(TButton);
_Stylers.Add(TButtonStyler);
_Controls.Add(TEdit);
_Stylers.Add(TEditStyler);
_Controls.Add(TLabel);
_Stylers.Add(TLabelStyler);
finalization
FreeAndNiL(_Controls);
FreeAndNiL(_Stylers);
end.
This solution basically employs polymorphism and a registry that links control classes to styler classes. It also uses class procedures and functions to avoid having to instantiate anything.
Please note that the registry is implemented in this example as two lists that need to be kept in sync manually as the code assumes that finding a class at index X will find the styler at the same index in the other list. This can of course be improved upon very much, but is sufficient here to show the concept.
No, There is no issue (in your specific case) passing a object as parameter
procedure StyleButton(AButton : TButton)
when you do this you are passing a address memory (reference) and setting some properties of the referenced object, so there is not problem.
To add to what Rob and RRUZ have already said, you could consider an extra helper using open array parameters:
procedure StyleButtons(const Buttons: array of TButton);
var
i: Integer;
begin
for i := low(Buttons) to high(Buttons) do
StyleButton(Buttons[i]);
end;
You can then call this as:
StyleButtons([btnOK, btnCancel, btnRelease64bitDelphi]);
which is, in my view, more readable at the call-site than:
StyleButton(btnOK);
StyleButton(btnCancel);
StyleButton(btnRelease64bitDelphi);
Note that I passed the open array as a const parameter because that is more efficient when dealing with arrays. Because each element of the array is itself a reference to the button, you are able to modify the actual button. The const just means that you cannot change the reference.
I have a form (form2) and I implemented the following PUBLIC method:
function ShowInterface(i:integer):boolean;
This form is in a package that will be DYNAMIC LOADED. Now I want to instantiate this form (form2) and execute the method above.
Important: I can't reference form2's unit in form1.
I tryed this code, but it never finds "ShowInterface" pointer (returns nil).
procedure TfrmForm1.Button1Click(Sender: TObject);
var
PackageModule: HModule;
AClass: TPersistentClass;
ShowInterface: function (i:integer):boolean;
frm: TCustomForm;
begin
PackageModule := LoadPackage('form2.bpl');
if PackageModule <> 0 then
begin
AClass := GetClass('TfrmForm2');
if AClass <> nil then // <<-- FINE!! IT FINDS OUT 'TfrmForm2' in 'form2.bpl')
begin
frm := TComponentClass(AClass).Create(Self) as TCustomForm;
ShowInterface := frm.MethodAddress('ShowInterface'); // <<-- HERE!! ALLWAYS RETURNS "NIL"
if #ShowInterface <> nil then
ShowInterface(1);
// but if I call frm.Show, it works fine. frm is "loaded"!!!
frm.Free;
end;
DoUnloadPackage(PackageModule);
end;
end;
Thanks in advance.
MethodAddress only works for published methods. Move it to the published section and it should work.
Or, if you have Delphi 2010, the extended RTTI offers a way to find public methods by name. (Or other visibility levels, if you change it from the default.)
As Mason and TOndrej said, I have to put the method in published section. (Thank you!)
But, some fixes were needed:
procedure TfrmForm1.Button1Click(Sender: TObject);
type
TShowInterface = function(i:integer):boolean of object;
var
PackageModule: HModule;
AClass: TPersistentClass;
Routine: TMethod;
ShowInterface : TShowInterface;
frm: TCustomForm;
begin
PackageModule := LoadPackage('form2.bpl');
if PackageModule <> 0 then
begin
AClass := GetClass('TfrmForm2');
if AClass <> nil then
begin
frm := TComponentClass(AClass).Create(Self) as TCustomForm;
Routine.Data := Pointer(frm);
Routine.Code := frm.MethodAddress('ShowInterface');
if Assigned(Routine.Code) then
begin
ShowInterface := TShowInterface(Routine);
ShowInterface(1); // showinterface executes a "ShowModal", so we can "free" form after this.
end;
frm.Free;
end;
DoUnloadPackage(PackageModule);
end;
end;
In D2007 and some earlier versions, that only works with published methods, or extended RTTI: {$METHODINFO ON}. I haven't used D2010 yet; it seems to have a new RTTI system which has been extended a lot.
The most recent Crystal XI component for Delphi was released for Delphi 7. That VCL component compiles in D2007, but gives me errors at runtime. What is the best way to display a database-connected Crystal Report in a Delphi 2007 application?
This is the solution I've found, using ActiveX:
First, register the Active X control like this:
In Delphi, choose Component -> Import Component
Click on "Type Library", click Next
Choose "Crystal ActiveX Report Viewer Library 11.5"
Pick whatever Palette Page you want (I went with "Data Access")
Choose an import location
Exit out of the wizard
Add the location you chose to your project Search Path
Now this code should work:
...
uses
CrystalActiveXReportViewerLib11_5_TLB, OleAuto;
...
procedure TForm1.Button1Click(Sender: TObject);
var
cry : TCrystalActiveXReportViewer;
oRpt, oApp : variant;
i : integer;
frm : TForm;
begin
cry := TCrystalActiveXReportViewer.Create(Self);
oApp := CreateOleObject('CrystalRuntime.Application');
oRpt := oApp.OpenReport('c:\my_report.rpt',1);
for i := 1 to oRpt.Database.Tables.Count do begin
oRpt.Database.Tables[i].ConnectionProperties.Item['User ID'] := 'username';
oRpt.Database.Tables[i].ConnectionProperties.Item['Password'] := 'password';
end;
frm := TForm.Create(Self);
try
cry.Parent := frm;
cry.Align := alClient;
cry.ReportSource := oRpt;
cry.ViewReport;
frm.Position := poOwnerFormCenter;
frm.ShowModal;
finally
FreeAndNil(frm);
end; //try-finally
end;
procedure TForm1.btnExportClick(Sender: TObject);
var
cry : TCrystalActiveXReportViewer;
oRpt, oApp : variant;
i : integer;
begin
//Export the report to a file
cry := TCrystalActiveXReportViewer.Create(Self);
oApp := CreateOleObject('CrystalRuntime.Application');
oRpt := oApp.OpenReport(c_DBRpt,1);
for i := 1 to oRpt.Database.Tables.Count do begin
oRpt.Database.Tables[i].ConnectionProperties.Item['User ID'] := 'username';
oRpt.Database.Tables[i].ConnectionProperties.Item['Password'] := 'password';
end;
oRpt.ExportOptions.FormatType := 29; //excel 8
oRpt.ExportOptions.DiskFileName := 'c:\output.xls';
oRpt.ExportOptions.DestinationType := 1; //file destination
//Export(False) => do NOT prompt.
//Export(True) will give runtime prompts for export options.
oRpt.Export(False);
end;
If you use this method, then this (rather dense) reference will be helpful, especially since Intellisense doesn't work on Ole objects like these.
Edit: The original link to the reference broke, so I changed it to point to a new one (valid as of Dec 15 2009). If that new one breaks, then Google should be able to find it.
I know it's not your question and it might not be an acceptable answer at all in your situation, but I have found FastReports to be clearly superior to Crystal for my purposes. It's lighter weight, includes a real scripting language, incorporates event handling, can make calls into your native code for information and updates and does not require an ActiveX connection. I can export my reports into sharp looking PDF files or Excel spreadsheets and several other formats. The quality of the output adds to the overall experience users get from my application. I could go on, but if it's off topic for you, it won't be helpful.
For the sake of anyone else who can use it, here is a complete class that gives a pleasant wrapper around these vile Crystal interactions. It works for me about 80% of the time, but I suspect a lot of this stuff is very dependent on the specific platform on which it runs. I'll post improvements as I make them.
Somebody at Business Objects should really take a hard look at this API. It sucks pretty badly.
{
Class to facilitate the display of Crystal 11 Reports.
The Crystal 11 VCL component does not seem to work with Delphi 2007.
As a result, we have to use ActiveX objects, which make deployment messy.
This class is similar to CrystalReporter, but it works for Crystal 11.
However, it lacks some of the features of the old CrystalReporter.
Refer to the crystal reports activex technical reference to duplicate the
missing functionality.
Example usage is at the bottom of this unit.
//}
unit CrystalReporter11;
interface
uses
CrystalActiveXReportViewerLib11_5_TLB, OleAuto, Classes, Controls;
type
TCryExportFormat = (
XLS
,PDF
);
type
TCrystalReporter11 = class
private
FCryRpt : TCrystalActiveXReportViewer;
FRpt, FApp : variant;
FReportFile, FUsername, FPassword, FServer, FFilters : string;
FOwner : TComponent;
procedure SetLoginInfo(const username, password, server : string);
function GetFilterConds: string;
procedure SetFilterConds(const Value: string);
public
property FilterConditions : string read GetFilterConds write SetFilterConds;
procedure ExportToFile(ExportFileName : string;
FileExportFmt : TCryExportFormat; PromptForOptions : boolean);
procedure Display;
constructor Create(AOwner : TComponent; ReportFile : string); overload;
constructor Create(AOwner : TComponent; ReportFile,
Username, Password, Server : string); overload;
end;
implementation
uses
SysUtils, Forms;
const
//these are taken from pgs 246 and 247 of the technical reference
c_FmtCode_Excel = 29;
c_FmtCode_PDF = 31;
constructor TCrystalReporter11.Create(AOwner: TComponent; ReportFile: string);
begin
inherited Create;
try
FReportFile := ReportFile;
if FileExists(FReportFile) then begin
FOwner := AOwner;
FCryRpt := TCrystalActiveXReportViewer.Create(AOwner);
FApp := CreateOleObject('CrystalRuntime.Application');
FRpt := FApp.OpenReport(FReportFile,1);
FFilters := FRpt.RecordSelectionFormula;
end
else begin
raise Exception.Create('Report file ' + ReportFile + ' not found!');
end;
except on e : exception do
raise;
end; //try-except
end;
constructor TCrystalReporter11.Create(AOwner: TComponent; ReportFile, Username,
Password, Server: string);
begin
Create(AOwner,ReportFile);
FUsername := Username;
FPassword := Password;
FServer := Server;
SetLoginInfo(FUsername,FPassword,FServer);
end;
procedure TCrystalReporter11.Display;
var
rptForm : TForm;
begin
SetLoginInfo(FUsername,FPassword,FServer);
FCryRpt.ReportSource := FRpt;
rptForm := TForm.Create(FOwner);
try
FCryRpt.Parent := rptForm;
FCryRpt.Align := alClient;
FCryRpt.ViewReport;
rptForm.Position := poOwnerFormCenter;
rptForm.WindowState := wsMaximized;
rptForm.Caption := ExtractFileName(FReportFile);
rptForm.ShowModal;
finally
FreeAndNil(rptForm);
end; //try-finally
end;
procedure TCrystalReporter11.ExportToFile(ExportFileName : string;
FileExportFmt : TCryExportFormat; PromptForOptions : boolean);
begin
case FileExportFmt of
XLS : FRpt.ExportOptions.FormatType := c_FmtCode_Excel;
PDF : FRpt.ExportOptions.FormatType := c_FmtCode_PDF;
end; //case
FRpt.ExportOptions.DiskFileName := ExportFileName;
FRpt.ExportOptions.DestinationType := 1; //file destination
FCryRpt.ReportSource := FRpt;
FRpt.Export(PromptForOptions);
end;
function TCrystalReporter11.GetFilterConds: string;
begin
Result := FFilters;
end;
procedure TCrystalReporter11.SetFilterConds(const Value: string);
begin
FFilters := Value;
if 0 < Length(Trim(FFilters)) then begin
FRpt.RecordSelectionFormula := Value;
end;
end;
procedure TCrystalReporter11.SetLoginInfo(const username, password,
server : string);
var
i : integer;
begin
//set user name and password
//crystal only accepts these values if they are CONST params
for i := 1 to FRpt.Database.Tables.Count do begin
FRpt.Database.Tables[i].ConnectionProperties.Item['User ID'] := username;
FRpt.Database.Tables[i].ConnectionProperties.Item['Password'] := password;
try
{
Some reports use direct connections, and others use an ODBC Data Source.
Crystal XI uses a different label to refer to the database name in each
method.
I don't know how to determine in advance which method is being used, so:
First, we try the direct connection.
If that fails, we try the "data source" method.
Reference: "Crystal Reports XI Technical Reference", pages 41 thru 46;
"Common ConnectionProperties"
}
FRpt.Database.Tables[i].ConnectionProperties.Item['Server'] := server;
except on E: Exception do
FRpt.Database.Tables[i].ConnectionProperties.Item['Data Source'] := server;
end;
end;
end;
{
Example usage:
procedure TForm1.btnShowRptDBClick(Sender: TObject);
var
cry : TCrystalReporter11;
begin
cry := TCrystalReporter11.Create(Self,'c:\my_report.rpt','username',
'password','server.domain.com');
try
cry.Display;
finally
FreeAndNil(cry);
end;
end;
}
end.
I too have been disappointed with the lack of effort by Crystal Reports with respect to application integration. I use the RDC, and from what I understand this is being deprecated and emphasis is being placed on .Net.
My application has these files in the uses clause:
CRRDC, CRAXDRT_TLB,
It works ok. The because drawback is parameter passing. In my option the parameter dialog boxes which come with the viewer are terrible. So I use my own Delphi application to prompt for parameters and pass them to the report.
Here is a bit simpler and clean class which solves the problem very nicely:
Unit CrystalReports;
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, ActiveX, ComObj, Data.DB, Data.Win.ADODB,
CrystalActiveXReportViewerLib11_TLB, Vcl.OleServer, CrystalReportsControllersLib_TLB;
type
TCrystalReportForm = class(TForm)
CRV: TCrystalActiveXReportViewer;
procedure DisplayReport;
private
{ Private declarations }
public
{Public declarations }
ReportName : WideString;
ReportCaption : String;
ReportSelectionFormula : WideString;
end;
var
CRXIRuntime : Variant;
implementation
{$R *.dfm}
procedure TCrystalReportForm.DisplayReport;
var
CrystalReport : variant;
i : integer;
begin
CrystalReport := CRXIRuntime.OpenReport(ReportName);
for i := 1 to CrystalReport.Database.Tables.Count do begin
CrystalReport.Database.Tables[1].ConnectionProperties.Item['User ID'] := 'user';
CrystalReport.Database.Tables[1].ConnectionProperties.Item['Password'] := 'password';
end;
CrystalReport.FormulaSyntax := 0;
Caption := ReportCaption;
CrystalReport.RecordSelectionFormula := ReportSelectionFormula;
CRV.Align := alClient;
CRV.ReportSource := CrystalReport;
WindowState := wsMaximized;
CRV.ViewReport;
ShowModal;
end;
begin
CRXIRuntime := CreateOleObject('CrystalRuntime.Application');
end.