← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/include/intfbasewinapi.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:
lcl/include/intfbasewinapi.inc
1
1
{%MainUnit ../interfacebase.pp}
2
2
 
3
 
{ $Id: intfbasewinapi.inc 27388 2010-09-16 19:02:43Z blikblum $ }
 
3
{ $Id: intfbasewinapi.inc 38824 2012-09-25 04:47:49Z paul $ }
4
4
{******************************************************************************
5
5
                                  TWidgetSet
6
6
 
28
28
//##apiwiz##sps##   // Do not remove
29
29
 
30
30
function TWidgetSet.Arc(DC: HDC;
31
 
  Left, Top, Right, Bottom, angle1, angle2: Integer): Boolean;
 
31
  Left, Top, Right, Bottom, Angle16Deg, Angle16DegLength: Integer): Boolean;
32
32
var
33
33
  Points : PPoint;
34
34
  Count : Longint;
36
36
  Result := False;
37
37
  Points := nil;
38
38
  Count := 0;
39
 
  PolyBezierArcPoints(Left, Top, Right-Left, Bottom-Top, Angle1, Angle2, 0,
 
39
  PolyBezierArcPoints(Left, Top, Right-Left, Bottom-Top, Angle16Deg, Angle16DegLength, 0,
40
40
                      Points, Count);
41
41
  Polyline(DC, Points, Count);
42
42
  ReallocMem(Points, 0);
136
136
  Result := 0;
137
137
end;
138
138
 
139
 
function TWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
 
139
function TWidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN;
140
140
begin
141
141
  Result:=ERROR;
142
142
  DebugLn('WARNING: CreateEllipticRgn not yet implemented.');
178
178
 
179
179
function TWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
180
180
  FillMode: integer): HRGN;
181
 
Begin
 
181
begin
182
182
  Result := 0;
183
183
end;
184
184
 
198
198
function TWidgetSet.CreateRoundRectRgn(X1, Y1, X2, Y2, nWidthEllipse, nHeightEllipse: Integer): HRGN;
199
199
var
200
200
  RoundRgn, CornerSquareRgn, CornerCutRgn: HRGN;
 
201
  nHalfX,nHalfY:integer;
201
202
begin
202
203
  Result := 0;
203
204
 
204
205
  // The resulting region
205
206
  Result := CreateRectRgn(X1, Y1, X2, Y2);
206
207
 
 
208
  nHalfX := nWidthEllipse div 2;
 
209
  nHalfY := nHeightEllipse div 2;
 
210
 
207
211
  // We create this region with dummy values just because
208
212
  // CombineRgn requires an existing region to receive the result
209
213
  CornerCutRgn := CreateRectRgn(0, 0, nWidthEllipse, nHeightEllipse);
210
214
 
211
215
  // Top-left corner
212
 
  RoundRgn := CreateEllipticRgn(X1, Y1, X1 + nWidthEllipse * 2, Y1 + nHeightEllipse * 2);
213
 
  CornerSquareRgn := CreateRectRgn(X1, Y1, X1 + nWidthEllipse, Y1 + nHeightEllipse);
 
216
  RoundRgn := CreateEllipticRgn(X1, Y1, X1 + nWidthEllipse, Y1 + nHeightEllipse);
 
217
  CornerSquareRgn := CreateRectRgn(X1, Y1, X1 + nHalfX, Y1 + nHalfY);
214
218
  CombineRgn(CornerCutRgn, RoundRgn, CornerSquareRgn, RGN_AND);
215
219
  CombineRgn(CornerCutRgn, CornerSquareRgn, CornerCutRgn, RGN_DIFF);
216
220
  CombineRgn(Result, Result, CornerCutRgn, RGN_DIFF);
218
222
  DeleteObject(CornerSquareRgn);
219
223
 
220
224
  // Bottom-left corner
221
 
  RoundRgn := CreateEllipticRgn(X1, Y2 - nHeightEllipse * 2, X1 + nWidthEllipse * 2, Y2);
222
 
  CornerSquareRgn := CreateRectRgn(X1, Y2 - nHeightEllipse, X1 + nWidthEllipse, Y2);
 
225
  RoundRgn := CreateEllipticRgn(X1, Y2 - nHeightEllipse, X1 + nWidthEllipse, Y2);
 
