← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/include/dbedit.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/dbedit.inc
25
25
 
26
26
//update the caption on next record etc...
27
27
procedure TDBEdit.DataChange(Sender: TObject);
 
28
var
 
29
  DataLinkField: TField;
28
30
begin
29
 
  if FDataLink.Field <> nil then begin
30
 
    //use the right EditMask if any
31
 
    //EditMask := FDataLink.Field.EditMask; doesn't exist yet
32
 
    Alignment := FDataLink.Field.Alignment;
 
31
  DataLinkField := FDataLink.Field;
 
32
  if DataLinkField <> nil then begin
 
33
    //use Field EditMask by default
 
34
    if not FCustomEditMask then
 
35
      EditMask := DataLinkField.EditMask;
 
36
    Alignment := DataLinkField.Alignment;
33
37
 
34
38
    //if we are focused its possible to edit,
35
39
    //if the field is currently modifiable
36
40
    if Focused and FDataLink.CanModify then begin
37
41
      //display the real text since we can modify it
38
 
      RestoreMask(FDatalink.Field.Text);
39
 
      SelectAll;
 
42
      RestoreMask(DatalinkField.Text);
40
43
    end else
41
44
      //otherwise display the pretified/formated text since we can't
42
 
      DisableMask(FDataLink.Field.DisplayText);
43
 
    if (FDataLink.Field.DataType = ftString) and (MaxLength = 0) then
44
 
      MaxLength := FDatalink.Field.Size;
 
45
      DisableMask(DataLinkField.DisplayText);
 
46
    if (DataLinkField.DataType in [ftString, ftFixedChar, ftWidestring, ftFixedWideChar])
 
47
      and (MaxLength = 0) then
 
48
      MaxLength := DatalinkField.Size;
45
49
  end
46
50
  else begin
47
 
    //todo: uncomment this when TField implements EditMask
48
 
    //EditMask := ''
49
 
    Text := '';
50
 
  end;
51
 
end;
52
 
 
53
 
procedure TDBEdit.ActiveChange(Sender: TObject);
54
 
begin
55
 
  if FDatalink.Active then 
56
 
    DataChange(Sender)
57
 
  else begin
58
 
    Text := '';
59
 
    FDataLink.Reset;
60
 
  end;
61
 
end;
62
 
 
63
 
procedure TDBEdit.LayoutChange(Sender: TObject);
64
 
begin
65
 
  DataChange(Sender);
 
51
    if not FCustomEditMask then
 
52
      EditMask := '';
 
53
    Text := '';
 
54
    MaxLength := 0;
 
55
  end;
66
56
end;
67
57
 
68
58
procedure TDBEdit.UpdateData(Sender: TObject);
78
68
  //the changes have been validated
79
69
  ValidateEdit;
80
70
  FDataLink.Field.Text := Text;
81
 
  //FDataLink.Field.AsString := Text;// I shouldn't have to do this, but text seems broken
82
 
end;
83
 
 
84
 
procedure TDBEdit.FocusRequest(Sender: TObject);
85
 
begin
86
 
  //the FieldLink has requested the control
87
 
  //recieve focus for some reason..
88
 
  //perhaps an error occured?
89
 
  SetFocus;
90
71
end;
91
72
 
92
73
function TDBEdit.GetDataField: string;
125
106
  ChangeDataSource(Self,FDataLink,Value);
126
107
end;
127
108
 
128
 
function TDBEdit.IsReadOnly: boolean;
129
 
begin
130
 
  // This function in unneccesary for fpc versions > 2.2.4.
131
 
  // In those versions FDatalink.CanModify already checks if the dataset is active.
132
 
  // So this temporary method should be removed in the future, and the calls to
133
 
  // 'not IsReadOnly' should then be replaced by calls to FDatalink.CanModify.
134
 
  If FDatalink.Active then
135
 
    Result := not FDatalink.CanModify
136
 
  else
137
 
    Result := False;
138
 
end;
139
 
 
140
109
procedure TDBEdit.CMGetDataLink(var Message: TLMessage);
141
110
begin
142
111
  Message.Result := PtrUInt(FDataLink);
146
115
procedure TDBEdit.KeyDown(var Key: Word; Shift: TShiftState);
147
116
begin
148
117
  inherited KeyDown(Key,Shift);
149
 
  if Key=VK_ESCAPE then begin
150
 
    //cancel out of editing by reset on esc
151
 
    FDataLink.Reset;
152
 
    SelectAll;
153
 
    Key := VK_UNKNOWN;
154
 
  end else
155
 
  if Key in [VK_DELETE, VK_BACK] then begin
156
 
    if not IsReadOnly then
157
 
      FDatalink.Edit
158
 
    else
159
 
      Key := VK_UNKNOWN;
 
118
  case key of
 
119
    VK_ESCAPE:
 
120
      begin
 
121
       //cancel out of editing by reset on esc
 
122
       FDataLink.Reset;
 
123
       SelectAll;
 
124
       Key := VK_UNKNOWN;
 
125
      end;
 
126
    VK_DELETE, VK_BACK:
 
127
      begin
 
128
        if not FieldIsEditable(FDatalink.Field) or not FDataLink.Edit then
 
129
          Key := VK_UNKNOWN;
 
130
      end;
160
131
  end;
161
132
end;
162
133
 
163
 
procedure TDBEdit.KeyPress(var Key: char);
164
 
  function CanAcceptKey(AKey: char): boolean;
165
 
  begin
166
 
    Result := (Field<>nil) and Field.IsValidChar(AKey) and
167
 
              (Field.DataType<>ftAutoInc);
168
 
  end;
 
