← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/win32/win32wsextctrls.pp

  • 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/interfaces/win32/win32wsextctrls.pp
36
36
// rtl
37
37
  Windows, CommCtrl, SysUtils, Classes,
38
38
// lcl
39
 
  ExtCtrls, Controls, ImgList, LCLType, LCLIntf, LCLProc, Themes, LCLMessageGlue,
 
39
  ExtCtrls, Controls, ImgList, LCLType, LCLIntf, LCLProc, Themes, LCLMessageGlue, ComCtrls, WSComCtrls,
40
40
// ws
41
41
  WSControls, WSExtCtrls, WSLCLClasses, WSProc, Win32Extra, Win32Int, Win32Proc,
42
42
  InterfaceBase, Win32WSControls;
43
43
 
44
44
type
45
 
 
46
 
  { TWin32WSCustomPage }
47
 
 
48
 
  TWin32WSCustomPage = class(TWSCustomPage)
49
 
  public
50
 
    class procedure ThemeChange(Wnd: HWND);
51
 
  published
52
 
    class function CreateHandle(const AWinControl: TWinControl;
53
 
          const AParams: TCreateParams): HWND; override;
54
 
    class procedure DestroyHandle(const AWinControl: TWinControl); override;
55
 
    class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
56
 
    class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
57
 
  end;
58
 
 
59
 
  { TWin32WSCustomNotebook }
60
 
 
61
 
  TWin32WSCustomNotebook = class(TWSCustomNotebook)
62
 
  published
63
 
    class function CreateHandle(const AWinControl: TWinControl;
64
 
          const AParams: TCreateParams): HWND; override;
65
 
    class procedure AddAllNBPages(const ANotebook: TCustomNotebook);
66
 
    class procedure AdjustSizeNotebookPages(const ANotebook: TCustomNotebook);
67
 
    class procedure AddPage(const ANotebook: TCustomNotebook;
68
 
      const AChild: TCustomPage; const AIndex: integer); override;
69
 
    class procedure MovePage(const ANotebook: TCustomNotebook;
70
 
      const AChild: TCustomPage; const NewIndex: integer); override;
71
 
    class procedure RemoveAllNBPages(const ANotebook: TCustomNotebook);
72
 
    class procedure RemovePage(const ANotebook: TCustomNotebook;
73
 
      const AIndex: integer); override;
74
 
 
75
 
    class function GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer; override;
76
 
    class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer; override;
77
 
    class function GetTabRect(const ANotebook: TCustomNotebook; const AIndex: Integer): TRect; override;
78
 
    class function GetCapabilities: TNoteBookCapabilities;override;
79
 
    class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
80
 
    class procedure SetImageList(const ANotebook: TCustomNotebook; const AImageList: TCustomImageList); override;
81
 
    class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
82
 
    class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
83
 
    class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
84
 
    class procedure UpdateProperties(const ANotebook: TCustomNotebook); override;
85
 
  end;
86
 
 
87
45
  { TWin32WSPage }
88
46
 
89
47
  TWin32WSPage = class(TWSPage)
199
157
    class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override;
200
158
  end;
201
159
 
202
 
procedure NotebookFocusNewControl(const ANotebook: TCustomNotebook; NewIndex: integer);
203
 
function NotebookPageRealToLCLIndex(const ANotebook: TCustomNotebook; AIndex: integer): integer;
204
 
 
205
160
implementation
206
161
 
207
162
uses
208
163
  Forms, LMessages, ShellAPI;
209
164
 
210
 
type
211
 
  TCustomPageAccess = class(TCustomPage)
212
 
  end;
213
 
 
214
 
function IsNotebookGroupFocused(const ANotebook: TCustomNotebook): boolean;
215
 
var
216
 
  lNotebookHandle, lWindow: HWND;
217
 
begin
218
 
  result := false;
219
 
  if not ANotebook.HandleAllocated then exit;