226
  CornerSquareRgn := CreateRectRgn(X1, Y2 - nHalfX, X1 + nHalfY, Y2);
223
227
  CombineRgn(CornerCutRgn, RoundRgn, CornerSquareRgn, RGN_AND);
224
228
  CombineRgn(CornerCutRgn, CornerSquareRgn, CornerCutRgn, RGN_DIFF);
225
229
  CombineRgn(Result, Result, CornerCutRgn, RGN_DIFF);
227
231
  DeleteObject(CornerSquareRgn);
228
232
 
229
233
  // Top-Right corner
230
 
  RoundRgn := CreateEllipticRgn(X2 - nWidthEllipse * 2 , Y1, X2, Y1 + nHeightEllipse * 2);
231
 
  CornerSquareRgn := CreateRectRgn(X2 - nWidthEllipse, Y1, X2, Y1 + nHeightEllipse);
 
234
  RoundRgn := CreateEllipticRgn(X2 - nWidthEllipse, Y1, X2, Y1 + nHeightEllipse);
 
235
  CornerSquareRgn := CreateRectRgn(X2 - nHalfX, Y1, X2, Y1 + nHalfY);
232
236
  CombineRgn(CornerCutRgn, RoundRgn, CornerSquareRgn, RGN_AND);
233
237
  CombineRgn(CornerCutRgn, CornerSquareRgn, CornerCutRgn, RGN_DIFF);
234
238
  CombineRgn(Result, Result, CornerCutRgn, RGN_DIFF);
236
240
  DeleteObject(CornerSquareRgn);
237
241
 
238
242
  // Bottom-Right corner
239
 
  RoundRgn := CreateEllipticRgn(X2 - nWidthEllipse * 2, Y2 - nHeightEllipse * 2, X2, Y2);
240
 
  CornerSquareRgn := CreateRectRgn(X2 - nWidthEllipse, Y2 - nHeightEllipse, X2, Y2);
 
243
  RoundRgn := CreateEllipticRgn(X2 - nWidthEllipse, Y2 - nHeightEllipse, X2, Y2);
 
244
  CornerSquareRgn := CreateRectRgn(X2 - nHalfX, Y2 - nHalfY, X2, Y2);
241
245
  CombineRgn(CornerCutRgn, RoundRgn, CornerSquareRgn, RGN_AND);
242
246
  CombineRgn(CornerCutRgn, CornerSquareRgn, CornerCutRgn, RGN_DIFF);
243
247
  CombineRgn(Result, Result, CornerCutRgn, RGN_DIFF);
334
338
end;
335
339
 
336
340
function TWidgetSet.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean;
337
 
Begin
 
341
begin
338
342
  Result := False;
339
343
end;
340
344
 
765
769
end;
766
770
 
767
771
function TWidgetSet.EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
768
 
Begin
 
772
begin
769
773
  Result:=1;
770
774
end;
771
775
 
864
868
  //  ' Clip=',DbgS(Clip),8),' RGn=',DbgS(Cardinal(RGN),' Mode=',dbgs(Mode));
865
869
  Result := CombineRGN(Clip, OldC, RGN, Mode);
866
870
  //DebugLn('TWidgetSet.ExtSelectClipRGN B Result=',Result);
867
 
  If Result <> ERROR then
 
871
  if Result <> ERROR then
868
872
    Result := SelectClipRGN(DC, Clip);
869
873
  DeleteObject(Clip);
870
874
  DeleteObject(OldC);
1088
1092
  Result := 0;
1089
1093
end;
1090
1094
 
 
1095
{ Returns in MaxCount how many characters fit into a given MaxWidth
 
1096
  It also returns the width of each character
 
1097
 
 
1098
  MaxCount is given in the number of UTF-8 characters, not bytes
 
1099
}
1091
1100
function TWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar;
1092
1101
  Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger;
1093
1102
  var Size: TSize): Boolean;
 
1103
var
 
1104
  lPasStr, lCurSubStr: String;
 
1105
  lPasStrLen, i: PtrInt;
 
1106
  lCurSize: TSize;
 
1107
  lBestFitFound: Boolean = False;
1094
1108
begin
1095
 
  if MaxCount<>nil then MaxCount^:=Count;
1096
 
  if PartialWidths<>nil then
