← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/lclmessageglue.pas

  • 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/lclmessageglue.pas
1
 
{ $Id: lclmessageglue.pas 26637 2010-07-14 08:47:02Z paul $ }
 
1
{ $Id: lclmessageglue.pas 36432 2012-03-30 01:05:10Z paul $ }
2
2
{
3
3
 *****************************************************************************
4
4
 *                              LCLMessageGlue.pas                           *
31
31
 
32
32
interface
33
33
 
34
 
uses Classes, Forms, LCLClasses, LCLProc, Controls, LMessages, LCLType;
 
34
uses
 
35
  Classes, Forms, LCLClasses, LCLProc, Controls, Messages, LMessages, LCLType;
35
36
 
36
37
function DeliverMessage(const Target: TObject; var AMessage): PtrInt;
37
38
function SendSimpleMessage(const Target: TControl; Msg: Cardinal): PtrInt;
38
39
 
39
 
function LCLSendActivateMsg(const Target: TControl; Active: Boolean; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
 
40
function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
40
41
function LCLSendSetFocusMsg(const Target: TControl): PtrInt;
41
42
function LCLSendKillFocusMsg(const Target: TControl): PtrInt;
42
43
function LCLSendShowWindowMsg(const Target: TControl; Show: Boolean; Status: LPARAM = 0): PtrInt;
66
67
function LCLSendPasteFromClipboardMsg(const Target: TControl): PtrInt;
67
68
function LCLSendConfigureEventMsg(const Target: TControl): PtrInt;
68
69
function LCLSendPaintMsg(const Target: TControl;const  DC: HDC; const PaintStruct: PPaintStruct): PtrInt;
 
70
function LCLSendEraseBackgroundMsg(const Target: TWinControl;const  DC: HDC): PtrInt;
69
71
function LCLSendKeyDownEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
70
72
function LCLSendKeyUpEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
 
73
function LCLSendCharEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt;
 
74
function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char; IsSysKey: Boolean): PtrInt;
71
75
function LCLSendTimerMsg(const Target: TControl; TimerID: WParam; TimerProc: LParam): PtrInt;
72
76
function LCLSendExitMsg(const Target: TControl): PtrInt;
73
77
function LCLSendCloseQueryMsg(const Target: TControl): PtrInt;
74
78
function LCLSendDragStartMsg(const Target: TControl): PtrInt;
75
 
function LCLSendDeactivateStartMsg(const Target: TControl): PtrInt;
76
79
function LCLSendMonthChangedMsg(const Target: TControl): PtrInt;
77
80
function LCLSendYearChangedMsg(const Target: TControl): PtrInt;
78
81
function LCLSendDayChangedMsg(const Target: TControl): PtrInt;
83
86
 
84
87
implementation
85
88
 
 
89
type
 
90
  TWinControlAccess = class(TWinControl)
 
91
  end;
 
92
 
86
93
function DeliverMessage(const Target: TObject; var AMessage): PtrInt;
87
94
var
88
95
  RefCounted: Boolean;
100
107
  {$ENDIF}
101
108
  RefCounted := False;
102
109
  try
103
 
    if Target is TLCLComponent then
104
 
    begin
105
 
      TLCLComponent(Target).IncLCLRefCount;
106
 
      RefCounted := True;
107
 
    end;
108
110
    try
 
111
      if Target is TLCLComponent then
 
112
      begin
 
113
        TLCLComponent(Target).IncLCLRefCount;
 
114
        RefCounted := True;
 
115
      end;
109
116
      if Target is TControl then
110
117
        TControl(Target).WindowProc(TLMessage(AMessage))
111
118
      else
157
164
 *                active window                                               *
158
165
 *                                                                            *
159
166
 ******************************************************************************}
160
 