220
 
  lNotebookHandle := ANotebook.Handle;
221
 
  lWindow := Windows.GetFocus;
222
 
  while (lWindow <> 0) and (lWindow <> lNotebookHandle) do
223
 
    lWindow := Windows.GetParent(lWindow);
224
 
  if lWindow = 0 then exit;
225
 
  result := true;
226
 
end;
227
 
 
228
 
{ sets focus to a control on the newly focused tab page }
229
 
procedure NotebookFocusNewControl(const ANotebook: TCustomNotebook; NewIndex: integer);
230
 
var
231
 
  Page: TCustomPage;
232
 
  AWinControl: TWinControl;
233
 
  ParentForm: TCustomForm;
234
 
begin
235
 
  { see if currently focused control is within notebook }
236
 
  if not IsNotebookGroupFocused(ANotebook) then exit;
237
 
 
238
 
  { focus was/is within notebook, pick a new control to focus }
239
 
  Page := ANotebook.CustomPage(NewIndex);
240
 
  ParentForm := GetParentForm(ANotebook);
241
 
  if ParentForm <> nil then
242
 
  begin
243
 
    if ANotebook.ContainsControl(ParentForm.ActiveControl) and (ParentForm.ActiveControl <> ANotebook) then
244
 
    begin
245
 
      AWinControl := nil;
246
 
      if Page.CanFocus then
247
 
        AWinControl := TCustomPageAccess(Page).FindNextControl(nil, True, True, False);
248
 
      // if nothing to focus then focus notebook then we can traverse pages by keys
249
 
      if AWinControl = nil then
250
 
        AWinControl := ANotebook;
251
 
      AWinControl.SetFocus;
252
 
    end;
253
 
  end;
254
 
end;
255
 
 
256
 
function NotebookPageRealToLCLIndex(const ANotebook: TCustomNotebook; AIndex: integer): integer;
257
 
var
258
 
  I: Integer;
259
 
begin
260
 
  Result := AIndex;
261
 
  if csDesigning in ANotebook.ComponentState then exit;
262
 
  I := 0;
263
 
  while (I < ANotebook.PageCount) and (I <= Result) do 
264
 
  begin
265
 
    if not ANotebook.Page[I].TabVisible then Inc(Result);
266
 
    Inc(I);
267
 
  end;
268
 
end;
269
 
 
270
 
function PageWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
271
 
    LParam: Windows.LParam): LResult; stdcall;
272
 
begin
273
 
  if Msg = WM_THEMECHANGED then
274
 
  begin
275
 
    ThemeServices.UpdateThemes;
276
 
    TWin32WSCustomPage.ThemeChange(Window);
277
 
  end;
278
 
  Result := WindowProc(Window, Msg, WParam, LParam);
279
 
end;
280
 
 
281
 
{ TWin32WSCustomPage }
282
 
 
283
 
class function TWin32WSCustomPage.CreateHandle(const AWinControl: TWinControl;
284
 
  const AParams: TCreateParams): HWND;
285
 
var
286
 
  Params: TCreateWindowExParams;
287
 
begin
288
 
  // general initialization of Params
289
 
  PrepareCreateWindow(AWinControl, AParams, Params);
290
 
  // customization of Params
291
 
  with Params do
292
 
  begin
293
 
    pClassName := @ClsName[0];
294
 
    SubClassWndProc := @PageWindowProc;
295
 
  end;
296
 
  // create window
297
 
  FinishCreateWindow(AWinControl, Params, false);
298
 
  // return window handle
299
 
  Result := Params.Window;
300
 
  ThemeChange(Result);
301
 
end;
302
 
 
303
 
class procedure TWin32WSCustomPage.DestroyHandle(const AWinControl: TWinControl);
304
 
var
305
 
  PageIndex, RealIndex: integer;
306
 
  PageControlHandle: HWND;
307
 
