oup/current/Tool_Preview.pas

unit Tool_Preview;

interface

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

type
  TForm_Preview = class(TForm)
    timer:   TTimer;
    panel_preview: TPanel;
    img:     TImage;
    panel_buttons: TPanel;
    btn_dec: TButton;
    btn_startstop: TButton;
    btn_inc: TButton;
    Splitter1: TSplitter;
    lbl_notpossible: TLabel;
    panel_files: TPanel;
    list:    TListBox;
    panel_extension: TPanel;
    lbl_filter: TLabel;
    combo_extension: TComboBox;
    check_zerobyte: TCheckBox;
    edit_filtername: TEdit;
    check_filtername: TCheckBox;
    procedure LoadFileNames;
    procedure check_filternameClick(Sender: TObject);
    procedure check_zerobyteClick(Sender: TObject);
    procedure combo_extensionClick(Sender: TObject);
    procedure panel_extensionResize(Sender: TObject);
    procedure listClick(Sender: TObject);
    procedure Recreatelist;

    procedure PreviewImage;
    procedure PreviewTXAN;
    procedure btn_incClick(Sender: TObject);
    procedure btn_decClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btn_startstopClick(Sender: TObject);
    procedure panel_buttonsResize(Sender: TObject);
    procedure timerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure DrawImage(index: Integer);
    procedure SetBitmapCount(Count: Integer);
    procedure LoadImage(fileid, index: Integer);
    procedure listMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    bitmaps:   array of TBitmap;
    actualimg: Byte;
    _fileid:   LongWord;
  public
  end;

var
  Form_Preview: TForm_Preview;

implementation

{$R *.dfm}

uses Main;


procedure TForm_Preview.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
    combo_extension.Items.Add(exts[i]);
  combo_extension.ItemIndex := 0;
  combo_extensionClick(Self);
end;


procedure TForm_Preview.LoadFileNames;
var
  Extension: String[4];
  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
    Extension := '';

  files := OniDataConnection.GetFilesList(extension, pattern, no_zero_bytes);
  list.Items.Clear;
  if Length(files) > 0 then
    for i := 0 to High(files) do
      list.Items.Add(files[i]);
end;


procedure TForm_Preview.LoadImage(fileid, index: Integer);
var
  Data:      Tdata;
  memstream: TMemoryStream;
  OniImage:  TOniImage;

begin
  OniImage := TOniImage.Create;
  OniImage.Load(fileid);
  Data := OniImage.GetAsBMP;
  OniImage.Free;

  memstream := TMemoryStream.Create;
  memstream.Write(Data[0], Length(Data));
  memstream.Seek(0, soFromBeginning);
  bitmaps[index].LoadFromStream(memstream);
  memstream.Free;
end;


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


procedure TForm_Preview.DrawImage(index: Integer);
begin
  BitBlt(img.Canvas.Handle, 0, 0, img.Width, img.Height,
    bitmaps[index].Canvas.Handle, 0, 0, WHITENESS);
  BitBlt(img.Canvas.Handle, 0, 0, bitmaps[index].Width, bitmaps[index].Height,
    bitmaps[index].Canvas.Handle, 0, 0, SRCCOPY);
  img.Invalidate;
end;


procedure TForm_Preview.SetBitmapCount(Count: Integer);
var
  i: Integer;
begin
  if Length(bitmaps) > Count then
  begin
    for i := Count to High(bitmaps) do
      bitmaps[i].Free;
    SetLength(bitmaps, Count);
  end;
  if Length(bitmaps) < Count then
  begin
    i := Length(bitmaps);
    SetLength(bitmaps, Count);
    for i := i to High(bitmaps) do
      bitmaps[i] := TBitmap.Create;
  end;
end;


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


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


procedure TForm_Preview.listClick(Sender: TObject);
var
  ext: String;
