File: lr_edit.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (324 lines) | stat: -rw-r--r-- 7,535 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324

{*****************************************}
{                                         }
{             FastReport v2.3             }
{               Memo editor               }
{                                         }
{  Copyright (c) 1998-99 by Tzyganenko A. }
{                                         }
{*****************************************}

unit LR_Edit;

interface

{$I LR_Vers.inc}

uses
  Classes, SysUtils, LResources,
  Forms, Controls, Graphics, Dialogs,
  Buttons, StdCtrls,ClipBrd,ExtCtrls,

  LCLType,LCLIntf,LCLProc,
  
  LR_Class, lr_propedit, SynEdit, SynHighlighterPas;

type

  { TfrEditorForm }

  TfrEditorForm = class(TPropEditor)
    Button6: TButton;
    CB1: TCheckBox;
    CB2: TCheckBox;
    CB3: TCheckBox;
    Label1: TLabel;
    M1: TMemo;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Panel3: TPanel;
    ScriptPanel: TPanel;
    Label2: TLabel;
    MemoPanel: TPanel;
    M2: TSynEdit;
    Splitter: TSplitter;
    SynPasSyn1: TSynPasSyn;
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure M1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button4Click(Sender: TObject);
    procedure M1Enter(Sender: TObject);
    procedure CB1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CB2Click(Sender: TObject);
    procedure CB3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    FActiveMemo: TWinControl;
    procedure InsertText(const S:string);
    function CheckScript:boolean;
  public
    function ShowEditor(AView: TfrView): TModalResult; virtual;
  end;

implementation

{$R *.lfm}

uses LR_Desgn, LR_Fmted, LR_Var, LR_Flds, LR_Const, lr_expres, strutils;

function TfrEditorForm.ShowEditor(AView: TfrView): TModalResult;
begin
  Button5.Enabled:=Assigned(AView);
  CB1.Enabled:=Assigned(AView);
  CB2.Enabled:=Assigned(AView);
  CB3.Enabled:=Assigned(AView);
  Result := inherited ShowEditor(AView);
end;

procedure TfrEditorForm.FormShow(Sender: TObject);
begin
  {$IFDEF DebugLR}
  DebugLn('TfrEditorForm.FormShow INIT HandleAllocated=', dbgs(HandleAllocated));
  {$ENDIF}
  CB1Click(nil);
  CB2Click(nil);
  CB3Click(nil);
  if Assigned(View) then
  begin
    M1.Lines.Text:=View.Memo.Text;
    if not M1.HandleAllocated then
      M1.SelStart:=0;
    M1.SetFocus;
    FActiveMemo := M1;
    CB1.Checked:=(View.Script.Count>0) or (View is TfrControl);
    M2.Lines.Text:=View.Script.Text;
    Button5.Visible := (View is TfrMemoView);
  end
  else
  begin
    Button5.Visible := false;
  end;
  M1.Font.Charset := frCharset;
  M2.Font.Charset := frCharset;

  if edtScriptFontName <> '' then
    M2.Font.Name:=edtScriptFontName;

  if edtScriptFontSize > 0 then
    M2.Font.Size:=edtScriptFontSize;

  {$IFDEF DebugLR}
  DebugLn('TfrEditorForm.FormShow END');
  {$ENDIF}
end;

procedure TfrEditorForm.Button3Click(Sender: TObject);
begin
  frVarForm := TfrVarForm.Create(Application);
  try
    if (frVarForm.ShowModal = mrOk) then
      InsertText(frVarForm.SelectedItem);
  finally
    frVarForm.Free;
  end;
  FActiveMemo.SetFocus;
end;

procedure TfrEditorForm.Button6Click(Sender: TObject);
var
  lrExpresionEditorForm: TlrExpresionEditorForm;
begin
  lrExpresionEditorForm:=TlrExpresionEditorForm.Create(Application);
  try
    if lrExpresionEditorForm.ShowModal = mrOk then
      InsertText(lrExpresionEditorForm.ResultExpresion);
  finally
    lrExpresionEditorForm.Free;
  end;
end;

procedure TfrEditorForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  if ModalResult = mrOk then
  begin
    CanClose:=CheckScript;
    if CanClose then
    begin
      frDesigner.BeforeChange;
      M1.WordWrap := False;
      if Assigned(View) then
      begin
        View.Memo.Text := M1.Text;
        View.Script.Text := M2.Text;
      end;
    end
    else
      ModalResult:=mrNone;
  end;
