VCL.Net Transfert Bitmap vers fichier RTF [Trucs & Astuces]

**emmanuelc** · 22/09/2006, 16h53

Je rencontre des problèmes pour transférer un Bitmap vers un fichier RTF. J'utilisai précédemment une procédure pour Win32 qui n'est malheureusement plus compatible en .NET.

Quelqu'un a-t-il une solution pour ce problème?

Merci d'avance

Emmanuel

**flash_math** · 22/09/2006, 18h07

Bonjour,

Heu tu utilisais quelle procédure ?

**emmanuelc** · 26/09/2006, 11h57

Une méthode qui consistait a placer le contenu du bitmap dans un metafile, puis à sauvergarder le métafile pour ensuite utiliser une procédure d'insersion de ce fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
procedure TRtfFile.AddBitmap(Bitmap : TBitmap; ScaleValue : integer);
var
  HMF : TMetaFile;
  MFC : TMetaFileCanvas;
  HRect : TRect;
begin
  HMF:=TMetafile.Create;
  try
    HMF.Width:=Bitmap.Width;
    HMF.Height:=Bitmap.Height;
    MFC:=TMetafileCanvas.Create(HMF,0);
    try
      HRect.Top:=0;
      HRect.Left:=0;
      HRect.Right:=1200;
      HRect.Bottom:=1200;
      MFC.Draw(0,0,Bitmap);
    finally
      MFC.Free;
    end;
    HMF.SaveToFile('Temp.wmf');
    try
      AddMetaFile('Temp.wmf',ScaleValue);
   finally
      DeleteFile('Temp.wmf');
    end;
  finally
    HMF.Free;
  end;
end;
 
 
procedure TRtfFile.AddMetaFile(wmfname: string; ScaleValue: single);
var
  wmf: file;
  PString : Pchar;
  ByteStr: array[1..3] of byte;
  i, numread: integer;
  block: array[1..128] of byte;
  dummy1: array[1..6] of byte;
  dummy2: array[1..8] of byte;
  x, y: word;
  x1, y1: word;
  WOverH : double;
  DoelW, DoelH : double;
begin
  assign(wmf, wmfname);
  PString := StrAlloc(256);
  try
    reset(wmf, 1);
 
    { header lesen }
    blockread(wmf, dummy1, 6);
    blockread(wmf, x1, 2); { obere, linke Ecke, immer 0 }
    blockread(wmf, y1, 2);
    blockread(wmf, x, 2); { untere, rechte Ecke, immer 0 }
    blockread(wmf, y, 2);
    blockread(wmf, dummy2, 8);
    WriteText('{\pict\wmetafile8');
 
    if Word2000Rtf then
     begin
      if ScaleValue < 0 then
       begin
        DoelW := x * 5.67  * abs(ScaleValue) / 300;
        DoelH := y * 5.67  * abs(ScaleValue) / 300;
       end
      else
       begin
        WOverH := x / y;
        DoelW := fWidth - fLeftMargin - fRightMargin - 0.5;
        DoelH := DoelW / WOverH;
        if DoelH > fHeight - fUpperMargin - fLowerMargin - 3 then
         begin
          DoelH := fHeight - fUpperMargin - fLowerMargin - 3;
          DoelW := DoelH * WoverH;
         end;
       end;
       if (DoelW > 31.5) then
        begin
         WOverH := DoelW / DoelH;
         DoelW := 31.5;
         DoelH := DoelW / WOverH;
        end;
       if (DoelH > 31.5) then
        begin
         WOverH := DoelW / DoelH;
         DoelH := 31.5;
         DoelW := DoelH * WOverH;
        end;
       WriteText('\picw' + IntToStr(round(DoelW * 1000)));
       WriteText('\pich' + IntToStr(round(DoelH * 1000)));
     end
    else
     begin
      WriteText('\picwgoal' + IntToStr(round(x * 5.67 * abs(ScaleValue))));
      WriteText('\pichgoal' + IntToStr(round(y * 5.67 * abs(ScaleValue))));
     end;
 
    WriteTextLn('');
 
     repeat
      blockread(wmf, block, 127, Numread);
      StrCopy(PString, '');
      for i := 1 to numread do
      begin
        StrPCopy(@ByteStr, DecToHex(block[i]));
        StrCat(PString, @ByteStr);
      end;
      WriteTextLn(StrPas(PString));
    until eof(wmf) or (Numread < 127);
  except
    on exception do
      ShowMessage('WMF-bestand kan niet worden ingelezen.');
  end;
  close(wmf);
  StrDispose(PString);
  WriteTextLn('}');
