← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/sqldb/sqlstringspropertyeditordlg.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:
components/sqldb/sqlstringspropertyeditordlg.pas
11
11
uses
12
12
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
13
13
  SynEdit, ButtonPanel, SynHighlighterSQL, ComCtrls, SQLDb, db, DBGrids, Menus,
14
 
  SrcEditorIntf,clipbrd;
 
14
  SrcEditorIntf,clipbrd, StdCtrls;
15
15
 
16
16
type
17
17
 
19
19
 
20
20
  TSQLStringsPropertyEditorDlg = class(TForm)
21
21
    ButtonsPanel: TButtonPanel;
 
22
    CbxMetaData: TComboBox;
 
23
    MIPaste: TMenuItem;
 
24
    MetaDBGrid: TDBGrid;
 
25
    EdtObject: TEdit;
22
26
    ImageList: TImageList;
 
27
    Label1: TLabel;
 
28
    MIMeta: TMenuItem;
 
29
    MIMetaColumns: TMenuItem;
23
30
    MICheck: TMenuItem;
24
31
    MICreateConstant: TMenuItem;
25
32
    MICleanup: TMenuItem;
26
33
    PMSQL: TPopupMenu;
 
34
    PMMeta: TPopupMenu;
27
35
    ResultDBGrid: TDBGrid;
28
36
    SQLDataSource: TDatasource;
29
37
    OpenDialog: TOpenDialog;
30
38
    PageControl: TPageControl;
31
39
    SaveDialog: TSaveDialog;
 
40
    SQLDataSource1: TDatasource;
32
41
    SQLEditor: TSynEdit;
33
42
    SQLHighlighter: TSynSQLSyn;
34
43
    EditorTabSheet: TTabSheet;
35
44
    ResultTabSheet: TTabSheet;
36
45
    SQLQuery: TSQLQuery;
 
46
    MetaTabSheet: TTabSheet;
 
47
    SQLMeta: TSQLQuery;
37
48
    ToolBar: TToolBar;
38
49
    OpenToolButton: TToolButton;
39
50
    SaveToolButton: TToolButton;
40
51
    DividerToolButton: TToolButton;
41
52
    ExecuteToolButton: TToolButton;
42
53
    TBCheck: TToolButton;
 
54
    procedure MetaDBGridDblClick(Sender: TObject);
43
55
    procedure ExecuteToolButtonClick(Sender: TObject);
44
56
    procedure FormShow(Sender: TObject);
45
57
    procedure MICleanupClick(Sender: TObject);
46
58
    procedure MICreateConstantClick(Sender: TObject);
 
59
    procedure MIMetaColumnsClick(Sender: TObject);
 
60
    procedure MIPasteClick(Sender: TObject);
47
61
    procedure OpenToolButtonClick(Sender: TObject);
48
62
    procedure SaveToolButtonClick(Sender: TObject);
 
63
    procedure SQLEditorMouseDown(Sender: TObject; Button: TMouseButton;
 
64
      Shift: TShiftState; X, Y: Integer);
49
65
    procedure TBCheckClick(Sender: TObject);
50
66
  private
51
67
    { private declarations }
 
68
    FMetaFromSynedit: Boolean;
52
69
    FConnection:TSQLConnection;
53
70
    FISSQLScript: Boolean;
54
71
    FTransaction:TSQLTransaction;
55
 
 
 
72
    FWordUnderCursor:string;
56
73
    function CheckConnection:boolean;
57
 
    procedure CheckSQLSyntax(SQL: TStrings);
 
74
    procedure CheckSQLSyntax({%H-}SQL: TStrings);
58
75
    procedure CleanupDelphiCode;
59
76
    procedure CreateConstant;
 
77
    procedure ShowMetaData;
60
78
  public
61
79
    { public declarations }
62
80
    constructor Create(AOwner:TComponent);override;
77
95
{$R *.lfm}
78
96
 
79
97
resourcestring
 
98
  SResultTabCaption = 'Results';
80
99
  SSQLTabCaption    = 'SQL Code';
81
 
  SResultTabCaption = 'Results';
 
100
  SMetaTabCaption   = 'Metadata';
 
101
  SMetaTables       = 'Tables';
 
102
  SMetaColumns      = 'Columns';
 
103
  SMetaProcedures   = 'Procedures';
 