begin
308
 
  // remove tab from pagecontrol only if not pfRemoving is set
309
 
  // if pfRemoving is set then Tab has been deleted by RemovePage
310
 
  if (AWinControl.Parent <> nil) and (AWinControl.Parent.HandleAllocated) and
311
 
     not (pfRemoving in TCustomPageAccess(AWinControl).Flags) then
312
 
  begin
313
 
    PageControlHandle := AWinControl.Parent.Handle;
314
 
    PageIndex := TCustomPage(AWinControl).PageIndex;
315
 
    RealIndex := TWin32WSCustomNotebook.GetPageRealIndex(TCustomNotebook(AWinControl.Parent), PageIndex);
316
 
    if RealIndex <> -1 then
317
 
    begin
318
 
      Windows.SendMessage(PageControlHandle, TCM_DELETEITEM, Windows.WPARAM(RealIndex), 0);
319
 
      AWinControl.Parent.InvalidateClientRectCache(False);
320
 
    end;
321
 
  end;
322
 
  TWSWinControlClass(ClassParent).DestroyHandle(AWinControl);
323
 
end;
324
 
 
325
 
class procedure TWin32WSCustomPage.ThemeChange(Wnd: HWnd);
326
 
var
327
 
  WindowInfo: PWin32WindowInfo;
328
 
begin
329
 
  WindowInfo := GetWin32WindowInfo(Wnd);
330
 
  if WindowInfo <> nil then
331
 
  begin
332
 
    with WindowInfo^ do
333
 
    begin
334
 
      needParentPaint := ThemeServices.ThemesEnabled;
335
 
      isTabPage := ThemeServices.ThemesEnabled;
336
 
    end;
337
 
  end;
338
 
end;
339
 
 
340
 
class procedure TWin32WSCustomPage.SetText(const AWinControl: TWinControl; const AText: string);
341
 
var
342
 
  TCI: TC_ITEM;
343
 
  PageIndex, RealIndex: integer;
344
 
  NotebookHandle: HWND;
345
 
begin
346
 
  PageIndex := TCustomPage(AWinControl).PageIndex;
347
 
  RealIndex := TWin32WSCustomNotebook.GetPageRealIndex(TCustomNotebook(AWinControl.Parent), PageIndex);
348
 
  NotebookHandle := AWinControl.Parent.Handle;
349
 
  // We can't set label of a page not yet added,
350
 
  // Check for valid page index
351
 
  if (RealIndex >= 0) and (RealIndex < Windows.SendMessage(NotebookHandle, TCM_GETITEMCOUNT, 0, 0)) then
352
 
  begin
353
 
    // retrieve page handle from tab as extra check (in case page isn't added yet).
354
 
    TCI.mask := TCIF_PARAM;
355
 
    Windows.SendMessage(NotebookHandle, TCM_GETITEM, RealIndex, LPARAM(@TCI));
356
 
    if PtrUInt(TCI.lParam) = PtrUInt(AWinControl) then
357
 
    begin
358
 
      Assert(False, Format('Trace:TWin32WSCustomPage.SetText --> %S', [AText]));
359
 
      TCI.mask := TCIF_TEXT;
360
 
{$ifdef WindowsUnicodeSupport}
361
 
      if UnicodeEnabledOS then
362
 
      begin
363
 
        TCI.pszText := PChar(PWideChar(UTF8ToUTF16(AText)));
364
 
        Windows.SendMessage(NotebookHandle, TCM_SETITEMW, RealIndex, LPARAM(@TCI));
365
 
      end
366
 
      else
367
 
      begin
368
 
        TCI.pszText := PChar(UTF8ToAnsi(AText));
369
 
        Windows.SendMessage(NotebookHandle, TCM_SETITEM, RealIndex, LPARAM(@TCI));
370
 
      end;
371
 
{$else}
372
 
      TCI.pszText := PChar(AText);
