FAQ DelphiConsultez toutes les FAQ

1
2
3
Set Picture1.FormattedPicture = LoadPicture(Field3.Value) 
'Field3 pourrait être un FormulaField qui retourne 
"pic" + ToText({Hetype.Type,0}) + ".jpg"

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;

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
70
71
{ 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;

1
2
3
  FRptSection := TCRSection.Create(nil); 
  FRptSection.OnFormat := FormatOLE; 
  FRptSection.ConnectTo(crReport.Sections.Get_Item('DetailSection1'));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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;