Source/TntGraphics.pas

   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
  12 unit TntGraphics;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Graphics, Windows;
  20
  21 {TNT-WARN TextRect}
  22 procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
  23 {TNT-WARN TextOut}
  24 procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
  25 {TNT-WARN TextExtent}
  26 function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
  27 function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
  28 {TNT-WARN TextWidth}
  29 function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
  30 {TNT-WARN TextHeight}
  31 function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
  32
  33 type
  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
  41 implementation
  42
  43 uses
  44   SysUtils, TntSysUtils;
  45
  46 type
  47   TAccessCanvas = class(TCanvas);
  48
  49 procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
  50 var
  51   Options: Longint;
  52 begin
  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;
  65 end;
  66
  67 procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
  68 begin
  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;
  78 end;
  79
  80 function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
  81 begin
  82   Result.cx := 0;
  83   Result.cy := 0;
  84   Windows.GetTextExtentPoint32W(hDC, PWideChar(Text), Length(Text), Result);
  85 end;
  86
  87 function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
  88 begin
  89   with TAccessCanvas(Canvas) do begin
  90     RequiredState([csHandleValid, csFontValid]);
  91     Result := WideDCTextExtent(Handle, Text);
  92   end;
  93 end;
  94
  95 function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
  96 begin
  97   Result := WideCanvasTextExtent(Canvas, Text).cX;
  98 end;
  99
 100 function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
 101 begin
 102   Result := WideCanvasTextExtent(Canvas, Text).cY;
 103 end;
 104
 105 { TTntPicture }
 106
 107 procedure TTntPicture.LoadFromFile(const Filename: WideString);
 108 var
 109   ShortName: WideString;
 110 begin
 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));
 117 end;
 118
 119 procedure TTntPicture.SaveToFile(const Filename: WideString);
 120 var
 121   TempFile: WideString;
 122 begin
 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;
 140 end;
 141
 142 end.