function LCLSendActivateMsg(const Target: TControl; Active: Boolean; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
 
167
function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
161
168
var
162
169
  Mess: TLMActivate;
163
170
begin
164
171
  Result := 0;
165
 
 
166
 
  FillChar(Mess,SizeOf(Mess),0);
 
172
  FillChar(Mess, SizeOf(Mess), 0);
167
173
  Mess.Msg := LM_ACTIVATE;
168
 
  Mess.Active:=Active;
169
 
  Mess.Minimized:=Minimized;
170
 
  Mess.ActiveWindow:=ActiveWindow;
 
174
  Mess.Active := Active;
 
175
  Mess.Minimized := Minimized;
 
176
  Mess.ActiveWindow := ActiveWindow;
171
177
  Mess.Result := 0;
172
178
  DeliverMessage(Target, Mess);
173
179
  Result := Mess.Result;
244
250
 *                                                                            *
245
251
 * Target        : The Control that will recieve the message LM_SIZE          *
246
252
 * Width, Height : The new Width and Height for the control                   *
247
 
 * SizeType      : SIZENORMAL, SIZEICONIC, SIZEFULLSCREEN, SIZEZOOMSHOW or    *
248
 
 *                 SIZEZOOMHIDE. (In LCLType)                                 *
 
253
 * SizeType      : SIZE_RESTORED, SIZE_MINIMIZED, SIZE_MAXIMIZED,...          *
249
254
 * FromInterface : True if this message was sent from the widgetset to notify *
250
255
 *                 the LCL of a change.  False to make the widgetset change   *
251
256
 *                 the size of the control. Default = True                    *
261
266
  Mess.Msg := LM_SIZE;
262
267
  Mess.Width := Width;
263
268
  Mess.Height := Height;
264
 
  //SIZENORMAL, SIZEICONIC, SIZEFULLSCREEN, SIZEZOOMSHOW, SIZEZOOMHIDE.
265
269
  Mess.SizeType := SizeType;
266
270
  if FromInterface then
267
271
    Mess.SizeType := Mess.SizeType or Size_SourceIsInterface;
429
433
  Mess.X := XPos;
430
434
  Mess.Y := YPos;
431
435
  Mess.WheelDelta := WheelDelta;
 
436
  Mess.State := ShiftState;
432
437
 
433
438
  Result := DeliverMessage(Target, Mess);
434
439
end;
789
794
  Result := DeliverMessage(Target, Mess);
790
795
end;
791
796
 
 
797
function LCLSendEraseBackgroundMsg(const Target: TWinControl; const DC: HDC): PtrInt;
 
798
var
 
799
  Mess: TLMEraseBkgnd;
 
800
begin
 
801
  FillChar(Mess, SizeOf(Mess), 0);
 
802
  Mess.Msg := LM_ERASEBKGND;
 
803
  Mess.DC := DC;
 
804
 
 
805
  Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
 
806
  Result := DeliverMessage(Target, Mess);
 
807
  Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
 
808
end;
 
809
 
792
810
{******************************************************************************
793
811
 *                                                                            *
794
812
 *  LCLSendKeyDownEvent                                                       *
867
885
  CharCode := Mess.CharCode;
868
886
end;
869
887
 
 
888
function LCLSendCharEvent(const Target: TControl; var CharCode: Word;
 
889
  KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt;
 
890
var
 
891
  Mess: TLMChar;
 
892
begin
 
893
  FillChar(Mess, SizeOf(Mess), 0);
 
894
  if BeforeEvent then begin
 
895
    if IsSysKey then
 
896
      Mess.Msg := CN_SYSCHAR
 
897
    else Mess.Msg := CN_CHAR;
 
898
  end
 
899
  else begin
 
900
    if IsSysKey then
 
901
      Mess.Msg := LM_SYSCHAR
 
902
    else Mess.Msg := LM_CHAR;
 
903
  end;
 
904
  Mess.CharCode := CharCode;
 
905
  Mess.KeyData := KeyData;
 
906
  Result := DeliverMessage(Target, Mess);
 
907
  CharCode := Mess.CharCode;
 
908
 
 
909
  if ANotifyUserInput then NotifyApplicationUserInput(Target, Mess.Msg);
 
910
end;
 
911
 
 
912
function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char;
 
913
  IsSysKey: Boolean): PtrInt;
 
914
begin
 
915
  {if not IsControlKey then}
 
916
  Target.IntfUTF8KeyPress(AUTF8Char, 1, IsSysKey);
 
917
  Result := 1;
 
918
end;
 
919
 
870
920
{******************************************************************************
871
921
 *                                                                            *
872
922
 *  LCLSendTimerMsg                                                           *
945
995
 
946
996
{******************************************************************************
947
997
 *                                                                            *
948
 
 *  LCLSendDeactivateStartMsg                                                 *
949
 
 *                                                                            *
950
 
 *  Returns     : 0 to accept the message, non-zero to reject the message     *
951
 
 *                                                                            *
952
 
 *  Params                                                                    *
953
 
 *                                                                            *
954
 
 *  Target      : The Control that will recieve the message LM_DEACTIVATE     *
955
 
 *                                                                            *
956
 
 ******************************************************************************}
957
 
function LCLSendDeactivateStartMsg(const Target: TControl): PtrInt;
958
 
begin
959
 
  Result := SendSimpleMessage(Target, LM_DEACTIVATE);
960
 
end;
961
 
 
962
 
{******************************************************************************
963
 
 *                                                                            *
964
998
 *  LCLSendMonthChangedMsg                                                    *
965
999
 *                                                                            *
966
1000
 *  Returns     : 0 to accept the message, non-zero to reject the message     *