begin
  _fileid := OniDataConnection.ExtractFileID(list.Items.Strings[list.ItemIndex]);
  lbl_notpossible.Visible := False;
  Self.img.Visible := True;
  Self.timer.Enabled := False;
  Self.panel_buttons.Visible := False;
  ext     := RightStr(list.Items.Strings[list.ItemIndex], 4);
  if (ext = 'PSpc') or (ext = 'TXMB') or (ext = 'TXMP') then
    PreviewImage
  else if ext = 'TXAN' then
    PreviewTXAN
  else
  begin
    Self.lbl_notpossible.Visible := True;
    Self.img.Visible := False;
  end;
end;


procedure TForm_Preview.listMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
begin
  pt.X := x;
  pt.Y := y;
  list.ItemIndex := list.ItemAtPos(pt, true);
  if list.ItemIndex > -1 then
    Self.listClick(Self);
end;

procedure TForm_Preview.PreviewImage;
begin
  SetBitmapCount(1);
  LoadImage(_fileid, 0);
  DrawImage(0);
end;


procedure TForm_Preview.PreviewTXAN;
var
  loop_speed: Word;
  linkcount: LongWord;
  link: LongWord;
  i:    Byte;
begin
  OniDataConnection.LoadDatFilePart(_fileid, $14, SizeOf(loop_speed), @loop_speed);
  OniDataConnection.LoadDatFilePart(_fileid, $1C, SizeOf(linkcount), @linkcount);
  SetBitmapCount(linkcount);
  for i := 0 to linkcount - 1 do
  begin
    OniDataConnection.LoadDatFilePart(_fileid, $20 + i * 4, SizeOf(link), @link);
    link := link div 256;
    if link = 0 then
      link := _fileid - 1;
    LoadImage(link, i);
  end;
  actualimg := 254;
  Self.timer.Interval := Floor(loop_speed * (1 / 60) * 1000);
  Self.timer.Enabled := False;
  Self.btn_startstopClick(Self);
  Self.panel_buttons.Visible := True;
end;


procedure TForm_Preview.timerTimer(Sender: TObject);
begin
  btn_incClick(Self);
end;


procedure TForm_Preview.btn_startstopClick(Sender: TObject);
begin
  Self.timer.Enabled   := not Self.timer.Enabled;
  Self.btn_dec.Enabled := not Self.timer.Enabled;
  Self.btn_inc.Enabled := not Self.timer.Enabled;
  if Self.timer.Enabled then
    Self.btn_startstop.Caption := 'Stop automatic'
  else
    Self.btn_startstop.Caption := 'Start automatic';
end;


procedure TForm_Preview.btn_decClick(Sender: TObject);
begin
  if actualimg > 0 then
    Dec(actualimg)
  else
    actualimg := High(bitmaps);
  Self.Caption := 'Preview ' + OniDataConnection.GetFileInfo(_fileid).FileName +
    ' (' + IntToStr(actualimg + 1) + '/' + IntToStr(Length(bitmaps)) + ')';
  DrawImage(actualimg);
end;


procedure TForm_Preview.btn_incClick(Sender: TObject);
begin
  if actualimg < High(bitmaps) then
    Inc(actualimg)
  else
    actualimg := 0;
  Self.Caption := 'Preview ' + OniDataConnection.GetFileInfo(_fileid).FileName +
    ' (' + IntToStr(actualimg + 1) + '/' + IntToStr(Length(bitmaps)) + ')';
  DrawImage(actualimg);
end;


procedure TForm_Preview.panel_buttonsResize(Sender: TObject);
begin
  btn_startstop.Width := panel_buttons.Width - 45;
  btn_inc.Left := panel_buttons.Width - 23;
end;


procedure TForm_Preview.panel_extensionResize(Sender: TObject);
begin
  combo_extension.Width := panel_extension.Width - 5;
  edit_filtername.Width := panel_extension.Width - 5;
end;


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