104
  SMetaPleaseSpecifyATableInTheObjectField = 'Please specify a table in the '
 
105
    +'object field.';
 
106
  SMetaSysTables    = 'SysTables';
 
107
  {$IFDEF HASSQLPARSER}
82
108
  SSQLOK            = 'SQL OK';
83
109
  SQLSyntaxOK       = 'No syntax errors in SQL statement.';
84
110
  SSQLError         = 'SQL Error';
85
111
  SSQLSyntaxError   = 'Syntax error in SQL statement:'+slineBreak+'%s';
 
112
  {$ENDIF}
86
113
 
87
114
{ TSQLStringsPropertyEditorDlg }
88
115
 
94
121
  SourceEditorManagerIntf.GetHighlighterSettings(SQLHighlighter);
95
122
  EditorTabSheet.Caption := SSQLTabCaption;
96
123
  ResultTabSheet.Caption := SResultTabCaption;
 
124
  MetaTabSheet.Caption := SMetaTabCaption;
 
125
  CbxMetaData.Items.Add(SMetaTables);
 
126
  CbxMetaData.Items.Add(SMetaSysTables);
 
127
  CbxMetaData.Items.Add(SMetaColumns);
 
128
  CbxMetaData.Items.Add(SMetaProcedures);
97
129
end;
98
130
 
99
131
//----------------------------------------------------------//
113
145
//---------------------------------------------------------------------------//
114
146
procedure TSQLStringsPropertyEditorDlg.ExecuteToolButtonClick(Sender: TObject);
115
147
begin
116
 
  try
117
 
    SQLQuery.Close;
118
 
    SQLQuery.SQL.Text := SQLEditor.Text;
119
 
    SQLQuery.Open;
120
 
    PageControl.ActivePage := ResultTabSheet;
121
 
  except
122
 
    on e:Exception do
123
 
      MessageDlg(e.Message, mtError, [mbOK], 0);
124
 
  end;
 
148
  FMetaFromSynedit:=Sender.ClassNameIs('TMenuItem');
 
149
  if PageControl.ActivePage=MetaTabSheet then
 
150
    ShowMetaData
 
151
  else
 
152
    try
 
153
      SQLQuery.Close;
 
154
      SQLQuery.SQL.Text := SQLEditor.Text;
 
155
      SQLQuery.Open;
 
156
      PageControl.ActivePage := ResultTabSheet;
 
157
    except
 
158
      on e:Exception do
 
159
        MessageDlg(e.Message, mtError, [mbOK], 0);
 
160
    end;
 
161
end;
 
162
 
 
163
procedure TSQLStringsPropertyEditorDlg.MetaDBGridDblClick(Sender: TObject);
 
164
begin
 
165
  if assigned(MetaDBGrid.SelectedField) and (MetaDBGrid.SelectedField.Value <> NULL) then
 
166
    if FMetaFromSynedit then
 
167
      begin
 
168
      MIPasteClick(Sender);
 
169
      end
 
170
    else
 
171
      EdtObject.Text:=MetaDBGrid.SelectedField.AsString;
125
172
end;
126
173
 
127
174
//-------------------------------------------------------------//
152
199
    begin
153
200
    SQLQuery.DataBase    := FConnection;
154
201
    SQLQuery.Transaction := FTransaction;
 
202
    SQLMeta.DataBase    := FConnection;
 
203
    SQLMeta.Transaction := FTransaction;
155
204
    ResultTabSheet.TabVisible    := True;
 
205
    MetaTabSheet.TabVisible    := True;
156
206
    ExecuteToolButton.Visible := True;
157
207
    FConnection.GetTableNames(SQLHighLighter.TableNames);
158
208
    end
159
209
  else
160
210
    begin
161
211
    ResultTabSheet.TabVisible    := False;
 
212
    MetaTabSheet.TabVisible    := False;
162
213
    ExecuteToolButton.Visible := False;
163
214
    end;
164
215
  SQLHighlighter.SQLDIalect:=D;
165
216
  SQLHighlighter.Enabled:=True;
 
217
  CbxMetaData.ItemIndex:=0;
166
218
{$ifdef unix}
167
 
  {$ifndef darwin}
 
219
  // keep this only because of gtk1
 
220
  {$ifdef LCLGtk}
