oup/current/Tool_Template.pas

unit Tool_Template;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, StrUtils,
  Code_OniDataClass, Code_Functions, Data, Menus;

type
  TNewFileSelectedEvent = procedure(fileinfo: TFileInfo) of object;

  TForm_ToolTemplate = class(TForm)
    panel_files: TPanel;
    filelist: TListBox;
    panel_extension: TPanel;
    label_ext: TLabel;
    combo_extension: TComboBox;
    check_zerobyte: TCheckBox;
    edit_filtername: TEdit;
    check_filtername: TCheckBox;
    Splitter1: TSplitter;
    content: TPanel;
    filepopup: TPopupMenu;
    popup_import: TMenuItem;
    popup_export: TMenuItem;
    popup_separator: TMenuItem;
    importd: TOpenDialog;
    exportd: TSaveDialog;
    procedure RecreateList;
    procedure LoadFileNames;
    procedure SelectFileName(filename: String);
    procedure SelectFileID(id: Integer);
    procedure check_filternameClick(Sender: TObject);
    procedure check_zerobyteClick(Sender: TObject);
    procedure combo_extensionClick(Sender: TObject);
    procedure listClick(Sender: TObject);
    procedure listMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure popup_importClick(Sender: TObject);
    procedure popup_exportClick(Sender: TObject);
    procedure popup_opentool(Sender: TObject);
    procedure filepopupPopup(Sender: TObject);
  private
    FOnNewFileSelected: TNewFileSelectedEvent;
    FAllowedExts: String;
    FAllowMultiSelect: Boolean;
    procedure SetAllowedExts(exts: String);
    procedure SetMultiSelect(allow: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property OnNewFileSelected: TNewFileSelectedEvent read FOnNewFileSelected write FOnNewFileSelected;
    property AllowedExts: String read FAllowedExts write SetAllowedExts;
    property AllowMultiSelect: Boolean read FAllowMultiSelect write SetMultiSelect;
  end;

var
  ToolList: TToolList;
procedure AddToolListEntry(context, name, exts: String);

implementation
{$R *.dfm}
uses Main, Code_Exporters;


procedure TForm_ToolTemplate.RecreateList;
var
  i:    LongWord;
  exts: TStringArray;
begin
  combo_extension.Items.Clear;
  combo_extension.Items.Add('_All files_ (' +
    IntToStr(OniDataConnection.GetFilesCount) + ')');
  exts := OniDataConnection.GetExtensionsList;
  for i := 0 to High(exts) do
    if Length(FAllowedExts) > 0 then
    begin
      if Pos(MidStr(exts[i],1,4), FAllowedExts) > 0 then
      begin
        combo_extension.Items.Add(exts[i]);
      end;
    end else
      combo_extension.Items.Add(exts[i]);
  combo_extension.ItemIndex := 0;
  combo_extensionClick(Self);
end;


procedure TForm_ToolTemplate.LoadFileNames;
var
  Extension: String;
  no_zero_bytes: Boolean;
  pattern: String;
  files: TStringArray;
  i: LongWord;
begin
  Extension := MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex], 1, 4);
  no_zero_bytes := not check_zerobyte.Checked;
  pattern := '';
  if check_filtername.Checked then
    pattern := edit_filtername.Text;
  if Extension = '_All' then
    if Length(FAllowedExts) > 0 then
      Extension := FAllowedExts
    else
      Extension := '';

  files := OniDataConnection.GetFilesList(extension, pattern, no_zero_bytes);

  filelist.Visible := False;
  filelist.Items.Clear;
  if Length(files) > 0 then
    for i := 0 to High(files) do
      filelist.Items.Add(files[i]);
  filelist.Visible := True;
end;


procedure TForm_ToolTemplate.popup_exportClick(Sender: TObject);
var
  id: Integer;
  ext: String;