1097
 
    DebugLn('Warning: TWidgetSet.GetTextExtentExPoint PartialWidths not implemented yet');
 
1109
  // First obtain the size information which duplicates GetTextExtentPoint
1098
1110
  Result := GetTextExtentPoint(DC,Str,Count,Size);
 
1111
  // Now calculate MaxCount and PartialWidths
 
1112
  lPasStr := StrPas(Str);
 
1113
  if (Str = nil) or (Count <= 0) or (lPasStr = '') then
 
1114
  begin
 
1115
    Result := False;
 
1116
    if MaxCount <> nil then
 
1117
      MaxCount^ := 0;
 
1118
    exit;
 
1119
  end;
 
1120
  lPasStrLen := UTF8Length(lPasStr);
 
1121
  for i := 1 to lPasStrLen do
 
1122
  begin
 
1123
    if (not lBestFitFound) then
 
1124
    begin
 
1125
      lCurSubStr := UTF8Copy(lPasStr, 1, i);
 
1126
      Self.GetTextExtentPoint(DC, PChar(lCurSubStr), Length(lCurSubStr), lCurSize);
 
1127
 
 
1128
      // Calculate the summed partial widths
 
1129
      if PartialWidths<>nil then PartialWidths[i-1] := lCurSize.cx;
 
1130
 
 
1131
      // Calculate the width until the utilized size gets bigger then the desired one
 
1132
      // Give up when the size surpases MaxWidth to be faster
 
1133
      if (MaxCount <> nil) then
 
1134
      begin
 
1135
        if lCurSize.cx <= MaxWidth then MaxCount^ := i
 
1136
        else lBestFitFound := True;
 
1137
      end;
 
1138
    end;
 
1139
  end;
1099
1140
end;
1100
1141
 
 
1142
// Note that Count is the number of bytes in the utf-8 encoded string Str
1101
1143
function TWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer;
1102
1144
  var Size: TSize): Boolean;
1103
1145
begin
1156
1198
  Result := 0;
1157
1199
end;
1158
1200
 
1159
 
function TWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
1160
 
  NumVertices : Longint; Meshes: Pointer; NumMeshes : Longint;
1161
 
  Mode : Longint): Boolean;
 
1201
{------------------------------------------------------------------------------
 
1202
  Function: GradientFill
 
1203
  Params: DC - DeviceContext to perform on
 
1204
          Vertices - array of Points W/Color & Alpha
 
1205
          NumVertices - Number of Vertices
 
1206
          Meshes - array of Triangle or Rectangle Meshes,
 
1207
                   each mesh representing one Gradient Fill
 
1208
          NumMeshes - Number of Meshes
 
1209
          Mode - Gradient Type, either Triangle,
 
1210
                 Vertical Rect, Horizontal Rect
 
1211
 
 
1212
  Returns: true on success
 
1213
 
 
1214
  Performs multiple Gradient Fills, either a Three way Triangle Gradient,
 
1215
  or a two way Rectangle Gradient, each Vertex point also supports optional
 
1216
  Alpha/Transparency for more advanced Gradients.
 
1217
 ------------------------------------------------------------------------------}
 
1218
function TWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices: Longint;
 
1219
  Meshes: Pointer; NumMeshes: Longint; Mode: Longint): Boolean;
 
1220
 
 
1221
  function DoFillTriangle: Boolean; inline;
 
1222
  begin
 
1223
    Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE;
 
1224
  end;
 
1225
 
 
1226
  function DoFillVRect: Boolean; inline;
 
1227
  begin
 
1228
    Result := (Mode and GRADIENT_FILL_RECT_V) = GRADIENT_FILL_RECT_V;
 
1229
  end;
 
1230
 
 
1231
  function CreateIntfImage(W, H: Integer; Clear: Boolean): TLazIntfImage;
 
1232
  begin
 
1233
    Result := TLazIntfImage.Create(W, H, [riqfRGB, riqfAlpha, riqfUpdate]);
 
1234
    Result.CreateData;
 
1235
    if Clear then
 
1236
      Result.FillPixels(FPColor(0, 0, 0, $0000));
 
1237
  end;
 
1238
 
 
1239
  procedure DrawIntfImage(Image: TLazIntfImage; R: TRect);
 