373
 
      Windows.SendMessage(NotebookHandle, TCM_SETITEM, RealIndex, LPARAM(@TCI));
374
 
{$endif}
375
 
    end;
376
 
  end;
377
 
end;
378
 
 
379
 
class procedure TWin32WSCustomPage.UpdateProperties(const ACustomPage: TCustomPage);
380
 
var
381
 
  TCI: TC_ITEM;
382
 
  PageIndex, RealIndex: integer;
383
 
  NotebookHandle: HWND;
384
 
begin
385
 
  PageIndex := ACustomPage.PageIndex;
386
 
  RealIndex := TWin32WSCustomNotebook.GetPageRealIndex(TCustomNotebook(ACustomPage.Parent), PageIndex);
387
 
  NotebookHandle := ACustomPage.Parent.Handle;
388
 
  // Check for valid page index
389
 
  if (RealIndex >= 0) and (RealIndex < Windows.SendMessage(NotebookHandle, TCM_GETITEMCOUNT,0,0)) then
390
 
  begin
391
 
    // retrieve page handle from tab as extra check (in case page isn't added yet).
392
 
    TCI.mask := TCIF_PARAM;
393
 
    Windows.SendMessage(NotebookHandle, TCM_GETITEM, RealIndex, LPARAM(@TCI));
394
 
    if PtrUInt(TCI.lParam) = PtrUInt(ACustomPage) then
395
 
    begin
396
 
      TCI.mask := TCIF_IMAGE;
397
 
      TCI.iImage := TCustomNotebook(ACustomPage.Parent).GetImageIndex(PageIndex);
398
 
 
399
 
      Windows.SendMessage(NotebookHandle, TCM_SETITEM, RealIndex, LPARAM(@TCI));
400
 
    end;
401
 
  end;
402
 
end;
403
 
 
404
 
{ TWin32WSCustomNotebook }
405
 
 
406
 
class function TWin32WSCustomNotebook.CreateHandle(const AWinControl: TWinControl;
407
 
  const AParams: TCreateParams): HWND;
408
 
const
409
 
  TabPositionFlags: array[TTabPosition] of DWord = (
410
 
 { tpTop    } 0,
411
 
 { tpBottom } TCS_BOTTOM,
412
 
 { tpLeft   } TCS_VERTICAL or TCS_MULTILINE,
413
 
 { tpRight  } TCS_VERTICAL or TCS_RIGHT or TCS_MULTILINE
414
 
  );
415
 
var
416
 
  Params: TCreateWindowExParams;
417
 
begin
418
 
  // general initialization of Params
419
 
  PrepareCreateWindow(AWinControl, AParams, Params);
420
 
  // customization of Params
421
 
  with Params do
422
 
  begin
423
 
    Flags := Flags or TabPositionFlags[TCustomNoteBook(AWinControl).TabPosition];
424
 
    if nboMultiLine in TCustomNotebook(AWinControl).Options then
425
 
      Flags := Flags or TCS_MULTILINE;
426
 
    pClassName := WC_TABCONTROL;
427
 
  end;
428
 
  // create window
429
 
  FinishCreateWindow(AWinControl, Params, false);
430
 
  Result := Params.Window;
431
 
 
432
 
  if TCustomNoteBook(AWinControl).Images <> nil then
433
 
    SendMessage(Result, TCM_SETIMAGELIST, 0, TCustomNoteBook(AWinControl).Images.Reference._Handle);
434
 
 
435
 
  // although we may be child of tabpage, cut the paint chain
436
 
  // to improve speed and possible paint anomalities
437
 
  Params.WindowInfo^.needParentPaint := false;
438
 
end;
439
 
 
440
 
class procedure TWin32WSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
441
 
  const AChild: TCustomPage; const AIndex: integer);
442
 
var
443
 
  TCI: TC_ITEM;
444
 
begin
445
 
  with ANotebook do
446
 
  begin
447
 
    // other widgetsets allocates handles because they really need this
