source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntGraphics.pas@ 1286

Last change on this file since 1286 was 672, checked in by Kevin Toppenberg, 15 years ago

Adding source to tntControls for compilation

File size: 4.7 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntGraphics;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Graphics, Windows;
20
21{TNT-WARN TextRect}
22procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
23{TNT-WARN TextOut}
24procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
25{TNT-WARN TextExtent}
26function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
27function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
28{TNT-WARN TextWidth}
29function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
30{TNT-WARN TextHeight}
31function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
32
33type
34{TNT-WARN TPicture}
35 TTntPicture = class(TPicture{TNT-ALLOW TPicture})
36 public
37 procedure LoadFromFile(const Filename: WideString);
38 procedure SaveToFile(const Filename: WideString);
39 end;
40
41implementation
42
43uses
44 SysUtils, TntSysUtils;
45
46type
47 TAccessCanvas = class(TCanvas);
48
49procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
50var
51 Options: Longint;
52begin
53 with TAccessCanvas(Canvas) do begin
54 Changing;
55 RequiredState([csHandleValid, csFontValid, csBrushValid]);
56 Options := ETO_CLIPPED or TextFlags;
57 if Brush.Style <> bsClear then
58 Options := Options or ETO_OPAQUE;
59 if ((TextFlags and ETO_RTLREADING) <> 0) and
60 (CanvasOrientation = coRightToLeft) then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
61 Windows.ExtTextOutW(Handle, X, Y, Options, @Rect, PWideChar(Text),
62 Length(Text), nil);
63 Changed;
64 end;
65end;
66
67procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
68begin
69 with TAccessCanvas(Canvas) do begin
70 Changing;
71 RequiredState([csHandleValid, csFontValid, csBrushValid]);
72 if CanvasOrientation = coRightToLeft then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
73 Windows.ExtTextOutW(Handle, X, Y, TextFlags, nil, PWideChar(Text),
74 Length(Text), nil);
75 MoveTo(X + WideCanvasTextWidth(Canvas, Text), Y);
76 Changed;
77 end;
78end;
79
80function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
81begin
82 Result.cx := 0;
83 Result.cy := 0;
84 Windows.GetTextExtentPoint32W(hDC, PWideChar(Text), Length(Text), Result);
85end;
86
87function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
88begin
89 with TAccessCanvas(Canvas) do begin
90 RequiredState([csHandleValid, csFontValid]);
91 Result := WideDCTextExtent(Handle, Text);
92 end;
93end;
94
95function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
96begin
97 Result := WideCanvasTextExtent(Canvas, Text).cX;
98end;
99
100function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
101begin
102 Result := WideCanvasTextExtent(Canvas, Text).cY;
103end;
104
105{ TTntPicture }
106
107procedure TTntPicture.LoadFromFile(const Filename: WideString);
108var
109 ShortName: WideString;
110begin
111 ShortName := WideExtractShortPathName(Filename);
112 if WideSameText(WideExtractFileExt(FileName), '.jpeg') // the short name ends with ".JPE"!
113 or (ShortName = '') then // GetShortPathName failed
114 inherited LoadFromFile(FileName)
115 else
116 inherited LoadFromFile(WideExtractShortPathName(Filename));
117end;
118
119procedure TTntPicture.SaveToFile(const Filename: WideString);
120var
121 TempFile: WideString;
122begin
123 if Graphic <> nil then begin
124 // create to temp file (ansi safe file name)
125 repeat
126 TempFile := WideExtractFilePath(Filename) + IntToStr(Random(MaxInt)) + WideExtractFileExt(Filename);
127 until not WideFileExists(TempFile);
128 CloseHandle(WideFileCreate(TempFile)); // make it a real file so that it has a temp
129 try
130 // save
131 Graphic.SaveToFile(WideExtractShortPathName(TempFile));
132 // rename
133 WideDeleteFile(Filename);
134 if not WideRenameFile(TempFile, FileName) then
135 RaiseLastOSError;
136 finally
137 WideDeleteFile(TempFile);
138 end;
139 end;
140end;
141
142end.
Note: See TracBrowser for help on using the repository browser.