1240
  var
 
1241
    Bmp, Mask, Old: HBitmap;
 
1242
    BmpDC: HDC;
 
1243
  begin
 
1244
    Image.CreateBitmaps(Bmp, Mask, True);
 
1245
    BmpDC := CreateCompatibleDC(0);
 
1246
    Old := SelectObject(BmpDC, Bmp);
 
1247
    MaskBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, BmpDC, 0, 0, Mask, 0, 0);
 
1248
    DeleteObject(SelectObject(BmpDC, Old));
 
1249
    if Mask <> 0 then
 
1250
      DeleteObject(Mask);
 
1251
    DeleteDC(BmpDC);
 
1252
  end;
 
1253
 
 
1254
  function GetRectangleGradientColor(const BeginColor, EndColor: TFPColor; const Position, TotalSteps: Longint): TFPColor; inline;
 
1255
  var
 
1256
    A1: Word absolute BeginColor.alpha;
 
1257
    R1: Word absolute BeginColor.red;
 
1258
    G1: Word absolute BeginColor.green;
 
1259
    B1: Word absolute BeginColor.blue;
 
1260
    A2: Word absolute Endcolor.alpha;
 
1261
    R2: Word absolute Endcolor.red;
 
1262
    G2: Word absolute Endcolor.green;
 
1263
    B2: Word absolute Endcolor.blue;
 
1264
  begin
 
1265
    Result.alpha := (A1 + (Position * (A2 - A1) div TotalSteps));
 
1266
    Result.red := (R1 + (Position * (R2 - R1) div TotalSteps));
 
1267
    Result.green := (G1 + (Position * (G2 - G1) div TotalSteps));
 
1268
    Result.blue := (B1 + (Position * (B2 - B1) div TotalSteps));
 
1269
  end;
 
1270
 
 
1271
  function GetTriangleBounds(const v1, v2, v3: TTriVertex): TRect;
 
1272
  begin
 
1273
    with v1, Result do
 
1274
    begin
 
1275
      Left := x;
 
1276
      Top := y;
 
1277
      BottomRight := TopLeft;
 
1278
    end;
 
1279
    with v2, Result do
 
1280
    begin
 
1281
      if x < Left then
 
1282
        Left := x;
 
1283
      if x > Right then
 
1284
        Right := x;
 
1285
      if y < Top then
 
1286
        Top := y;
 
1287
      if y > Bottom then
 
1288
        Bottom := y;
 
1289
    end;
 
1290
    with v3, Result do
 
1291
    begin
 
1292
      if x < Left then
 
1293
        Left := x;
 
1294
      if x > Right then
 
1295
        Right := x;
 
1296
      if y < Top then
 
1297
        Top := y;
 
1298
      if y > Bottom then
 
1299
        Bottom := y;
 
1300
    end;
 
1301
  end;
 
1302
 
 
1303
  {
 
1304
    implementation of Arjen Nienhuis:
 
1305
    http://www.winehq.org/pipermail/wine-patches/2003-June/006544.html
 
1306
    Arjen has granted us the rights to include this code with our modified LGPL2 license
 
1307
  }
 
1308
 
 
1309
  procedure GradientFillTriangle(Image: TLazIntfImage; v1, v2, v3: TTriVertex);
 
1310
  var
 
1311
    t, v: TTriVertex;
 
1312
    y, y2, dy, dy2: Integer;
 
1313
    x, x1, x2, r1, r2, g1, g2, b1, b2: Integer;
 
1314
    dx: Integer;
 
1315
  begin
 
1316
    if (v1.y > v2.y) then
 
1317
    begin
 
1318
      t := v1;
 
1319
      v1 := v2;
 
1320
      v2 := t;
 
1321
    end;
 
1322
 
 
1323
    if (v2.y > v3.y) then
 
1324
    begin
 
1325
      t := v2;
 
1326
      v2 := v3;
 
1327
      v3 := t;
 
1328
      if (v1.y > v2.y) then
 
1329
      begin
 
1330
        t := v1;
 
1331
        v1 := v2;
 
1332
        v2 := t;
 
1333
      end;
 
1334
    end;
 
1335
    // v1.y <= v2.y <= v3.y
 
1336
    dy := v3.y - v1.y;
 
1337
    for y := 0 to dy - 1 do
 