448
 
    // but on windows page handle is differ from tab and thus allocation can be
449
 
    // postponed, but this cause problems with event handling like bug #0012434
450
 
    // so to overcome such problems we need to allocate this handle
451
 
    AChild.HandleNeeded;
452
 
    if ShowTabs then
453
 
    begin
454
 
      TCI.Mask := TCIF_TEXT or TCIF_PARAM or TCIF_IMAGE;
455
 
      // store object as extra, so we can verify we got the right page later
456
 
      TCI.lParam := PtrUInt(AChild);
457
 
      TCI.iImage := ANotebook.GetImageIndex(NotebookPageRealToLCLIndex(ANotebook, AIndex));
458
 
  {$ifdef WindowsUnicodeSupport}
459
 
      if UnicodeEnabledOS then
460
 
      begin
461
 
        TCI.pszText := PChar(PWideChar(UTF8ToUTF16(AChild.Caption)));
462
 
        Windows.SendMessage(Handle, TCM_INSERTITEMW, AIndex, LPARAM(@TCI));
463
 
      end
464
 
      else
465
 
      begin
466
 
        TCI.pszText := PChar(Utf8ToAnsi(AChild.Caption));
467
 
        Windows.SendMessage(Handle, TCM_INSERTITEM, AIndex, LPARAM(@TCI));
468
 
      end;
469
 
  {$else}
470
 
      TCI.pszText := PChar(AChild.Caption);
471
 
      Windows.SendMessage(Handle, TCM_INSERTITEM, AIndex, LPARAM(@TCI));
472
 
  {$endif}
473
 
    end;
474
 
    // clientrect possible changed, adding first tab, or deleting last
475
 
    // windows should send a WM_SIZE message because of this, but it doesn't
476
 
    // send it ourselves
477
 
    if LCLControlSizeNeedsUpdate(ANotebook, True) then
478
 
      AdjustSizeNotebookPages(ANotebook);
479
 
  end;
480
 
end;
481
 
 
482
 
class procedure TWin32WSCustomNotebook.MovePage(const ANotebook: TCustomNotebook;
483
 
  const AChild: TCustomPage; const NewIndex: integer);
484
 
begin
485
 
  RemovePage(ANotebook, AChild.PageIndex);
486
 
  AddPage(ANotebook,AChild,NewIndex);
487
 
end;
488
 
 
489
 
class procedure TWin32WSCustomNotebook.RemovePage(const ANotebook: TCustomNotebook;
490
 
  const AIndex: integer);
491
 
begin
492
 
  Windows.SendMessage(ANotebook.Handle, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0);
493
 
  if LCLControlSizeNeedsUpdate(ANotebook, True) then
494
 
    AdjustSizeNotebookPages(ANotebook);
495
 
end;
496
 
 
497
 
{ -----------------------------------------------------------------------------
498
 
  Method: AddAllNBPages
499
 
  Params: Notebook - A notebook control
500
 
  Returns: Nothing
501
 
 
502
 
  Adds all pages to notebook (showtabs becomes true)
503
 
 ------------------------------------------------------------------------------}
504
 
class procedure TWin32WSCustomNotebook.AddAllNBPages(const ANotebook: TCustomNotebook);
505
 
var
506
 
  TCI: TC_ITEM;
507
 
  I, Res, RealIndex: Integer;
508
 
  APage: TCustomPage;
509
 
  WinHandle: HWND;
510
 
begin
511
 
  WinHandle := ANotebook.Handle;
512
 
  RealIndex := 0;
513
 
  for I := 0 to ANotebook.PageCount - 1 do
514
 
  begin
515
 
    APage := ANotebook.Page[I];
516
 
    if not APage.TabVisible and not (csDesigning in APage.ComponentState) then
517
 
      continue;
518
 
    // check if already shown
519
 
    TCI.Mask := TCIF_PARAM;