begin
  id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
  ext := RightStr(filelist.Items.Strings[filelist.ItemIndex], 4);
  exportd.Filter := 'Files of matching extension (*.' + ext + ')|*.' + ext + '|All files|*.*';
  exportd.DefaultExt := ext;
  if exportd.Execute then
    ExportDatFile(id, exportd.FileName);
end;

procedure TForm_ToolTemplate.popup_importClick(Sender: TObject);
var
  id: Integer;
  finfo: TFileInfo;
  fs: TFileStream;
  data: TData;
begin
  id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
  finfo := OniDataConnection.GetFileInfo(id);

  importd.Filter := 'Files of matching extension (*.' + finfo.Extension + ')|*.' +
        finfo.Extension + '|All files|*.*';
  if importd.Execute then
  begin
    fs := TFileStream.Create(importd.FileName, fmOpenRead);
    if fs.Size <> finfo.Size then
      ShowMessage('Can''t import ' + ExtractFilename(importd.FileName) +
        ', file has to have same size as file in .dat.' + CrLf +
        'Size of file in .dat: ' + FormatFileSize(finfo.Size) + CrLf +
        'Size of chosen file: ' + FormatFileSize(fs.Size))
    else begin
      SetLength(data, fs.Size);
      fs.Read(data[0], fs.Size);
      OniDataConnection.UpdateDatFile(id, data);
      Self.listClick(Self);
    end;
    fs.Free;
  end;
end;

procedure TForm_ToolTemplate.popup_opentool(Sender: TObject);
var
  sender_name, context: String;
  id: Integer;
begin
  sender_name := TComponent(Sender).Name;
  id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
  context := MidStr(sender_name, Pos('_', sender_name) + 1, Length(sender_name) - Pos('_', sender_name));
  Form_Main.open_child(context, id);
end;

procedure TForm_ToolTemplate.combo_extensionClick(Sender: TObject);
begin
  LoadFileNames;
end;


constructor TForm_ToolTemplate.Create(AOwner: TComponent);
var
  i: Integer;
  item: TMenuItem;
begin
  inherited;
  RecreateList;
  if Length(ToolList) > 0 then
  begin
    for i := 0 to High(ToolList) do
    begin
      item := TMenuItem.Create(filepopup);
      item.Name := 'popup_' + ToolList[i].context;
      item.Caption := 'Open with ' + ToolList[i].name;
      item.OnClick := Self.popup_opentool;
      filepopup.Items.Insert(i, item);
    end;
  end;
end;

procedure TForm_ToolTemplate.filepopupPopup(Sender: TObject);
var
  ext: String;
  i: Integer;
begin
  ext := RightStr(filelist.Items.Strings[filelist.ItemIndex], 4);
  for i := 0 to High(ToolList) do
  begin
    filepopup.Items.Items[i].Enabled := True;
    if Length(ToolList[i].exts) > 0 then
      if Pos(ext, ToolList[i].exts) = 0 then
        filepopup.Items.Items[i].Enabled := False;
  end;
end;

procedure TForm_ToolTemplate.check_zerobyteClick(Sender: TObject);
begin
  LoadFileNames;
end;

procedure TForm_ToolTemplate.check_filternameClick(Sender: TObject);
begin
  edit_filtername.Enabled := not check_filtername.Checked;
  LoadFileNames;
end;

procedure TForm_ToolTemplate.listClick(Sender: TObject);
var
  fileid: Integer;
begin
  if filelist.ItemIndex > -1 then
  begin
    fileid := OniDataConnection.ExtractFileID(
          filelist.Items.Strings[filelist.ItemIndex]);
    if Assigned(FOnNewFileSelected) then
      FOnNewFileSelected(OniDataConnection.GetFileInfo(fileid));
  end;
end;

procedure TForm_ToolTemplate.listMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
begin
  pt.X := x;
  pt.Y := y;
  filelist.ItemIndex := filelist.ItemAtPos(pt, true);
  Self.listClick(Self);
end;


procedure TForm_ToolTemplate.SelectFileID(id: Integer);
var
  i: Integer;
