summaryrefslogtreecommitdiff
path: root/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntGraphics.pas
blob: 617b901f77d3156a5ced9f95f9d52e3fa11b7b9d (plain)
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
{                                                                             }
{*****************************************************************************}

unit TntGraphics;

{$INCLUDE TntCompilers.inc}

interface

uses
  Graphics, Windows;

{TNT-WARN TextRect}
procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
{TNT-WARN TextOut}
procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
{TNT-WARN TextExtent}
function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
{TNT-WARN TextWidth}
function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
{TNT-WARN TextHeight}
function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;

type
{TNT-WARN TPicture}
  TTntPicture = class(TPicture{TNT-ALLOW TPicture})
  public
    procedure LoadFromFile(const Filename: WideString);
    procedure SaveToFile(const Filename: WideString);
  end;

implementation

uses
  SysUtils, TntSysUtils;

type
  TAccessCanvas = class(TCanvas);

procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
var
  Options: Longint;
begin
  with TAccessCanvas(Canvas) do begin
    Changing;
    RequiredState([csHandleValid, csFontValid, csBrushValid]);
    Options := ETO_CLIPPED or TextFlags;
    if Brush.Style <> bsClear then
      Options := Options or ETO_OPAQUE;
    if ((TextFlags and ETO_RTLREADING) <> 0) and
       (CanvasOrientation = coRightToLeft) then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
    Windows.ExtTextOutW(Handle, X, Y, Options, @Rect, PWideChar(Text),
      Length(Text), nil);
    Changed;
  end;
end;

procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
begin
  with TAccessCanvas(Canvas) do begin
    Changing;
    RequiredState([csHandleValid, csFontValid, csBrushValid]);
    if CanvasOrientation = coRightToLeft then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
    Windows.ExtTextOutW(Handle, X, Y, TextFlags, nil, PWideChar(Text),
     Length(Text), nil);
    MoveTo(X + WideCanvasTextWidth(Canvas, Text), Y);
    Changed;
  end;
end;

function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
begin
  Result.cx := 0;
  Result.cy := 0;
  Windows.GetTextExtentPoint32W(hDC, PWideChar(Text), Length(Text), Result);
end;

function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
begin
  with TAccessCanvas(Canvas) do begin
    RequiredState([csHandleValid, csFontValid]);
    Result := WideDCTextExtent(Handle, Text);
  end;
end;

function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
begin
  Result := WideCanvasTextExtent(Canvas, Text).cX;
end;

function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
begin
  Result := WideCanvasTextExtent(Canvas, Text).cY;
end;

{ TTntPicture }

procedure TTntPicture.LoadFromFile(const Filename: WideString);
var
  ShortName: WideString;
begin
  ShortName := WideExtractShortPathName(Filename);
  if WideSameText(WideExtractFileExt(FileName), '.jpeg') // the short name ends with ".JPE"!
  or (ShortName = '') then // GetShortPathName failed
    inherited LoadFromFile(FileName)
  else
    inherited LoadFromFile(WideExtractShortPathName(Filename));
end;

procedure TTntPicture.SaveToFile(const Filename: WideString);
var
  TempFile: WideString;
begin
  if Graphic <> nil then begin
    // create to temp file (ansi safe file name)
    repeat
      TempFile := WideExtractFilePath(Filename) + IntToStr(Random(MaxInt)) + WideExtractFileExt(Filename);
    until not WideFileExists(TempFile);
    CloseHandle(WideFileCreate(TempFile)); // make it a real file so that it has a temp
    try
      // save
      Graphic.SaveToFile(WideExtractShortPathName(TempFile));
      // rename
      WideDeleteFile(Filename);
      if not WideRenameFile(TempFile, FileName) then
        RaiseLastOSError;
    finally
      WideDeleteFile(TempFile);
    end;
  end;
end;

end.