520
 
    Res := Windows.SendMessage(ANotebook.Handle, TCM_GETITEM, RealIndex, LPARAM(@TCI));
521
 
    if (Res = 0) or (PtrUInt(TCI.lParam) <> PtrUInt(APage)) then
522
 
    begin
523
 
      TCI.Mask := TCIF_TEXT or TCIF_PARAM or TCIF_IMAGE;
524
 
      TCI.lParam := PtrUInt(APage);
525
 
      TCI.iImage := ANotebook.GetImageIndex(I);
526
 
{$ifdef WindowsUnicodeSupport}
527
 
      if UnicodeEnabledOS then
528
 
      begin
529
 
        TCI.pszText := PChar(PWideChar(UTF8ToUTF16(APage.Caption)));
530
 
        Windows.SendMessage(WinHandle, TCM_INSERTITEMW, RealIndex, LPARAM(@TCI));
531
 
      end
532
 
      else
533
 
      begin
534
 
        TCI.pszText := PChar(Utf8ToAnsi(APage.Caption));
535
 
        Windows.SendMessage(WinHandle, TCM_INSERTITEM, RealIndex, LPARAM(@TCI));
536
 
      end;
537
 
{$else}
538
 
      TCI.pszText := PChar(APage.Caption);
539
 
      Windows.SendMessage(WinHandle, TCM_INSERTITEM, RealIndex, LPARAM(@TCI));
540
 
{$endif}
541
 
    end;
542
 
    Inc(RealIndex);
543
 
  end;
544
 
  AdjustSizeNotebookPages(ANotebook);
545
 
end;
546
 
 
547
 
class procedure TWin32WSCustomNotebook.AdjustSizeNotebookPages(const ANotebook: TCustomNotebook);
548
 
var
549
 
  I: Integer;
550
 
  R: TRect;
551
 
  WinHandle: HWND;
552
 
  lPage: TCustomPage;
553
 
begin
554
 
  WinHandle := ANotebook.Handle;
555
 
  // Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
556
 
  TWin32WidgetSet(WidgetSet).GetClientRect(WinHandle, R);
557
 
  for I := 0 to ANotebook.PageCount - 1 do
558
 
  begin
559
 
    lPage := ANotebook.Page[I];
560
 
    // we don't need to resize non-existing pages yet, they will be sized when created
561
 
    if lPage.HandleAllocated then
562
 
      SetBounds(lPage, R.Left, R.Top, R.Right, R.Bottom);
563
 
  end;
564
 
end;
565
 
 
566
 
{------------------------------------------------------------------------------
567
 
  Method: RemoveAllNBPages
568
 
  Params: Notebook - The notebook control
569
 
  Returns: Nothing
570
 
 
571
 
  Removes all pages from a notebook control (showtabs becomes false)
572
 
 ------------------------------------------------------------------------------}
573
 
class procedure TWin32WSCustomNotebook.RemoveAllNBPages(const ANotebook: TCustomNotebook);
574
 
var
575
 
  I: Integer;
576
 
  WinHandle: HWND;
577
 
begin
578
 
  WinHandle := ANotebook.Handle;
579
 
  for I := ANotebook.PageCount - 1 downto 0 do
580
 
    Windows.SendMessage(WinHandle, TCM_DELETEITEM, Windows.WPARAM(I), 0);
581
 
  AdjustSizeNotebookPages(ANotebook);
582
 
end;
583
 
 
584
 
class function TWin32WSCustomNotebook.GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer;
585
 
var
586
 
  X: Integer;
587
 
begin
588
 
  Result := AIndex;
589
 
  if csDesigning in ANotebook.ComponentState then exit;
590
 
  for X := 0 to AIndex - 1 do
591
 
    if ANotebook.Page[X].TabVisible = False then Dec(Result);
592
 
end;
593
 
 
594
 