procedure TForm_Preview.FormCreate(Sender: TObject);
begin
  SetLength(bitmaps, 0);
  Self.Width  := 260;
  Self.Height := 300;
end;


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

end.
Revision:	43
Committed:	Mon Dec 18 23:35:30 2006 UTC (18 years, 9 months ago) by alloc
Content type:	text/x-pascal
File size:	8438 byte(s)
Log Message:	DevTree 0.33a.
#	Content
1	unit Tool_Preview;
2
3	interface
4
5	uses
6	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7	Dialogs, Math, ExtCtrls, StdCtrls, StrUtils, Menus,
8	Code_Functions, Data, Code_Exporters, Code_OniImgClass, Code_OniDataClass;
9
10	type
11	TForm_Preview = class(TForm)
12	timer: TTimer;
13	panel_preview: TPanel;
14	img: TImage;
15	panel_buttons: TPanel;
16	btn_dec: TButton;
17	btn_startstop: TButton;
18	btn_inc: TButton;
19	Splitter1: TSplitter;
20	lbl_notpossible: TLabel;
21	panel_files: TPanel;
22	list: TListBox;
23	panel_extension: TPanel;
24	lbl_filter: TLabel;
25	combo_extension: TComboBox;
26	check_zerobyte: TCheckBox;
27	edit_filtername: TEdit;
28	check_filtername: TCheckBox;
29	procedure LoadFileNames;
30	procedure check_filternameClick(Sender: TObject);
31	procedure check_zerobyteClick(Sender: TObject);
32	procedure combo_extensionClick(Sender: TObject);
33	procedure panel_extensionResize(Sender: TObject);
34	procedure listClick(Sender: TObject);
35	procedure Recreatelist;
36
37	procedure PreviewImage;
38	procedure PreviewTXAN;
39	procedure btn_incClick(Sender: TObject);
40	procedure btn_decClick(Sender: TObject);
41	procedure FormResize(Sender: TObject);
42	procedure btn_startstopClick(Sender: TObject);
43	procedure panel_buttonsResize(Sender: TObject);
44	procedure timerTimer(Sender: TObject);
45	procedure FormCreate(Sender: TObject);
46	procedure FormClose(Sender: TObject; var Action: TCloseAction);
47
48	procedure DrawImage(index: Integer);
49	procedure SetBitmapCount(Count: Integer);
50	procedure LoadImage(fileid, index: Integer);
51	procedure listMouseDown(Sender: TObject; Button: TMouseButton;
52	Shift: TShiftState; X, Y: Integer);
53	private
54	bitmaps: array of TBitmap;
55	actualimg: Byte;
56	_fileid: LongWord;
57	public
58	end;
59
60	var
61	Form_Preview: TForm_Preview;
62
63	implementation
64
65	{$R *.dfm}
66
67	uses Main;
68
69
70
71
72	procedure TForm_Preview.Recreatelist;
73	var
74	i: LongWord;
75	exts: TStringArray;
76	begin
77	combo_extension.Items.Clear;
78	combo_extension.Items.Add('_All files_ (' +
79	IntToStr(OniDataConnection.GetFilesCount) + ')');
80	exts := OniDataConnection.GetExtensionsList;
81	for i := 0 to High(exts) do
82	combo_extension.Items.Add(exts[i]);
83	combo_extension.ItemIndex := 0;
84	combo_extensionClick(Self);
85	end;
86
87
88
89
90	procedure TForm_Preview.LoadFileNames;
91	var
92	Extension: String[4];
93	no_zero_bytes: Boolean;
94	pattern: String;
95	files: TStringArray;
96	i: LongWord;
97	begin
98	Extension := MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex], 1, 4);
99	no_zero_bytes := not check_zerobyte.Checked;
100	pattern := '';
101	if check_filtername.Checked then
102	pattern := edit_filtername.Text;
103	if Extension = '_All' then
104	Extension := '';
105
106	files := OniDataConnection.GetFilesList(extension, pattern, no_zero_bytes);
107	list.Items.Clear;
108	if Length(files) > 0 then
109	for i := 0 to High(files) do
110	list.Items.Add(files[i]);
111	end;
112
113
114
115
116	procedure TForm_Preview.LoadImage(fileid, index: Integer);
117	var
118	Data: Tdata;
119	memstream: TMemoryStream;
120	OniImage: TOniImage;
121
122	begin
123	OniImage := TOniImage.Create;
124	OniImage.Load(fileid);
125	Data := OniImage.GetAsBMP;
126	OniImage.Free;
127
128	memstream := TMemoryStream.Create;
129	memstream.Write(Data[0], Length(Data));
130	memstream.Seek(0, soFromBeginning);
131	bitmaps[index].LoadFromStream(memstream);
132	memstream.Free;
133	end;
134
135
136
137
138	procedure TForm_Preview.combo_extensionClick(Sender: TObject);
139	begin
140	LoadFileNames;
141	end;
142
143
144
145	procedure TForm_Preview.DrawImage(index: Integer);
146	begin
147	BitBlt(img.Canvas.Handle, 0, 0, img.Width, img.Height,
148	bitmaps[index].Canvas.Handle, 0, 0, WHITENESS);
149	BitBlt(img.Canvas.Handle, 0, 0, bitmaps[index].Width, bitmaps[index].Height,
150	bitmaps[index].Canvas.Handle, 0, 0, SRCCOPY);
151	img.Invalidate;
152	end;
153
154
155
156
157	procedure TForm_Preview.SetBitmapCount(Count: Integer);
158	var
159	i: Integer;
160	begin
161	if Length(bitmaps) > Count then
162	begin
163	for i := Count to High(bitmaps) do
164	bitmaps[i].Free;
165	SetLength(bitmaps, Count);
166	end;
167	if Length(bitmaps) < Count then
168	begin
169	i := Length(bitmaps);
170	SetLength(bitmaps, Count);
171	for i := i to High(bitmaps) do
172	bitmaps[i] := TBitmap.Create;
173	end;
174	end;
175
176
177
178
179	procedure TForm_Preview.check_zerobyteClick(Sender: TObject);
180	begin
181	LoadFileNames;
182	end;
183
184
185
186
187	procedure TForm_Preview.check_filternameClick(Sender: TObject);
188	begin
189	edit_filtername.Enabled := not check_filtername.Checked;
190	LoadFileNames;
191	end;
192
193
194
195
196	procedure TForm_Preview.listClick(Sender: TObject);
197	var
198	ext: String;
199	begin
200	_fileid := OniDataConnection.ExtractFileID(list.Items.Strings[list.ItemIndex]);
201	lbl_notpossible.Visible := False;
202	Self.img.Visible := True;
203	Self.timer.Enabled := False;
204	Self.panel_buttons.Visible := False;
205	ext := RightStr(list.Items.Strings[list.ItemIndex], 4);
206	if (ext = 'PSpc') or (ext = 'TXMB') or (ext = 'TXMP') then
207	PreviewImage
208	else if ext = 'TXAN' then
209	PreviewTXAN
210	else
211	begin
212	Self.lbl_notpossible.Visible := True;
213	Self.img.Visible := False;
214	end;
215	end;
216
217
218
219
220	procedure TForm_Preview.listMouseDown(Sender: TObject; Button: TMouseButton;
221	Shift: TShiftState; X, Y: Integer);
222	var
223	pt: TPoint;
224	begin
225	pt.X := x;
226	pt.Y := y;
227	list.ItemIndex := list.ItemAtPos(pt, true);
228	if list.ItemIndex > -1 then
229	Self.listClick(Self);
230	end;
231
232	procedure TForm_Preview.PreviewImage;
233	begin
234	SetBitmapCount(1);
235	LoadImage(_fileid, 0);
236	DrawImage(0);
237	end;
238
239
240
241
242	procedure TForm_Preview.PreviewTXAN;
243	var
244	loop_speed: Word;
245	linkcount: LongWord;
246	link: LongWord;
247	i: Byte;
248	begin
249	OniDataConnection.LoadDatFilePart(_fileid, $14, SizeOf(loop_speed), @loop_speed);
250	OniDataConnection.LoadDatFilePart(_fileid, $1C, SizeOf(linkcount), @linkcount);
251	SetBitmapCount(linkcount);
252	for i := 0 to linkcount - 1 do
253	begin
254	OniDataConnection.LoadDatFilePart(_fileid, $20 + i * 4, SizeOf(link), @link);
255	link := link div 256;
256	if link = 0 then
257	link := _fileid - 1;
258	LoadImage(link, i);
259	end;
260	actualimg := 254;
261	Self.timer.Interval := Floor(loop_speed * (1 / 60) * 1000);
262	Self.timer.Enabled := False;
263	Self.btn_startstopClick(Self);
264	Self.panel_buttons.Visible := True;
265	end;
266
267
268
269
270	procedure TForm_Preview.timerTimer(Sender: TObject);
271	begin
272	btn_incClick(Self);
273	end;
274
275
276
277
278	procedure TForm_Preview.btn_startstopClick(Sender: TObject);
279	begin
280	Self.timer.Enabled := not Self.timer.Enabled;
281	Self.btn_dec.Enabled := not Self.timer.Enabled;
282	Self.btn_inc.Enabled := not Self.timer.Enabled;
283	if Self.timer.Enabled then
284	Self.btn_startstop.Caption := 'Stop automatic'
285	else
286	Self.btn_startstop.Caption := 'Start automatic';
287	end;
288
289
290
291
292	procedure TForm_Preview.btn_decClick(Sender: TObject);
293	begin
294	if actualimg > 0 then
295	Dec(actualimg)
296	else
297	actualimg := High(bitmaps);
298	Self.Caption := 'Preview ' + OniDataConnection.GetFileInfo(_fileid).FileName +
299	' (' + IntToStr(actualimg + 1) + '/' + IntToStr(Length(bitmaps)) + ')';
300	DrawImage(actualimg);
301	end;
302
303
304
305
306	procedure TForm_Preview.btn_incClick(Sender: TObject);
307	begin
308	if actualimg < High(bitmaps) then
309	Inc(actualimg)
310	else
311	actualimg := 0;
312	Self.Caption := 'Preview ' + OniDataConnection.GetFileInfo(_fileid).FileName +
313	' (' + IntToStr(actualimg + 1) + '/' + IntToStr(Length(bitmaps)) + ')';
314	DrawImage(actualimg);
315	end;
316
317
318
319
320	procedure TForm_Preview.panel_buttonsResize(Sender: TObject);
321	begin
322	btn_startstop.Width := panel_buttons.Width - 45;
323	btn_inc.Left := panel_buttons.Width - 23;
324	end;
325
326
327
328
329	procedure TForm_Preview.panel_extensionResize(Sender: TObject);
330	begin
331	combo_extension.Width := panel_extension.Width - 5;
332	edit_filtername.Width := panel_extension.Width - 5;
333	end;
334
335
336
337
338	procedure TForm_Preview.FormResize(Sender: TObject);
339	begin
340	if Self.Width < 300 then
341	Self.Width := 300;
342	if Self.Height < 200 then
343	Self.Height := 200;
344	end;
345
346
347
348
349	procedure TForm_Preview.FormCreate(Sender: TObject);
350	begin
351	SetLength(bitmaps, 0);
352	Self.Width := 260;
353	Self.Height := 300;
354	end;
355
356
357
358
359	procedure TForm_Preview.FormClose(Sender: TObject; var Action: TCloseAction);
360	begin
361	Action := caFree;
362	end;
363
364	end.