Ensuite beaucoup de demande on été faite pour pouvoir lier une image dynamiquement.
http://www.developpez.net/forums/viewtopic.php?t=102168
http://www.developpez.net/forums/viewtopic.php?t=66466
Pour cela Crystal nous propose quelque chose mais en VB :
1 2 3 4 5 6 7 8 9 10 11
|
This code applies to Section Format Events in a DSR.
'Section 3 is the detail section
Private Sub Section3_Format(ByVal pFormattingInfo As Object)
'Pass the path from field3 to the Visual Basic LoadPicture function.
'The picture is then loaded into the OLE Object
Set Picture1.FormattedPicture = LoadPicture(Field3.Value)
End Sub |
ON constate que Crystal à pensé à tout, car ce code n'est pas très compliqué.
IL faut :
1. Placer un objet OLE, appelé Picture1, dans un section, appelé Section3.
2. Traper l'événement Format de la Section du rapport.
3. Et dans l'événement Format, modifier l'objet Picture avec l'image qui se trouve sur votre disque. Par exemple :
1 2 3 4
| Set Picture1.FormattedPicture = LoadPicture(Field3.Value)
Field3 pourait être un FormulaField qui retourne
"pic" + ToText({Hetype.Type,0}) + ".jpg" |
Maintenat le plus compliqué c'est le point 2, car cela demande pas mal de notion COM en Delphi. Dans le fichier CRAXDRT_TLB.pas on a la section "ISection" et sont événement "ISectionEvent".
Il faut faire un wrappeur pour ces deux interface.
Voici ce que je vous propose :
Pour l'en-tête
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
| TCrSectionFormat = procedure (Sender: TObject; const pFormattingInfo: IDispatch) of object;
TCrSection = class(TOleServer)
private
FOnFormat : TCrSectionFormat;
FIntf: ISection;
function GetDefaultInterface: ISection;
protected
procedure InitServerData; override;
procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
published
property OnFormat: TCrSectionFormat read FOnFormat write FOnFormat;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: ISection);
procedure Disconnect; override;
property DefaultInterface: ISection read GetDefaultInterface;
property Intf:ISection read FIntf;
end; |
Pour le coprs :
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
| { TCrSection }
procedure TCrSection.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as ISection;
end;
end;
procedure TCrSection.ConnectTo(svrIntf: ISection);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
constructor TCrSection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TCrSection.Destroy;
begin
inherited Destroy;
end;
procedure TCrSection.Disconnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TCrSection.GetDefaultInterface: ISection;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
procedure TCrSection.InitServerData;
const
CServerData: TServerData = (
ClassID: '{AF3768D4-6120-4E28-96DD-63FD2DC27B7A}';
IntfIID: '{AF376806-6120-4E28-96DD-63FD2DC27B7A}';
EventIID: '{AF37684B-6120-4E28-96DD-63FD2DC27B7A}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TCrSection.InvokeEvent(DispID: TDispID;
var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnFormat) then
FOnFormat(Self, Params[0]);
end; {case DispID}
end; |
Vous ajouter cela dans le fichier CRAXDRT_TLB.pas
Maintenat vous avez une classe TCrSection qui ce connecte sur n'importe quel section du rapport et vous propose l'événement OnFormat(...)
Pour l'utiliser c'est simple :
1 2 3
| FRptSection := TCRSection.Create(nil);
FRptSection.OnFormat := FormatOLE;
FRptSection.ConnectTo(crReport.Sections.Get_Item('DetailSection1')); |
FormatOLE est votre procedure qui serra appelé par l'événement onFormat. C'est la dedans que vous coderai le chargement de l'image.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
|
var
strPath : string;
oPicture: TPicture;
pd: IPictureDisp;
oBitmap : TBitmap;
{...}
oPicture := TPicture.Create;
try
oBitmap := LoadGraphicsFile(strPath);
oPicture.Bitmap := oBitmap ;
GetOLEPicture(oPicture, pd);
Picture1.FormattedPicture := pd;
finally
oPicture.Free;
oBitmap.Free;
oBitmap := nil;
pd := nil;
end; |
Voilà si vous voulez en savoir plus sur la création de la classe TCrsection, allez plutôt sur le forum Delphi.
Bonne chance

Partager