procedure SendSelChangeMessage(const ANotebook: TCustomNotebook; const AHandle: HWND;
595
 
  const APageIndex: integer);
596
 
var
597
 
  Mess: TLMNotify;
598
 
  NMHdr: tagNMHDR;
599
 
begin
600
 
  FillChar(Mess,SizeOf(Mess),0);
601
 
  Mess.Msg := LM_NOTIFY;
602
 
  FillChar(NMHdr,SizeOf(NMHdr),0);
603
 
  NMHdr.code := TCN_SELCHANGE;
604
 
  NMHdr.hwndfrom := AHandle;
605
 
  NMHdr.idfrom := APageIndex;  //use this to set pageindex to the correct page.
606
 
  Mess.NMHdr := @NMHdr;
607
 
  DeliverMessage(ANotebook, TLMessage(Mess));
608
 
end;
609
 
 
610
 
class function TWin32WSCustomNotebook.GetTabIndexAtPos(const ANotebook: TCustomNotebook;
611
 
  const AClientPos: TPoint): integer;
612
 
var
613
 
  hittestInfo: TC_HITTESTINFO;
614
 
  Orect: TRect;
615
 
begin
616
 
  GetLCLClientBoundsOffset(ANotebook, ORect);
617
 
  hittestInfo.pt.x := AClientPos.x + ORect.Left;
618
 
  hittestInfo.pt.y := AClientPos.y + ORect.Top;
619
 
  Result := Windows.SendMessage(ANotebook.Handle, TCM_HITTEST, 0, LPARAM(@hittestInfo));
620
 
end;
621
 
 
622
 
class function TWin32WSCustomNotebook.GetTabRect(const ANotebook: TCustomNotebook;
623
 
  const AIndex: Integer): TRect;
624
 
var
625
 
  Orect: TRect;
626
 
begin
627
 
  GetLCLClientBoundsOffset(ANotebook, ORect);
628
 
  if Windows.SendMessage(ANotebook.Handle, TCM_GETITEMRECT, WPARAM(AIndex), LPARAM(@Result)) <> 0
629
 
  then begin
630
 
    Result.Top := Result.Top - Orect.Top;
631
 
    Result.Bottom := Result.Bottom - Orect.Top;
632
 
    Result.Left := Result.Left - Orect.Left;
633
 
    Result.Right := Result.Right - Orect.Left;
634
 
  end
635
 
  else
636
 
    Result := inherited GetTabRect(ANotebook, AIndex);
637
 
end;
638
 
 
639
 
class function TWin32WSCustomNotebook.GetCapabilities: TNoteBookCapabilities;
640
 
begin
641
 
  Result:=[nbcMultiLine];
642
 
end;
643
 
 
644
 