begin
  filelist.ItemIndex := -1;
  if filelist.Items.Count > 0 then
    for i := 0 to filelist.Items.Count - 1 do
      if OniDataConnection.ExtractFileID(filelist.Items.Strings[i]) = id then
      begin
        filelist.ItemIndex := i;
        Break;
      end;
  Self.listClick(Self);
end;

procedure TForm_ToolTemplate.SelectFileName(filename: String);
var
  i: Integer;
begin
  filelist.ItemIndex := -1;
  if filelist.Items.Count > 0 then
    for i := 0 to filelist.Items.Count - 1 do
      if filelist.Items.Strings[i] = filename then
        filelist.ItemIndex := i;
  Self.listClick(Self);
end;

procedure TForm_ToolTemplate.SetAllowedExts(exts: String);
begin
  FAllowedExts := exts;
  RecreateList;
end;

procedure TForm_ToolTemplate.SetMultiSelect(allow: Boolean);
begin
  FAllowMultiSelect := allow;
  filelist.MultiSelect := allow;
end;


procedure TForm_ToolTemplate.FormResize(Sender: TObject);
begin
  if Self.Width < 300 then
    Self.Width := 300;
  if Self.Height < 200 then
    Self.Height := 200;
end;


procedure TForm_ToolTemplate.FormCreate(Sender: TObject);
begin
  Self.Width  := 260;
  Self.Height := 300;
  FOnNewFileSelected := nil;
  FAllowedExts := '';
  FAllowMultiSelect := False;
end;

procedure TForm_ToolTemplate.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;


procedure AddToolListEntryExt(context, ext: String);
var
  i: Integer;
begin
  for i := 0 to High(ToolList) do
    if ToolList[i].context = context then
    begin
      if Pos(ext, ToolList[i].exts) = 0 then
      begin
        if Length(ToolList[i].exts) = 0 then
          ToolList[i].exts := ext
        else
          ToolList[i].exts := ToolList[i].exts + ',' + ext;
      end;
      Exit;
    end;
end;

procedure AddToolListEntry(context, name, exts: String);
var
  i: Integer;
begin
  if Length(ToolList) > 0 then
  begin
    for i := 0 to High(ToolList) do
      if ToolList[i].context = context then
      begin
        if (Length(ToolList[i].name) = 0) and (Length(name) > 0) then
          ToolList[i].name := name;
        if Length(exts) > 0 then
          AddToolListEntryExt(context, exts);
        Exit;
      end;
  end;
  SetLength(ToolList, Length(ToolList) + 1);
  for i := High(ToolList) downto 1 do
    if ToolList[i - 1].name > name then
      ToolList[i] := ToolList[i - 1]
    else
      Break;
  ToolList[i].context := context;
  ToolList[i].name := name;
  ToolList[i].exts := exts;
end;