end;

Mais bien entendu ces procédure sont non utilisables dans VCL.Net

**Laurent Dardenne** · 26/09/2006, 17h38

Envoyé par emmanuelc

Mais bien entendu ces procédure sont non utilisables dans VCL.Net

Il te faut les adapter.

Quelles sont celles qui pose pb ? et pour quelles raisons ?

**emmanuelc** · 27/09/2006, 17h05

Bonjour.

Tout d'abord, il n'est plus possible d'utiliser des variables PChar et File.

Bien entendu les procédures dérivées telles que StrAlloc ou blockread, StrCopy,... ne fonctionnent pas.

Je sais bien que programmer avec VCL.Net ne me permet plus directement d'utiliser des fichiers binaires de la même façon qu'avec Win32. J'ai bien trouvé des méthodes pour malgré tout utiliser des fichiers binaires mais dans le cas précis qui m'occupê, cela me semble assez fastitieux. Je suppose qu'il existe une méthode plus directe.

J'ai également essayé d'autres types de procédures mais ces dernières utilisaient des pointeurs non souhaitables avec VCL.Net.

**flash_math** · 27/09/2006, 23h03

Pourquoi ne pas utiliser Interop ? Ce qui te permettrait d'appeler du code Win32 à partir de ton code .Net ?

Ta procédure est enregistrée dans une dll win32 et est appelé par ton code .Net.

**emmanuelc** · 28/09/2006, 13h43

C'est effectivement une solution mais j'essaie de ne plus utiliser de code Win32 car il s'agit d'un nouveau projet que l'on souhaite totalement compatible pour .NET (y compris toutes les dll utilisées).

Toutefois, sans autre solution, je serai bien forcé de le faire mais je trouverai cela dommage.

Pour me dépanner temporairement, je vais utiliser une DLL Win32. Mais je reste à l'affût de toute solution full compatible .Net.

**Laurent Dardenne** · 28/09/2006, 16h07

Regarde si la Classe System.Drawing.Imaging.Metafile peut t'aider.

**emmanuelc** · 03/10/2006, 16h39

Voici une solution trouvée :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
procedure TRtfFile.WmfKU(wmfname: string; ScaleValue: single);
var
  wmf: tFileStream;
  ByteStr: array[1..3] of byte;
  i, numread: integer;
  block: array[1..128] of byte;
  dummy1: array[1..6] of byte;
  dummy2: array[1..8] of byte;
  x, y: word;
  x1, y1: word;
  WOverH : double;
  DoelW, DoelH : double;
  aString : string;
 
begin
  wmf := TFileStream.Create(wmfname, fmOpenRead);
  try
    try
       wmf.ReadBuffer(dummy1, 6);
      wmf.ReadBuffer(x1, 2); { obere, linke Ecke, immer 0 }
      wmf.ReadBuffer(y1, 2);
      wmf.ReadBuffer(x, 2); { untere, rechte Ecke, immer 0 }
      wmf.ReadBuffer(y, 2);
      wmf.ReadBuffer(dummy2, 8);
      WriteText('{\pict\wmetafile8');
 
      if Word2000Rtf then
      begin
        if ScaleValue < 0 then
        begin
          DoelW := x * 5.67  * abs(ScaleValue) / 300;
          DoelH := y * 5.67  * abs(ScaleValue) / 300;
        end
        else
        begin
          WOverH := x / y;
          DoelW := fWidth - fLeftMargin - fRightMargin - 0.5;
          DoelH := DoelW / WOverH;
          if DoelH > fHeight - fUpperMargin - fLowerMargin - 3 then
          begin
            DoelH := fHeight - fUpperMargin - fLowerMargin - 3;
            DoelW := DoelH * WoverH;
          end;
        end;
        if (DoelW > 31.5) then
        begin
          WOverH := DoelW / DoelH;
          DoelW := 31.5;
          DoelH := DoelW / WOverH;
        end;
        if (DoelH > 31.5) then
        begin
          WOverH := DoelW / DoelH;
          DoelH := 31.5;
          DoelW := DoelH * WOverH;
        end;
        WriteText('\picw' + IntToStr(round(DoelW * 1000)));
        WriteText('\pich' + IntToStr(round(DoelH * 1000)));
      end
      else
      begin
        WriteText('\picwgoal' + IntToStr(round(x * 5.67 * abs(ScaleValue))));
        WriteText('\pichgoal' + IntToStr(round(y * 5.67 * abs(ScaleValue))));
      end;
 
      WriteTextLn('');
 
      repeat
        numread := wmf.Read(Block, 127);
        aString := '';
        for i := 1 to numread do
          aString := aString + DecToHex(Block[i]);
        WriteTextLn(aString);
      until (wmf.Position >= (wmf.Size - 1)) or (numread < 127);
    except
      on exception do
        ShowMessage('WMF-file can not be read.');
    end;
  finally
    wmf.free;
  end;
  WriteTextLn('}');