class function TWin32WSCustomNotebook.GetDesignInteractive(
645
 
  const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
646
 
var
647
 
  hittestInfo: TC_HITTESTINFO;
648
 
  AIndex, ACurIndex: Integer;
649
 
begin
650
 
  hittestInfo.pt.x := AClientPos.x;
651
 
  hittestInfo.pt.y := AClientPos.y;
652
 
  AIndex := Windows.SendMessage(AWinControl.Handle, TCM_HITTEST, 0, LPARAM(@hittestInfo));
653
 
  ACurIndex := SendMessage(AWinControl.Handle, TCM_GETCURSEL, 0, 0);
654
 
  Result := (AIndex <> -1) and (AIndex <> ACurIndex);
655
 
end;
656
 
 
657
 
class procedure TWin32WSCustomNotebook.SetImageList(
658
 
  const ANotebook: TCustomNotebook; const AImageList: TCustomImageList);
659
 
begin
660
 
  if not WSCheckHandleAllocated(ANotebook, 'SetImageList') then
661
 
    Exit;
662
 
 
663
 
  if AImageList <> nil then
664
 
    SendMessage(ANoteBook.Handle, TCM_SETIMAGELIST, 0, AImageList.Reference._Handle)
665
 
  else
666
 
    SendMessage(ANoteBook.Handle, TCM_SETIMAGELIST, 0, 0);
667
 
  // if you set big images like 32x32 then tabs will be big too => you need to
668
 
  // readjust the size of pages
669
 
  AdjustSizeNotebookPages(ANotebook);
670
 
end;
671
 
 
672
 
class procedure TWin32WSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
673
 
var
674
 
  NotebookHandle, OldPageHandle, NewPageHandle: HWND;
675
 
  NewRealIndex: Integer;
676
 
begin
677
 
  NotebookHandle := ANotebook.Handle;
678
 
  // get the current top window
679
 
  OldPageHandle := GetTopWindow(NotebookHandle);
680
 
  NewPageHandle := 0;
681
 
  NewRealIndex := GetPageRealIndex(ANotebook, AIndex);
682
 
 
683
 
  SendMessage(NotebookHandle, TCM_SETCURSEL, Windows.WParam(NewRealIndex), 0);
684
 
  if not (csDestroying in ANotebook.ComponentState) then
685
 
  begin
686
 
    // create handle if not already done, need to show!
687
 
    if (AIndex >= 0) and (AIndex < ANotebook.PageCount) then
688
 
    begin
689
 
      NewPageHandle := ANotebook.Page[AIndex].Handle;
690
 
      Windows.SetWindowPos(NewPageHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW or SWP_NOACTIVATE);
691
 
      SendSelChangeMessage(ANotebook, NotebookHandle, AIndex);
692
 
      NotebookFocusNewControl(ANotebook, AIndex);
693
 
    end;
694
 
    // traverse children and hide them if needed
695
 
    while OldPageHandle <> 0 do
696
 
    begin
697
 
      // don't touch non-lcl windows
698
 
      if (OldPageHandle <> NewPageHandle) and IsWindowVisible(OldPageHandle) and Assigned(GetProp(OldPageHandle, 'WinControl')) then
699
 
        Windows.SetWindowPos(OldPageHandle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_HIDEWINDOW or SWP_NOACTIVATE);
700
 
      OldPageHandle := GetNextWindow(OldPageHandle, GW_HWNDNEXT);
701
 
    end;
702
 
  end;
703
 
end;
704
 
 
705
 
class procedure TWin32WSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
706
 
begin
707
 
  if ANoteBook.HandleAllocated then
708
 
    RecreateWnd(ANoteBook);
709
 
end;
710
 
 
711
 
class procedure TWin32WSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean);
712
 
begin
713
 
  if AShowTabs then
714
 
    AddAllNBPages(ANotebook)
715
 
  else
716
 
    RemoveAllNBPages(ANotebook);
717
 
end;
718
 
 
719
 
class procedure TWin32WSCustomNotebook.UpdateProperties(const ANotebook: TCustomNotebook);
720
 
var
721
 
  CurrentStyle, NewStyle: cardinal;
722
 
begin
723
 
  CurrentStyle := GetWindowLong(ANotebook.Handle, GWL_STYLE);
724
 
  if (nboMultiLine in ANotebook.Options) or (ANotebook.TabPosition in [tpLeft, tpRight]) then
725
 
    NewStyle := CurrentStyle or TCS_MULTILINE
726
 
  else
727
 
    NewStyle := CurrentStyle and not TCS_MULTILINE;
728
 
  if NewStyle <> CurrentStyle then
729
 
  begin
730
 
    SetWindowLong(ANotebook.Handle, GWL_STYLE, NewStyle);
731
 
    SetWindowPos(ANoteBook.Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_DRAWFRAME);
732
 
    if LCLControlSizeNeedsUpdate(ANotebook, True) then
733
 
      AdjustSizeNotebookPages(ANotebook);
734
 
  end;
735
 
end;
736
 
 
737
165
{$include win32trayicon.inc}
738
166
 
739
167
end.