end.
Revision:	45
Committed:	Sat Dec 23 00:03:50 2006 UTC (18 years, 9 months ago) by alloc
Content type:	text/x-pascal
File size:	10197 byte(s)
Log Message:
#	Content
1	unit Tool_Template;
2
3	interface
4
5	uses
6	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7	Dialogs, ExtCtrls, StdCtrls, StrUtils,
8	Code_OniDataClass, Code_Functions, Data, Menus;
9
10	type
11	TNewFileSelectedEvent = procedure(fileinfo: TFileInfo) of object;
12
13	TForm_ToolTemplate = class(TForm)
14	panel_files: TPanel;
15	filelist: TListBox;
16	panel_extension: TPanel;
17	label_ext: TLabel;
18	combo_extension: TComboBox;
19	check_zerobyte: TCheckBox;
20	edit_filtername: TEdit;
21	check_filtername: TCheckBox;
22	Splitter1: TSplitter;
23	content: TPanel;
24	filepopup: TPopupMenu;
25	popup_import: TMenuItem;
26	popup_export: TMenuItem;
27	popup_separator: TMenuItem;
28	importd: TOpenDialog;
29	exportd: TSaveDialog;
30	procedure RecreateList;
31	procedure LoadFileNames;
32	procedure SelectFileName(filename: String);
33	procedure SelectFileID(id: Integer);
34	procedure check_filternameClick(Sender: TObject);
35	procedure check_zerobyteClick(Sender: TObject);
36	procedure combo_extensionClick(Sender: TObject);
37	procedure listClick(Sender: TObject);
38	procedure listMouseDown(Sender: TObject; Button: TMouseButton;
39	Shift: TShiftState; X, Y: Integer);
40
41	procedure FormResize(Sender: TObject);
42	procedure FormCreate(Sender: TObject);
43	procedure FormClose(Sender: TObject; var Action: TCloseAction);
44	procedure popup_importClick(Sender: TObject);
45	procedure popup_exportClick(Sender: TObject);
46	procedure popup_opentool(Sender: TObject);
47	procedure filepopupPopup(Sender: TObject);
48	private
49	FOnNewFileSelected: TNewFileSelectedEvent;
50	FAllowedExts: String;
51	FAllowMultiSelect: Boolean;
52	procedure SetAllowedExts(exts: String);
53	procedure SetMultiSelect(allow: Boolean);
54	public
55	constructor Create(AOwner: TComponent); override;
56	published
57	property OnNewFileSelected: TNewFileSelectedEvent read FOnNewFileSelected write FOnNewFileSelected;
58	property AllowedExts: String read FAllowedExts write SetAllowedExts;
59	property AllowMultiSelect: Boolean read FAllowMultiSelect write SetMultiSelect;
60	end;
61
62	var
63	ToolList: TToolList;
64	procedure AddToolListEntry(context, name, exts: String);
65
66	implementation
67	{$R *.dfm}
68	uses Main, Code_Exporters;
69
70
71	procedure TForm_ToolTemplate.RecreateList;
72	var
73	i: LongWord;
74	exts: TStringArray;
75	begin
76	combo_extension.Items.Clear;
77	combo_extension.Items.Add('_All files_ (' +
78	IntToStr(OniDataConnection.GetFilesCount) + ')');
79	exts := OniDataConnection.GetExtensionsList;
80	for i := 0 to High(exts) do
81	if Length(FAllowedExts) > 0 then
82	begin
83	if Pos(MidStr(exts[i],1,4), FAllowedExts) > 0 then
84	begin
85	combo_extension.Items.Add(exts[i]);
86	end;
87	end else
88	combo_extension.Items.Add(exts[i]);
89	combo_extension.ItemIndex := 0;
90	combo_extensionClick(Self);
91	end;
92
93
94
95
96	procedure TForm_ToolTemplate.LoadFileNames;
97	var
98	Extension: String;
99	no_zero_bytes: Boolean;
100	pattern: String;
101	files: TStringArray;
102	i: LongWord;
103	begin
104	Extension := MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex], 1, 4);
105	no_zero_bytes := not check_zerobyte.Checked;
106	pattern := '';
107	if check_filtername.Checked then
108	pattern := edit_filtername.Text;
109	if Extension = '_All' then
110	if Length(FAllowedExts) > 0 then
111	Extension := FAllowedExts
112	else
113	Extension := '';
114
115	files := OniDataConnection.GetFilesList(extension, pattern, no_zero_bytes);
116
117	filelist.Visible := False;
118	filelist.Items.Clear;
119	if Length(files) > 0 then
120	for i := 0 to High(files) do
121	filelist.Items.Add(files[i]);
122	filelist.Visible := True;
123	end;
124
125
126	procedure TForm_ToolTemplate.popup_exportClick(Sender: TObject);
127	var
128	id: Integer;
129	ext: String;
130	begin
131	id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
132	ext := RightStr(filelist.Items.Strings[filelist.ItemIndex], 4);
133	exportd.Filter := 'Files of matching extension (.' + ext + ')\|.' + ext + '\|All files\|.';
134	exportd.DefaultExt := ext;
135	if exportd.Execute then
136	ExportDatFile(id, exportd.FileName);
137	end;
138
139	procedure TForm_ToolTemplate.popup_importClick(Sender: TObject);
140	var
141	id: Integer;
142	finfo: TFileInfo;
143	fs: TFileStream;
144	data: TData;
145	begin
146	id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
147	finfo := OniDataConnection.GetFileInfo(id);
148
149	importd.Filter := 'Files of matching extension (.' + finfo.Extension + ')\|.' +
150	finfo.Extension + '\|All files\|.';
151	if importd.Execute then
152	begin
153	fs := TFileStream.Create(importd.FileName, fmOpenRead);
154	if fs.Size <> finfo.Size then
155	ShowMessage('Can''t import ' + ExtractFilename(importd.FileName) +
156	', file has to have same size as file in .dat.' + CrLf +
157	'Size of file in .dat: ' + FormatFileSize(finfo.Size) + CrLf +
158	'Size of chosen file: ' + FormatFileSize(fs.Size))
159	else begin
160	SetLength(data, fs.Size);
161	fs.Read(data[0], fs.Size);
162	OniDataConnection.UpdateDatFile(id, data);
163	Self.listClick(Self);
164	end;
165	fs.Free;
166	end;
167	end;
168
169	procedure TForm_ToolTemplate.popup_opentool(Sender: TObject);
170	var
171	sender_name, context: String;
172	id: Integer;
173	begin
174	sender_name := TComponent(Sender).Name;
175	id := OniDataConnection.ExtractFileID(filelist.Items.Strings[filelist.ItemIndex]);
176	context := MidStr(sender_name, Pos('_', sender_name) + 1, Length(sender_name) - Pos('_', sender_name));
177	Form_Main.open_child(context, id);
178	end;
179
180	procedure TForm_ToolTemplate.combo_extensionClick(Sender: TObject);
181	begin
182	LoadFileNames;
183	end;
184
185
186	constructor TForm_ToolTemplate.Create(AOwner: TComponent);
187	var
188	i: Integer;
189	item: TMenuItem;
190	begin
191	inherited;
192	RecreateList;
193	if Length(ToolList) > 0 then
194	begin
195	for i := 0 to High(ToolList) do
196	begin
197	item := TMenuItem.Create(filepopup);
198	item.Name := 'popup_' + ToolList[i].context;
199	item.Caption := 'Open with ' + ToolList[i].name;
200	item.OnClick := Self.popup_opentool;
201	filepopup.Items.Insert(i, item);
202	end;
203	end;
204	end;
205
206	procedure TForm_ToolTemplate.filepopupPopup(Sender: TObject);
207	var
208	ext: String;
209	i: Integer;
210	begin
211	ext := RightStr(filelist.Items.Strings[filelist.ItemIndex], 4);
212	for i := 0 to High(ToolList) do
213	begin
214	filepopup.Items.Items[i].Enabled := True;
215	if Length(ToolList[i].exts) > 0 then
216	if Pos(ext, ToolList[i].exts) = 0 then
217	filepopup.Items.Items[i].Enabled := False;
218	end;
219	end;
220
221	procedure TForm_ToolTemplate.check_zerobyteClick(Sender: TObject);
222	begin
223	LoadFileNames;
224	end;
225
226	procedure TForm_ToolTemplate.check_filternameClick(Sender: TObject);
227	begin
228	edit_filtername.Enabled := not check_filtername.Checked;
229	LoadFileNames;
230	end;
231
232	procedure TForm_ToolTemplate.listClick(Sender: TObject);
233	var
234	fileid: Integer;
235	begin
236	if filelist.ItemIndex > -1 then
237	begin
238	fileid := OniDataConnection.ExtractFileID(
239	filelist.Items.Strings[filelist.ItemIndex]);
240	if Assigned(FOnNewFileSelected) then
241	FOnNewFileSelected(OniDataConnection.GetFileInfo(fileid));
242	end;
243	end;
244
245	procedure TForm_ToolTemplate.listMouseDown(Sender: TObject; Button: TMouseButton;
246	Shift: TShiftState; X, Y: Integer);
247	var
248	pt: TPoint;
249	begin
250	pt.X := x;
251	pt.Y := y;
252	filelist.ItemIndex := filelist.ItemAtPos(pt, true);
253	Self.listClick(Self);
254	end;
255
256
257
258	procedure TForm_ToolTemplate.SelectFileID(id: Integer);
259	var
260	i: Integer;
261	begin
262	filelist.ItemIndex := -1;
263	if filelist.Items.Count > 0 then
264	for i := 0 to filelist.Items.Count - 1 do
265	if OniDataConnection.ExtractFileID(filelist.Items.Strings[i]) = id then
266	begin
267	filelist.ItemIndex := i;
268	Break;
269	end;
270	Self.listClick(Self);
271	end;
272
273	procedure TForm_ToolTemplate.SelectFileName(filename: String);
274	var
275	i: Integer;
276	begin
277	filelist.ItemIndex := -1;
278	if filelist.Items.Count > 0 then
279	for i := 0 to filelist.Items.Count - 1 do
280	if filelist.Items.Strings[i] = filename then
281	filelist.ItemIndex := i;
282	Self.listClick(Self);
283	end;
284
285	procedure TForm_ToolTemplate.SetAllowedExts(exts: String);
286	begin
287	FAllowedExts := exts;
288	RecreateList;
289	end;
290
291	procedure TForm_ToolTemplate.SetMultiSelect(allow: Boolean);
292	begin
293	FAllowMultiSelect := allow;
294	filelist.MultiSelect := allow;
295	end;
296
297
298	procedure TForm_ToolTemplate.FormResize(Sender: TObject);
299	begin
300	if Self.Width < 300 then
301	Self.Width := 300;
302	if Self.Height < 200 then
303	Self.Height := 200;
304	end;
305
306
307
308	procedure TForm_ToolTemplate.FormCreate(Sender: TObject);
309	begin
310	Self.Width := 260;
311	Self.Height := 300;
312	FOnNewFileSelected := nil;
313	FAllowedExts := '';
314	FAllowMultiSelect := False;
315	end;
316
317	procedure TForm_ToolTemplate.FormClose(Sender: TObject; var Action: TCloseAction);
318	begin
319	Action := caFree;
320	end;
321
322
323	procedure AddToolListEntryExt(context, ext: String);
324	var
325	i: Integer;
326	begin
327	for i := 0 to High(ToolList) do
328	if ToolList[i].context = context then
329	begin
330	if Pos(ext, ToolList[i].exts) = 0 then
331	begin
332	if Length(ToolList[i].exts) = 0 then
333	ToolList[i].exts := ext
334	else
335	ToolList[i].exts := ToolList[i].exts + ',' + ext;
336	end;
337	Exit;
338	end;
339	end;
340
341	procedure AddToolListEntry(context, name, exts: String);
342	var
343	i: Integer;
344	begin
345	if Length(ToolList) > 0 then
346	begin
347	for i := 0 to High(ToolList) do
348	if ToolList[i].context = context then
349	begin
350	if (Length(ToolList[i].name) = 0) and (Length(name) > 0) then
351	ToolList[i].name := name;
352	if Length(exts) > 0 then
353	AddToolListEntryExt(context, exts);
354	Exit;
355	end;
356	end;
357	SetLength(ToolList, Length(ToolList) + 1);
358	for i := High(ToolList) downto 1 do
359	if ToolList[i - 1].name > name then
360	ToolList[i] := ToolList[i - 1]
361	else
362	Break;
363	ToolList[i].context := context;
364	ToolList[i].name := name;
365	ToolList[i].exts := exts;
366	end;
367
368	end.