← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazutils/asiancodepagefunctions.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazutils/asiancodepagefunctions.inc
 
1
{%MainUnit ../lconvencoding.pp}
 
2
 
 
3
{******************************************************************************
 
4
                               Asian Unicode Functions
 
5
 ******************************************************************************
 
6
 
 
7
 *****************************************************************************
 
8
 *                                                                           *
 
9
 *  This file is part of the Lazarus Component Library (LCL)                 *
 
10
 *                                                                           *
 
11
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 
12
 *  for details about the copyright.                                         *
 
13
 *                                                                           *
 
14
 *  This program is distributed in the hope that it will be useful,          *
 
15
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 
16
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 
17
 *                                                                           *
 
18
 *****************************************************************************
 
19
 
 
20
  The clipboard is able to work with the windows and gtk behaviour/features.
 
21
}
 
22
 
 
23
function DBCSToUTF8(const s: string; CodeP: integer): string;
 
24
var
 
25
  len:  SizeInt;
 
26
  Src:  PChar;
 
27
  Dest: PChar;
 
28
  c:    char;
 
29
  l: Integer;
 
30
  code: word;
 
31
begin
 
32
  if s = '' then
 
33
  begin
 
34
    Result := s;
 
35
    exit;
 
36
  end;
 
37
  len := length(s);
 
38
  SetLength(Result, len * 4);// Asia UTF-8 is at most 4 bytes
 
39
  Src  := PChar(s);
 
40
  Dest := PChar(Result);
 
41
  repeat
 
42
    c := Src^;
 
43
    Inc(Src);
 
44
    if Ord(c) < 128 then
 
45
    begin
 
46
      if (c=#0) and (Src-PChar(s)>=len) then break;
 
47
      Dest^ := c;
 
48
      Inc(Dest);
 
49
    end
 
50
    else
 
51
    begin
 
52
      code := Byte(c) shl 8;
 
53
      c:=Src^;
 
54
      if (c=#0) and (Src-PChar(s)>=len) then break;
 
55
      code := code + Byte(c);
 
56
      Inc(Src);
 
57
 
 
58
      case CodeP of
 
59
        936:
 
60
          code := Uni936C[SearchTable(CP936CC, code)];
 
61
        950:
 
62
          code := Uni950C[SearchTable(CP950CC, code)];
 
63
        949:
 
64
          code := Uni949C[SearchTable(CP949CC, code)];
 
65
        932:
 
66
          code := Uni932C[SearchTable(CP932CC, code)];
 
67
        else
 
68
          code := 0;
 
69
      end;
 
70
 
 
71
      if code>0 then
 
72
      begin
 
73
        l:=UnicodeToUTF8Inline(code,Dest);
 
74
        inc(Dest,l);
 
75
      end;
 
76
    end;
 
77
  until false;
 
78
  SetLength(Result, {%H-}PtrUInt(Dest) - PtrUInt(Result));
 
79
end;
 
80
 
 
81
function CP936ToUTF8(const s: string): string;
 
82
begin
 
83
  Result := DBCSToUTF8(s, 936);
 
84
end;
 
85
 
 
86
function CP950ToUTF8(const s: string): string;
 
87
begin
 
88
  Result := DBCSToUTF8(s, 950);
 
89
end;
 
90
 
 
91
function CP949ToUTF8(const s: string): string;
 
92
begin
 
93
  Result := DBCSToUTF8(s, 949);
 
94
end;
 
95
 
 
96
function CP932ToUTF8(const s: string): string;
 
97
begin
 
98
  Result := DBCSToUTF8(s, 932);
 
99
end;
 
100
 
 
101
function UnicodeToCP936(Unicode: cardinal): integer;
 
102
begin
 
103
  case Unicode of
 
104
    0..127: Result := Unicode;
 
105
    else
 
106
      Result := CP936CU[SearchTable(Uni936U, Unicode)];
 
107
  end;
 
108
end;
 
109
 
 
110
function UnicodeToCP950(Unicode: cardinal): integer;
 
111
begin
 
112
  case Unicode of
 
113
    0..127: Result := Unicode;
 
114
    else
 
115
      Result := CP950CU[SearchTable(Uni950U, Unicode)];
 
116
  end;
 
117
end;
 
118
 
 
119
function UnicodeToCP949(Unicode: cardinal): integer;
 
120
begin
 
121
  case Unicode of
 
122
    0..127: Result := Unicode;
 
123
    else
 
124
      Result := CP949CU[SearchTable(Uni949U, Unicode)];
 
125
  end;
 
126
end;
 
127
 
 
128
function UnicodeToCP932(Unicode: cardinal): integer;
 
129
begin
 
130
  case Unicode of
 
131
    0..127: Result := Unicode;
 
132
    else
 
133
      Result := CP932CU[SearchTable(Uni932U, Unicode)];
 
134
  end;
 
135
end;
 
136
 
 
137
function UTF8ToDBCS(const s: string;
 
138
  const UTF8CharConvFunc: TUnicodeToCharID): string;
 
139
var
 
140
  len:  integer;
 
141
  Src:  PChar;
 
142
  Dest: PChar;
 
143
  c:    char;
 
144
  Unicode: longword;
 
145
  CharLen: integer;
 
146
  i:    integer;
 
147
begin
 
148
  if s = '' then
 
149
  begin
 
150
    Result := '';
 
151
    exit;
 
152
  end;
 
153
  len := length(s);
 
154
  SetLength(Result, len); // DBCS needs at most space as UTF-8
 
155
  Src  := PChar(s);
 
156
  Dest := PChar(Result);
 
157
  repeat
 
158
    c := Src^;
 
159
    if c < #128 then
 
160
    begin
 
161
      if (c=#0) and (Src-PChar(s)>=len) then break;
 
162
      Dest^ := c;
 
163
      Inc(Dest);
 
164
      Inc(Src);
 
165
    end
 
166
    else
 
167
    begin
 
168
      Unicode := UTF8CharacterToUnicode(Src, CharLen);
 
169
      Inc(Src, CharLen);
 
170
      i := UTF8CharConvFunc(Unicode);
 
171
      //writeln(Format('%X', [i]));
 
172
      if i >= 0 then
 
173
      begin
 
174
        if i > $ff then
 
175
        begin
 
176
          Dest^ := chr(i shr 8);
 
177
          Inc(Dest);
 
178
          Dest^ := chr(i);
 
179
        end
 
180
        else
 
181
          Dest^ := chr(i);
 
182
        Inc(Dest);
 
183
      end;
 
184
    end;
 
185
  until false;
 
186
  //SetLength(Result, Dest - PChar(Result));
 
187
  SetLength(Result, {%H-}PtrUInt(Dest) - PtrUInt(Result));
 
188
end;
 
189
 
 
190
function UTF8ToCP936(const s: string): string;
 
191
begin
 
192
  Result := UTF8ToDBCS(s, @UnicodeToCP936);
 
193
end;
 
194
 
 
195
function UTF8ToCP950(const s: string): string;
 
196
begin
 
197
  Result := UTF8ToDBCS(s, @UnicodeToCP950);
 
198
end;
 
199
 
 
200
function UTF8ToCP949(const s: string): string;
 
201
begin
 
202
  Result := UTF8ToDBCS(s, @UnicodeToCP949);
 
203
end;
 
204
 
 
205
function UTF8ToCP932(const s: string): string;
 
206
begin
 
207
  Result := UTF8ToDBCS(s, @UnicodeToCP932);
 
208
end;
 
209