end;
 
avec 
 
function TRtfFile.DecToHex(dec: byte): string;
 
  function IntToHexChar(i: byte): char;
  begin
    case i of
      0..9: IntToHexChar := chr(i + 48);
      10..15: IntToHexChar := chr(i + 87); { 55 für Großbuchstaben }
    else
      IntToHexChar := 'x';
    end;
  end;
 
begin
  DecToHex := IntToHexChar(dec div 16) + IntToHexChar(dec mod 16);
end;

**emmanuelc** · 03/10/2006, 16h42

petit complément d'info : la procédure appelée quelques messages antérieurs 'AddMetaFile' correspond à WmfKU dans le dernier message.

**emmanuelc** · 10/10/2006, 11h16

Voici une procédure, meilleure me semble-t-il, mais spécifique à un Bitmap.
(plus de création de fichier temporaire).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
procedure TRtfFile.AddBitmapInRTFFile(Bitmap : TBitmap; Word2000Rtf : boolean; ScaleValue : double = -1);
var
  hStream : TMemoryStream;
 
  wmf: tFileStream;
  ByteStr: array[1..3] of byte;
  i, numread: integer;
  block: array[1..128] of byte;
  x, y: word;
  WOverH : double;
  DoelW, DoelH : double;
  aString : string;
 
 
begin
  hStream := TMemoryStream.Create;
  try
    Bitmap.SaveToStream(hStream);
    try
      try
        x := Bitmap.Width;
        y := Bitmap.Height;
        WriteText('{\pict\wmetafile8\picbmp');
 
        if Word2000Rtf then
        begin
          if ScaleValue < 0 then
          begin
            DoelW := x * 5.67  * abs(ScaleValue) / 300;
            DoelH := y * 5.67  * abs(ScaleValue) / 300;
          end
          else
          begin
            WOverH := x / y;
            DoelW := fWidth - fLeftMargin - fRightMargin - 0.5;
            DoelH := DoelW / WOverH;
            if DoelH > fHeight - fUpperMargin - fLowerMargin - 3 then
            begin
              DoelH := fHeight - fUpperMargin - fLowerMargin - 3;
              DoelW := DoelH * WoverH;
            end;
          end;
          if (DoelW > 31.5) then
          begin
            WOverH := DoelW / DoelH;
            DoelW := 31.5;
            DoelH := DoelW / WOverH;
          end;
          if (DoelH > 31.5) then
          begin
            WOverH := DoelW / DoelH;
            DoelH := 31.5;
            DoelW := DoelH * WOverH;
          end;
          WriteText('\picw' + IntToStr(round(DoelW * 1000)));
          WriteText('\pich' + IntToStr(round(DoelH * 1000)));
        end
        else
        begin
          WriteText('\picwgoal' + IntToStr(round(x * 5.67 * abs(ScaleValue))));
          WriteText('\pichgoal' + IntToStr(round(y * 5.67 * abs(ScaleValue))));
        end;
 
        WriteTextLn('');
 
        hStream.Position := 0;
        repeat
          numread := hStream.Read(Block, 127);
          aString := '';
          for i := 1 to numread do
            aString := aString + DecToHex(Block[i]);
          WriteTextLn(aString);
        until (hStream.Position >= (hStream.Size - 1)) or (numread < 127);
      except
        on exception do
          ShowMessage('TMemoryStream can not be read.');
      end;
    finally
      wmf.free;
    end;
    WriteTextLn('}');
 
  finally
    hStream.Free;
  end;
end;

**Laurent Dardenne** · 10/10/2006, 13h44

Merci d'utiliser les balises code.

VCL.Net Transfert Bitmap vers fichier RTF [Trucs & Astuces]

Delphi .NET

Discussions similaires

Partager

Partager