134
procedure TDBEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
169
135
var
170
 
  SavedKey: Char;
 
136
  CharKey: Char;
171
137
begin
172
 
  SavedKey := Key;
173
 
  inherited KeyPress(Key);
174
 
  //TCustomMaskEdit sets all normal Keys (and BackSpace) to #0 if IsMasked
175
 
  //but not if control is ReadOnly
176
 
  if (not IsMasked) or (inherited ReadOnly) then
177
 
  begin
178
 
    case Key of
179
 
      #8: // special keys
180
 
        if not IsReadOnly then
181
 
          FDatalink.Edit
182
 
        else
183
 
          Key:=#0;
184
 
 
185
 
      #32..#255: //standard keys
186
 
        if not IsReadOnly and CanAcceptKey(Key) then
187
 
          FDatalink.Edit
188
 
        else
189
 
          Key:=#0;
190
 
    end;//case
191
 
  end
 
138
  inherited UTF8KeyPress(UTF8Key);
 
139
  //If the pressed key is unicode then map the char to #255
 
140
  //Necessary to keep the TField.IsValidChar check
 
141
  if Length(UTF8Key) = 1 then
 
142
    CharKey := UTF8Key[1]
192
143
  else
 
144
    CharKey := #255;
 
145
 
 
146
  //handle standard keys
 
147
  if CharKey in [#32..#255] then
193
148
  begin
194
 
    case SavedKey of
195
 
      #8: // special keys
196
 
        if not IsReadOnly then
197
 
          FDatalink.Edit;
198
 
      #32..#255: //standard keys
199
 
        if not IsReadOnly and CanAcceptKey(SavedKey) then
200
 
          FDatalink.Edit;
201
 
    end;//case
 
149
    if not FieldCanAcceptKey(FDataLink.Field, CharKey) or not FDatalink.Edit then
 
150
      UTF8Key := '';
202
151
  end;
203
152
end;
204
153
 
205
 
procedure TDBEdit.Loaded;
206
 
begin
207
 
  inherited Loaded;
208
 
  //need to make sure the state is updated on first load
209
 
  if (csDesigning in ComponentState) then
210
 
    DataChange(Self);
211
 
end;
212
 
 
213
 
procedure TDBEdit.Notification(AComponent: TComponent;
214
 
  Operation: TOperation);
 
154
procedure TDBEdit.Notification(AComponent: TComponent; Operation: TOperation);
215
155
begin
216
156
  inherited Notification(AComponent, Operation);
217
157
  // if the datasource is being removed then we need to make sure
226
166
function TDBEdit.EditCanModify: Boolean;
227
167
begin
228
168
  //should follow the FieldLink for this one
229
 
  Result := FDataLink.Edit;
 
169
  Result := FDataLink.CanModify;
230
170
end;
231
171
 
232
172
function TDBEdit.GetEditText: string;
260
200
procedure TDBEdit.WMSetFocus(var Message: TLMSetFocus);
261
201
begin
262
202
  inherited WMSetFocus(Message);
263
 
  FDataLink.Reset;
 
203
  // some widgetsets do not notify clipboard actions properly. Put at edit state at entry
 
204
  if WidgetSet.GetLCLCapability(lcReceivesLMClearCutCopyPasteReliably) = LCL_CAPABILITY_YES then
 
205
    FDataLink.Reset
 
206
  else
 
207
    FDataLink.Edit;
264
208
end;
265
209
 
266
210
procedure TDBEdit.WMKillFocus(var Message: TLMKillFocus);
282
226
    FDatalink.Reset;
283
227
end;
284
228
 
285
 
procedure TDBEdit.LMPasteFromClip(var Message: TLMessage);
286
 
begin
287
 
  if not IsReadOnly then
288
 
    FDatalink.Edit;
289
 
  inherited LMPasteFromClip(Message);
290
 
end;
291
 
 
292
 
procedure TDBEdit.LMCutToClip(var Message: TLMessage);
293
 
begin
294
 
  if not IsReadOnly then
295
 
    FDatalink.Edit;
296
 
  inherited LMCutToClip(Message);
 
229
procedure TDBEdit.WndProc(var Message: TLMessage);
 
230
begin
 
231
  case Message.Msg of
 
232
    LM_CLEAR,
 
233
    LM_CUT,
 
234
    LM_PASTE:
 
235
      begin
 
236
        if FDataLink.CanModify then
 
237
        begin
 
238
          //LCL changes the Text before LM_PASTE is called and not after like Delphi. Issue 20330
 
239
          //When Edit is called the Text property is reset to the previous value
 
240
          //Add a workaround while bug is not fixed
 
241
          FDataLink.OnDataChange := nil;
 
242
          FDatalink.Edit;
 
243
          FDataLink.Modified;
 
244
          FDataLink.OnDataChange := @DataChange;
 
245
          inherited WndProc(Message);
 
246
        end;
 
247
      end;
 
248
    else
 
249
      inherited WndProc(Message);
 
250
  end;
297
251
end;
298
252
 
299
253
{ Public Methods }
304
258
  FDataLink.Control := Self;
305
259
  FDataLink.OnDataChange := @DataChange;
306
260
  FDataLink.OnUpdateData := @UpdateData;
307
 
  FDataLink.OnActiveChange := @ActiveChange;
308
 
  FDataLink.OnLayoutChange := @LayoutChange;
309
261
end;
310
262
 
311
263
destructor TDBEdit.Destroy;
312
264
begin
313
 
  FDataLink.Free;
314
 
  FDataLink := nil;
 
265
  FDataLink.Destroy;
315
266
  inherited Destroy;
316
267
end;
317
268