Discussion :

[kem]

Bonsoir

J'aimerais écrire du texte dans un TImage selon un certain angle.
Contrainte : j'ai déjà une image chargée dans le TImage. Je veux donc que le texte puisse se superposer à cette image avec un fond transparent

Merci de votre aide.

[neilbgr]

Après une recherche avec

j'ai trouvé ceci :

http://www.scalabium.com/faq/dct0002.htm :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure AngleTextOut(ACanvas: TCanvas; Angle, X, Y: Integer; Str: string);
var
  LogRec: TLogFont;
  OldFontHandle,
  NewFontHandle: hFont;
begin
  GetObject(ACanvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
  LogRec.lfEscapement := Angle*10;
  NewFontHandle := CreateFontIndirect(LogRec);
  OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
  ACanvas.TextOut(X, Y, Str);
  NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
  DeleteObject(NewFontHandle);
end;

ou encore :

http://www.latiumsoftware.com/en/delphi/00046.php :

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
interface
 
uses Windows;
 
function CreateAngledFont(Font: HFont; Angle: Longint;
  Quality: byte = PROOF_QUALITY): HFont;
 
implementation
 
function CreateAngledFont(Font: HFont; Angle: Longint;
  Quality: byte): HFont;
var
  FontInfo: TLogFontA;    // Font information structure
begin
  // Get the information of the font passed as parameter
  if GetObject(Font, SizeOf(FontInfo), @FontInfo) = 0 then begin
    Result := 0;
    exit;
  end;
  // Set the angle
  FontInfo.lfEscapement := Angle;
  FontInfo.lfOrientation := Angle;
  // Set the quality
  FontInfo.lfQuality := Quality;
  // Create a new font with the modified information
  // The new font must be released calling DeleteObject
  Result := CreateFontIndirect(FontInfo);
end;
 
procedure TextOutA(Canvas: TCanvas; X, Y, Angle: Integer;
  Text: string);
var
  OriginalFont, AngledFont: HFont;
begin
  // Create an angled font from the current font
  AngledFont := CreateAngledFont(Canvas.Font.Handle, Angle);
  if AngledFont <> 0 then begin
    // Set it temporarily as the current font
    OriginalFont := SelectObject(Canvas.Handle, AngledFont);
    if OriginalFont <> 0 then begin
      // Write the text
      Canvas.TextOut(X, Y, Text);
      // Restore the original font
      if SelectObject(Canvas.Handle, OriginalFont) = 0 then begin
        Canvas.Font.Handle := AngledFont;
        // raise Exception.Create('Couldn''t restore font');
        exit;
      end;
    end;
    // Release the angled font
    DeleteObject(AngledFont)
  end;
end;

[kem]

La seconde procedure (TextOutA) a parfaitement marché
Merci