1338
    begin
 
1339
      // v1.y <= y < v3.y
 
1340
      if y < (v2.y - v1.y) then
 
1341
        v :=  v1
 
1342
      else
 
1343
        v := v3;
 
1344
      // (v.y <= y < v2.y) || (v2.y <= y < v.y)
 
1345
      dy2 := v2.y - v.y;
 
1346
      y2 := y + v1.y - v.y;
 
1347
      x1 := (v3.x     * y  + v1.x     * (dy  - y )) div dy;
 
1348
      x2 := (v2.x     * y2 + v. x     * (dy2 - y2)) div dy2;
 
1349
      r1 := (v3.Red   * y  + v1.Red   * (dy  - y )) div dy;
 
1350
      r2 := (v2.Red   * y2 + v. Red   * (dy2 - y2)) div dy2;
 
1351
      g1 := (v3.Green * y  + v1.Green * (dy  - y )) div dy;
 
1352
      g2 := (v2.Green * y2 + v. Green * (dy2 - y2)) div dy2;
 
1353
      b1 := (v3.Blue  * y  + v1.Blue  * (dy  - y )) div dy;
 
1354
      b2 := (v2.Blue  * y2 + v. Blue  * (dy2 - y2)) div dy2;
 
1355
      if (x1 < x2) then
 
1356
      begin
 
1357
        dx := x2 - x1;
 
1358
        for x := 0 to dx - 1 do
 
1359
          Image.Colors[x + x1, y + v1.y] := FPColor(
 
1360
            (r1 * (dx - x) + r2 * x) div dx,
 
1361
            (g1 * (dx - x) + g2 * x) div dx,
 
1362
            (b1 * (dx - x) + b2 * x) div dx);
 
1363
      end
 
1364
      else
 
1365
      begin
 
1366
        dx := x1 - x2;
 
1367
        for x := 0 to dx - 1 do
 
1368
          Image.Colors[x + x2, y + v1.y] := FPColor(
 
1369
            (r2 * (dx - x) + r1 * x) div dx,
 
1370
            (g2 * (dx - x) + g1 * x) div dx,
 
1371
            (b2 * (dx - x) + b1 * x) div dx);
 
1372
      end;
 
1373
    end;
 
1374
  end;
 
1375
 
 
1376
 
 
1377
  function FillTriMesh(Mesh: TGradientTriangle): Boolean;
 
1378
  var
 
1379
    v1, v2, v3: TTriVertex;
 
1380
    R: TRect;
 
1381
    Image: TLazIntfImage;
 
1382
  begin
 
1383
    with Mesh do
 
1384
    begin
 
1385
      Result :=
 
1386
        (Vertex1 < Cardinal(NumVertices)) and (Vertex1 >= 0) and
 
1387
        (Vertex2 < Cardinal(NumVertices)) and (Vertex2 >= 0) and
 
1388
        (Vertex3 < Cardinal(NumVertices)) and (Vertex3 >= 0);
 
1389
 
 
1390
      if (Vertex1 = Vertex2) or (Vertex1 = Vertex3) or (Vertex2 = Vertex3) or not Result then
 
1391
        Exit;
 
1392
    end;
 
1393
 
 
1394
    v1 := Vertices[Mesh.Vertex1];
 
1395
    v2 := Vertices[Mesh.Vertex2];
 
1396
    v3 := Vertices[Mesh.Vertex3];
 
1397
    R := GetTriangleBounds(v1, v2, v3);
 
1398
    with R do
 
1399
    begin
 
1400
      dec(v1.x, Left);
 
1401
      dec(v2.x, Left);
 
1402
      dec(v3.x, Left);
 
1403
 
 
1404
      dec(v1.y, Top);
 
1405
      dec(v2.y, Top);
 
1406
      dec(v3.y, Top);
 
1407
    end;
 
1408
 
 
1409
    Image := CreateIntfImage(R.Right - R.Left, R.Bottom - R.Top, True);
 
1410
    GradientFillTriangle(Image, v1, v2, v3);
 
1411
    DrawIntfImage(Image, R);
 
1412
    Image.Free;
 
1413
    Result := True;
 
1414
  end;
 
1415
 
 
1416
  function FillRectMesh(Mesh: TGradientRect): Boolean;
 