end;

procedure TfrEditorForm.M1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = vk_Insert) and (Shift = []) then Button3Click(Self);
  if Key = vk_Escape then ModalResult := mrCancel;
end;

procedure TfrEditorForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Chr(Key) = 'F') and (ssCtrl in Shift) and Button5.Visible then
  begin
    Button5Click(nil);
    Key := 0;
  end;
  if (Key = vk_Return) and (ssCtrl in Shift) then
  begin
    ModalResult := mrOk;
    Key := 0;
  end;
end;

procedure TfrEditorForm.Button4Click(Sender: TObject);
begin
  frFieldsForm := TfrFieldsForm.Create(Application);
  try
    if frFieldsForm.ShowModal = mrOk then
      InsertText(frFieldsForm.DBField);
  finally
    frFieldsForm.Free;
  end;
  FActiveMemo.SetFocus;
end;

procedure TfrEditorForm.M1Enter(Sender: TObject);
begin
  FActiveMemo := Sender as TWinControl;
end;

procedure TfrEditorForm.CB1Click(Sender: TObject);
begin
  ScriptPanel.Visible := CB1.Checked;
  Splitter.Visible:= CB1.Checked;
  if Splitter.Visible then
    Splitter.Top:=MemoPanel.Height+1;

  if ScriptPanel.Visible then
    M2.SetFocus
  else
    M1.SetFocus
end;

procedure TfrEditorForm.CB2Click(Sender: TObject);
begin
{  if CB2.Checked then
    M1.Font.Size := 12
  else
    M1.Font.Size := 10;
  M2.Font.Size := M1.Font.Size;
}
end;

procedure TfrEditorForm.CB3Click(Sender: TObject);
begin
  M1.WordWrap := CB3.Checked;
end;

procedure TfrEditorForm.FormCreate(Sender: TObject);
begin
  Caption := sEditorFormCapt;
  Label1.Caption := sEditorFormMemo;
  CB1.Caption := sEditorFormScript;
  CB2.Caption := sEditorFormBig;
  CB3.Caption := sEditorFormWord;
  Label2.Caption := sEditorFormScr;
  Button3.Caption := sEditorFormVar;
  Button4.Caption := sEditorFormField;
  Button5.Caption := sEditorFormFormat;
  Button6.Caption := sEditorFormFunction;
  Button1.Caption := sOk;
  Button2.Caption := sCancel;

end;

procedure TfrEditorForm.Button5Click(Sender: TObject);
var
  t: TfrMemoView;
begin
  if not Assigned(View) then Exit;
  t := TfrMemoView(View);
  frFmtForm := TfrFmtForm.Create(nil);
  with frFmtForm do
  begin
    EdFormat := t.Format;
    EdFormatStr:=t.FormatStr;
    if ShowModal = mrOk then
    begin
      frDesigner.BeforeChange;
      t.Format := EdFormat;
      t.FormatStr := EdFormatStr;
    end;
  end;
  frFmtForm.Free;
end;

procedure TfrEditorForm.InsertText(const S: string);
begin
  if S<>'' then
  begin
    if FActiveMemo is TMemo then
      TMemo(FActiveMemo).SelText:='['+S+']'
    else
    if FActiveMemo is TSynEdit then
      TSynEdit(FActiveMemo).SelText:='['+S+']'
  end;
end;

function TfrEditorForm.CheckScript: boolean;
var
  sl1, sl2: TStringList;

procedure ErrorPosition(S:string);
var
  X, Y: LongInt;
begin
  if Pos('/', S) = 0 then exit;

  Y := StrToInt(Copy2SymbDel(S, '/'));
  X := StrToInt(Copy2SymbDel(S,':'));
  M2.CaretX:=X;
  M2.CaretY:=Y;
  M2.SetFocus;
end;

begin
  Result:=true;
  sl1 := TStringList.Create;
  sl2 := TStringList.Create;
  try
    frInterpretator.PrepareScript(M2.Lines, sl1, sl2);
    if sl2.Count > 0 then
    begin
      ErrorPosition(Copy(sl2.Text, Length(sErrLine)+1, Length(sl2.Text)));
      ShowMessage(sl2.Text);
      Result:=false;
    end;
  finally
    sl1.Free;
    sl2.Free;
  end;
end;

end.