VCL.Net Transfert Bitmap vers fichier RTF

Version imprimable

22/09/2006, 16h53
emmanuelc

VCL.Net Transfert Bitmap vers fichier RTF

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
22/09/2006, 18h07
flash_math

Bonjour,

Heu tu utilisais quelle procédure ?

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:

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

26/09/2006, 17h38
Laurent Dardenne

Citation:

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 ?
27/09/2006, 17h05
emmanuelc

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.
27/09/2006, 23h03
flash_math

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.
28/09/2006, 13h43
emmanuelc

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.
28/09/2006, 16h07
Laurent Dardenne

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

Voici une solution trouvée :

Code:

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;

03/10/2006, 16h42
emmanuelc

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

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

Code:

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;

10/10/2006, 13h44
Laurent Dardenne

Merci d'utiliser les balises code.