1417
  var
 
1418
    TL, BR: TTriVertex;
 
1419
    StartColor, EndColor, CurColor: TFPColor;
 
1420
    I, J: Longint;
 
1421
    SwapColors: Boolean;
 
1422
    Steps: Integer;
 
1423
    Image: TLazIntfImage;
 
1424
    R: TRect;
 
1425
  begin
 
1426
    with Mesh do
 
1427
    begin
 
1428
      Result := (UpperLeft < Cardinal(NumVertices)) and (LowerRight < Cardinal(NumVertices));
 
1429
      if (LowerRight = UpperLeft) or not Result then
 
1430
        Exit;
 
1431
      TL := Vertices[UpperLeft];
 
1432
      BR := Vertices[LowerRight];
 
1433
      SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X);
 
1434
      if BR.X < TL.X then
 
1435
      begin
 
1436
        I := BR.X;
 
1437
        BR.X := TL.X;
 
1438
        TL.X := I;
 
1439
      end;
 
1440
      if BR.Y < TL.Y then
 
1441
      begin
 
1442
        I := BR.Y;
 
1443
        BR.Y := TL.Y;
 
1444
        TL.Y := I;
 
1445
      end;
 
1446
      StartColor := FPColor(TL.Red, TL.Green, TL.Blue);
 
1447
      EndColor := FPColor(BR.Red, BR.Green, BR.Blue);
 
1448
      if SwapColors then
 
1449
      begin
 
1450
        CurColor := StartColor;
 
1451
        StartColor := EndColor;
 
1452
        EndColor := CurColor;
 
1453
      end;
 
1454
 
 
1455
      R := Rect(TL.X, TL.Y, BR.X, BR.Y);
 
1456
      dec(BR.X, TL.X);
 
1457
      dec(BR.Y, TL.Y);
 
1458
      TL.X := 0;
 
1459
      TL.Y := 0;
 
1460
      Image := CreateIntfImage(BR.X, BR.Y, False);
 
1461
 
 
1462
      if DoFillVRect then
 
1463
      begin
 
1464
        Steps := BR.Y;
 
1465
        for I := 0 to Steps - 1 do
 
1466
        begin
 
1467
          CurColor := GetRectangleGradientColor(StartColor, EndColor, I, Steps);
 
1468
          for J := TL.X to BR.X - 1 do
 
1469
            Image.Colors[J, I] := CurColor;
 
1470
        end
 
1471
      end
 
1472
      else
 
1473
      begin
 
1474
        Steps := BR.X;
 
1475
        for I := 0 to Steps - 1 do
 
1476
        begin
 
1477
          CurColor := GetRectangleGradientColor(StartColor, EndColor, I, Steps);
 
1478
          for J := TL.Y to BR.Y - 1 do
 
1479
            Image.Colors[I, J] := CurColor;
 
1480
        end;
 
1481
      end;
 
1482
      DrawIntfImage(Image, R);
 
1483
      Image.Free;
 
1484
    end;
 
1485
  end;
 
1486
 
 
1487
const
 
1488
  MeshSize: array[Boolean] of PtrUInt = (
 
1489
    SizeOf(tagGradientRect),
 
1490
    SizeOf(tagGradientTriangle)
 
1491
  );
 
1492
var
 
1493
  I : Integer;
1162
1494
begin
1163
 
  Result := False;
 
1495
  Result := Assigned(Meshes) and (NumMeshes >= 1) and (NumVertices >= 2) and Assigned(Vertices);
 
1496
  if Result and DoFillTriangle then
 
1497
    Result := NumVertices >= 3;
 
1498
  if Result then
 
1499
  begin
 
1500
    Result := False;
 
1501
 
 
1502
    //Sanity Checks For Vertices Size vs. Count
 
1503
    if MemSize(Vertices) < PtrUInt(SizeOf(TTriVertex) * NumVertices) then
 
1504
      Exit;
 
1505
 
 
1506
    //Sanity Checks For Meshes Size vs. Count
 
1507
    if MemSize(Meshes) < (MeshSize[DoFillTriangle] * Cardinal(NumMeshes)) then
 
1508
      Exit;
 
1509
 
 
1510
    for I := 0 to NumMeshes - 1 do
 
1511
    begin
 