168
221
  SQLEditor.Font.Name:='-adobe-courier-medium-r-normal-*-8-*-*-*-m-*-iso10646-1';
169
222
  {$endif}
170
223
{$endif}
214
267
  CreateConstant;
215
268
end;
216
269
 
 
270
procedure TSQLStringsPropertyEditorDlg.MIMetaColumnsClick(Sender: TObject);
 
271
begin
 
272
  if FWordUnderCursor<>'' then
 
273
    begin
 
274
    CbxMetaData.ItemIndex:=2; //stColumns
 
275
    EdtObject.Text:=FWordUnderCursor;
 
276
    PageControl.ActivePage:=MetaTabSheet;
 
277
    ExecuteToolButtonClick(Sender);
 
278
    end;
 
279
end;
 
280
 
 
281
procedure TSQLStringsPropertyEditorDlg.MIPasteClick(Sender: TObject);
 
282
 
 
283
begin
 
284
  if assigned(MetaDBGrid.SelectedField) and (MetaDBGrid.SelectedField.Value <> NULL) then
 
285
    begin
 
286
    SQLEditor.InsertTextAtCaret(' '+TSQLConnection(SQLMeta.DataBase).FieldNameQuoteChars[0]+
 
287
      trim(MetaDBGrid.SelectedField.AsString)+TSQLConnection(SQLMeta.DataBase).FieldNameQuoteChars[1]);
 
288
    PageControl.ActivePage:=EditorTabSheet;
 
289
    end;
 
290
end;
 
291
 
217
292
procedure TSQLStringsPropertyEditorDlg.CreateConstant;
218
293
 
219
294
Var
221
296
  I : Integer;
222
297
 
223
298
begin
 
299
  C:='';
224
300
  For I:=0 to SQLEditor.Lines.Count-1 do
225
301
    begin
226
302
    S:=SQLEditor.Lines[i];
232
308
  Clipboard.AsText:=C;
233
309
end;
234
310
 
 
311
procedure TSQLStringsPropertyEditorDlg.ShowMetaData;
 
312
var
 
313
  SchemaType:TSchemaType;
 
314
begin
 
315
  case CbxMetaData.ItemIndex of
 
316
    0:SchemaType:=stTables;
 
317
    2:begin
 
318
        SchemaType:=stColumns;
 
319
        if EdtObject.Text='' then
 
320
          begin
 
321
          ShowMessage(SMetaPleaseSpecifyATableInTheObjectField);
 
322
          exit;
 
323
          end;
 
324
      end;
 
325
    3:SchemaType:=stProcedures;
 
326
    1:SchemaType:=stSysTables;
 
327
    else
 
328
      SchemaType:=stNoSchema;
 
329
  end;
 
330
  if SchemaType<>stNoSchema then
 
331
    try
 
332
      SQLMeta.Close;
 
333
      SQLMeta.SetSchemaInfo(SchemaType,EdtObject.Text,'');
 
334
      SQLMeta.Open;
 
335
    except
 
336
      on e:Exception do
 
337
        MessageDlg(e.Message, mtError, [mbOK], 0);
 
338
    end;
 
339
end;
 
340
 
235
341
//------------------------------------------------------------------------//
236
342
procedure TSQLStringsPropertyEditorDlg.SaveToolButtonClick(Sender: TObject);
237
343
begin
239
345
    SQLEditor.Lines.SaveToFile(UTF8ToSys(SaveDialog.FileName));
240
346
end;
241
347
 
 
348
procedure TSQLStringsPropertyEditorDlg.SQLEditorMouseDown(Sender: TObject;
 
349
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 
350
var
 
351
  MPos,Caret:tpoint;
 
352
 
 
353
begin
 
354
  If Button=mbRight then // save word under cursor
 
355
    begin
 
356
    FWordUnderCursor:='';
 
357
    MPos.x:=x;
 
358
    MPos.y:=y;
 
359
    Caret:=SQLEditor.PhysicalToLogicalPos(SQLEditor.PixelsToLogicalPos(MPos));
 
360
    FWordUnderCursor:=SQLEditor.GetWordAtRowCol(Caret);
 
361
    end;
 
362
end;
 
363
 
242
364
procedure TSQLStringsPropertyEditorDlg.TBCheckClick(Sender: TObject);
243
365
begin
244
366
  CheckSQLSyntax(SQLEditor.Lines)