examples/Delphi/ExTextU.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit ExTextU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TSTDlg = class(TForm)
    Memo1: TMemo;
    OD1: TOpenDialog;
    LoadBtn: TButton;
    SeekBtn: TButton;
    FlushBtn: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    CloseFBtn: TButton;
    procedure LoadBtnClick(Sender: TObject);
    procedure SeekBtnClick(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FlushBtnClick(Sender: TObject);
    procedure CloseFBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure UpdatePos;
    procedure UpdateButtons(FOK : Boolean);
  end;

var
  STDlg: TSTDlg;

implementation

{$R *.DFM}

uses
  StConst,
  StBase,
  StText;


var
  F   : TextFile;
  AFO : Boolean;


procedure TSTDlg.UpdateButtons(FOK : Boolean);
begin
  CloseFBtn.Enabled := FOK;
  SeekBtn.Enabled   := FOK;
  FlushBtn.Enabled  := FOK;
end;

procedure TSTDlg.FormCreate(Sender: TObject);
begin
  UpdateButtons(False);
  AFO := False;
end;

procedure TSTDlg.LoadBtnClick(Sender: TObject);
var
  S  : string;
  hC : HCursor;
begin
  if (OD1.Execute) then
  begin
    if (AFO) then
      CloseFile(F);
    AFO := False;

    AssignFile(F,OD1.FileName);
    ReSet(F);

    Memo1.Enabled := True;
    Memo1.Perform(WM_SETREDRAW,0,0);
    hC := SetCursor(LoadCursor(0,IDC_WAIT));

    while NOT EOF(F) do
    begin
      Readln(F,S);
      Memo1.Lines.Add(S);
    end;

    Memo1.Perform(WM_SETREDRAW,1,0);
    Memo1.Update;
    Memo1.SelStart := 0;
    Memo1.SelLength := 0;

    Reset(F);

    Edit1.Text := OD1.FileName;
    Edit2.Text := IntToStr(TextFileSize(F));
    Edit3.Text := IntToStr(TextPos(F));

    SetCursor(hC);
    Memo1.SetFocus;
    AFO := True;
  end;
  UpdateButtons(AFO);
end;

procedure TSTDlg.CloseFBtnClick(Sender: TObject);
begin
  CloseFile(F);
  Memo1.Clear;
  AFO := False;
  UpdateButtons(False);
end;


procedure TSTDlg.SeekBtnClick(Sender: TObject);
var
  NP : LongInt;
begin
  NP := StrToInt(Edit4.Text);
  Memo1.SetFocus;
  if (NP < 0) OR (NP >= TextFileSize(F)) then
  begin
    ShowMessage('Value out of range');
    Exit;
  end;

  if TextSeek(F,NP) then
  begin
    NP := TextPos(F);
    Memo1.SelStart := NP;
    Memo1.SelLength := 0;
    Edit3.Text := IntToStr(NP);
  end else
  begin
    ShowMessage('Unable to seek to position');
    Memo1.SetFocus;
  end;
end;

procedure TSTDlg.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  UpdatePos;
end;

procedure TSTDlg.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  UpdatePos;
end;


procedure TSTDlg.UpdatePos;
var
  CP : LongInt;
begin
  CP := Memo1.SelStart;

  if NOT TextSeek(F,CP) then
  begin
    ShowMessage('Unable to update file pointer');
    Exit;
  end;

  Edit3.Text := IntToStr(TextPos(F));
end;

procedure TSTDlg.FlushBtnClick(Sender: TObject);
begin
  if NOT (TextFlush(F)) then
  begin
    ShowMessage('Unable to flush file');
  end;
  Memo1.SetFocus;
end;


procedure TSTDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if AFO then CloseFile(F);
end;

procedure TSTDlg.FormShow(Sender: TObject);
begin
  LoadBtn.SetFocus;
end;

end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	unit ExTextU;
27
28	interface
29
30	uses
31	Windows, Messages, SysUtils, Classes, Graphics, Controls,
32	Forms, Dialogs, StdCtrls;
33
34	type
35	TSTDlg = class(TForm)
36	Memo1: TMemo;
37	OD1: TOpenDialog;
38	LoadBtn: TButton;
39	SeekBtn: TButton;
40	FlushBtn: TButton;
41	Label1: TLabel;
42	Edit1: TEdit;
43	Label2: TLabel;
44	Edit2: TEdit;
45	Label3: TLabel;
46	Edit3: TEdit;
47	Edit4: TEdit;
48	CloseFBtn: TButton;
49	procedure LoadBtnClick(Sender: TObject);
50	procedure SeekBtnClick(Sender: TObject);
51	procedure Memo1KeyUp(Sender: TObject; var Key: Word;
52	Shift: TShiftState);
53	procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
54	Shift: TShiftState; X, Y: Integer);
55	procedure FlushBtnClick(Sender: TObject);
56	procedure CloseFBtnClick(Sender: TObject);
57	procedure FormCreate(Sender: TObject);
58	procedure FormClose(Sender: TObject; var Action: TCloseAction);
59	procedure FormShow(Sender: TObject);
60	private
61	{ Private declarations }
62	public
63	{ Public declarations }
64	procedure UpdatePos;
65	procedure UpdateButtons(FOK : Boolean);
66	end;
67
68	var
69	STDlg: TSTDlg;
70
71	implementation
72
73	{$R *.DFM}
74
75	uses
76	StConst,
77	StBase,
78	StText;
79
80
81	var
82	F : TextFile;
83	AFO : Boolean;
84
85
86	procedure TSTDlg.UpdateButtons(FOK : Boolean);
87	begin
88	CloseFBtn.Enabled := FOK;
89	SeekBtn.Enabled := FOK;
90	FlushBtn.Enabled := FOK;
91	end;
92
93	procedure TSTDlg.FormCreate(Sender: TObject);
94	begin
95	UpdateButtons(False);
96	AFO := False;
97	end;
98
99	procedure TSTDlg.LoadBtnClick(Sender: TObject);
100	var
101	S : string;
102	hC : HCursor;
103	begin
104	if (OD1.Execute) then
105	begin
106	if (AFO) then
107	CloseFile(F);
108	AFO := False;
109
110	AssignFile(F,OD1.FileName);
111	ReSet(F);
112
113	Memo1.Enabled := True;
114	Memo1.Perform(WM_SETREDRAW,0,0);
115	hC := SetCursor(LoadCursor(0,IDC_WAIT));
116
117	while NOT EOF(F) do
118	begin
119	Readln(F,S);
120	Memo1.Lines.Add(S);
121	end;
122
123	Memo1.Perform(WM_SETREDRAW,1,0);
124	Memo1.Update;
125	Memo1.SelStart := 0;
126	Memo1.SelLength := 0;
127
128	Reset(F);
129
130	Edit1.Text := OD1.FileName;
131	Edit2.Text := IntToStr(TextFileSize(F));
132	Edit3.Text := IntToStr(TextPos(F));
133
134	SetCursor(hC);
135	Memo1.SetFocus;
136	AFO := True;
137	end;
138	UpdateButtons(AFO);
139	end;
140
141	procedure TSTDlg.CloseFBtnClick(Sender: TObject);
142	begin
143	CloseFile(F);
144	Memo1.Clear;
145	AFO := False;
146	UpdateButtons(False);
147	end;
148
149
150	procedure TSTDlg.SeekBtnClick(Sender: TObject);
151	var
152	NP : LongInt;
153	begin
154	NP := StrToInt(Edit4.Text);
155	Memo1.SetFocus;
156	if (NP < 0) OR (NP >= TextFileSize(F)) then
157	begin
158	ShowMessage('Value out of range');
159	Exit;
160	end;
161
162	if TextSeek(F,NP) then
163	begin
164	NP := TextPos(F);
165	Memo1.SelStart := NP;
166	Memo1.SelLength := 0;
167	Edit3.Text := IntToStr(NP);
168	end else
169	begin
170	ShowMessage('Unable to seek to position');
171	Memo1.SetFocus;
172	end;
173	end;
174
175	procedure TSTDlg.Memo1KeyUp(Sender: TObject; var Key: Word;
176	Shift: TShiftState);
177	begin
178	UpdatePos;
179	end;
180
181	procedure TSTDlg.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
182	Shift: TShiftState; X, Y: Integer);
183	begin
184	UpdatePos;
185	end;
186
187
188	procedure TSTDlg.UpdatePos;
189	var
190	CP : LongInt;
191	begin
192	CP := Memo1.SelStart;
193
194	if NOT TextSeek(F,CP) then
195	begin
196	ShowMessage('Unable to update file pointer');
197	Exit;
198	end;
199
200	Edit3.Text := IntToStr(TextPos(F));
201	end;
202
203	procedure TSTDlg.FlushBtnClick(Sender: TObject);
204	begin
205	if NOT (TextFlush(F)) then
206	begin
207	ShowMessage('Unable to flush file');
208	end;
209	Memo1.SetFocus;
210	end;
211
212
213
214	procedure TSTDlg.FormClose(Sender: TObject; var Action: TCloseAction);
215	begin
216	if AFO then CloseFile(F);
217	end;
218
219	procedure TSTDlg.FormShow(Sender: TObject);
220	begin
221	LoadBtn.SetFocus;
222	end;
223
224	end.