1512
      if DoFillTriangle then
 
1513
      begin
 
1514
        if not FillTriMesh(PGradientTriangle(Meshes)[I]) then
 
1515
          exit;
 
1516
      end
 
1517
      else
 
1518
      begin
 
1519
        if not FillRectMesh(PGradientRect(Meshes)[I]) then
 
1520
          exit;
 
1521
      end;
 
1522
    end;
 
1523
    Result := True;
 
1524
  end;
1164
1525
end;
1165
1526
 
1166
1527
function TWidgetSet.HideCaret(hWnd: HWND): Boolean;
1179
1540
  Result := (Shift = []) and (Key = VK_F1);
1180
1541
end;
1181
1542
 
1182
 
function TWidgetSet.AppHandle: Thandle;
1183
 
begin
1184
 
  DebugLn('Warning: AppHandle is not implemented for this widgetset yet');
1185
 
  result := 0;
1186
 
end;
1187
 
 
1188
1543
procedure TWidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection);
1189
1544
begin
1190
1545
  DebugLn('TWidgetSet.InitializeCriticalSection Not implemented yet');
1191
1546
end;
1192
1547
 
1193
 
function TWidgetSet.IntersectClipRect(dc: hdc;
1194
 
  Left, Top, Right, Bottom: Integer): Integer;
 
1548
function TWidgetSet.IntersectClipRect(DC: HDC; Left, Top, Right, Bottom: Integer): Integer;
1195
1549
var
1196
 
  RRGN : hRGN;
 
1550
  R: TRect;
 
1551
  RRGN: hRGN;
1197
1552
begin
1198
 
  RRGN := CreateRectRgn(Left, Top, Right, Bottom);
1199
 
  //DebugLn('TWidgetSet.IntersectClipRect A RGN=',DbgS(RRGN),
1200
 
  //  ' ',dbgs(Left),',',dbgs(Top),',',dbgs(Right),',',dbgs(Bottom));
1201
 
  If not DCClipRegionValid(DC) then
 
1553
  R := Rect(Left, Top, Right, Bottom);
 
1554
  LPtoDP(DC, R, 2);
 
1555
  with R do
 
1556
    RRGN := CreateRectRgn(Left, Top, Right, Bottom);
 
1557
  if not DCClipRegionValid(DC) then
1202
1558
    Result := SelectClipRGN(DC, RRGN)
1203
1559
  else
1204
1560
    Result := ExtSelectClipRGN(DC, RRGN, RGN_AND);
1303
1659
  Result := False;
1304
1660
end;
1305
1661
 
 
1662
function TWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
 
1663
begin
 
1664
  Result := Error;
 
1665
end;
 
1666
 
1306
1667
function TWidgetSet.PeekMessage(var lpMsg : TMsg; Handle : HWND;
1307
1668
  wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
1308
 
Begin
 
1669
begin
1309
1670
  Result := False;
1310
 
End;
 
1671
end;
1311
1672
 
1312
1673
function TWidgetSet.Pie(DC: HDC; x1, y1, x2, y2,
1313
1674
                        sx, sy, ex, ey: Integer): Boolean;
1323
1684
var
1324
1685
  APoints : PPoint;
1325
1686
  ACount : Longint;
1326
 
Begin
 
1687
begin
1327
1688
  APoints := nil;
1328
1689
  ACount := 0;
1329
1690
  PolyBezier2Polyline(Points,NumPts,APoints,ACount,Continuous);
1408
1769
end;
1409
1770
 
1410
1771
function TWidgetSet.ReleaseCapture : Boolean;
1411
 
Begin
 
1772
begin
1412
1773
  Result := True;
1413
1774
end;
1414
1775
 
1602
1963
 
1603
1964
function TWidgetSet.SetProp(Handle: hwnd; Str : PChar;
1604
1965
  Data : Pointer) : Boolean;
1605
 
Begin
 
1966
begin
1606
1967
  Result := True;
1607
1968
end;
1608
1969
 
1663
2024
 
1664
2025
function TWidgetSet.SetWindowOrgEx(dc : hdc; NewX, NewY : Integer;
1665
2026
  OldPoint: PPoint) : Boolean;
1666
 
Begin
 
2027
begin
1667
2028
  Result := False;
1668
2029
end;
1669
2030