source: oup/current/Tool_Preview.pas @ 43

Last change on this file since 43 was 43, checked in by alloc, 17 years ago

DevTree 0.33a.

File size: 8.2 KB
Line 
1unit Tool_Preview;
2
3interface
4
5uses
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
10type
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
60var
61  Form_Preview: TForm_Preview;
62
63implementation
64
65{$R *.dfm}
66
67uses Main;
68
69
70
71
72procedure TForm_Preview.Recreatelist;
73var
74  i:    LongWord;
75  exts: TStringArray;
76begin
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);
85end;
86
87
88
89
90procedure TForm_Preview.LoadFileNames;
91var
92  Extension: String[4];
93  no_zero_bytes: Boolean;
94  pattern: String;
95  files: TStringArray;
96  i: LongWord;
97begin
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]);
111end;
112
113
114
115
116procedure TForm_Preview.LoadImage(fileid, index: Integer);
117var
118  Data:      Tdata;
119  memstream: TMemoryStream;
120  OniImage:  TOniImage;
121
122begin
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;
133end;
134
135
136
137
138procedure TForm_Preview.combo_extensionClick(Sender: TObject);
139begin
140  LoadFileNames;
141end;
142
143
144
145procedure TForm_Preview.DrawImage(index: Integer);
146begin
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;
152end;
153
154
155
156
157procedure TForm_Preview.SetBitmapCount(Count: Integer);
158var
159  i: Integer;
160begin
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;
174end;
175
176
177
178
179procedure TForm_Preview.check_zerobyteClick(Sender: TObject);
180begin
181  LoadFileNames;
182end;
183
184
185
186
187procedure TForm_Preview.check_filternameClick(Sender: TObject);
188begin
189  edit_filtername.Enabled := not check_filtername.Checked;
190  LoadFileNames;
191end;
192
193
194
195
196procedure TForm_Preview.listClick(Sender: TObject);
197var
198  ext: String;
199begin
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;
215end;
216
217
218
219
220procedure TForm_Preview.listMouseDown(Sender: TObject; Button: TMouseButton;
221  Shift: TShiftState; X, Y: Integer);
222var
223  pt: TPoint;
224begin
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);
230end;
231
232procedure TForm_Preview.PreviewImage;
233begin
234  SetBitmapCount(1);
235  LoadImage(_fileid, 0);
236  DrawImage(0);
237end;
238
239
240
241
242procedure TForm_Preview.PreviewTXAN;
243var
244  loop_speed: Word;
245  linkcount: LongWord;
246  link: LongWord;
247  i:    Byte;
248begin
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;
265end;
266
267
268
269
270procedure TForm_Preview.timerTimer(Sender: TObject);
271begin
272  btn_incClick(Self);
273end;
274
275
276
277
278procedure TForm_Preview.btn_startstopClick(Sender: TObject);
279begin
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';
287end;
288
289
290
291
292procedure TForm_Preview.btn_decClick(Sender: TObject);
293begin
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);
301end;
302
303
304
305
306procedure TForm_Preview.btn_incClick(Sender: TObject);
307begin
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);
315end;
316
317
318
319
320procedure TForm_Preview.panel_buttonsResize(Sender: TObject);
321begin
322  btn_startstop.Width := panel_buttons.Width - 45;
323  btn_inc.Left := panel_buttons.Width - 23;
324end;
325
326
327
328
329procedure TForm_Preview.panel_extensionResize(Sender: TObject);
330begin
331  combo_extension.Width := panel_extension.Width - 5;
332  edit_filtername.Width := panel_extension.Width - 5;
333end;
334
335
336
337
338procedure TForm_Preview.FormResize(Sender: TObject);
339begin
340  if Self.Width < 300 then
341    Self.Width := 300;
342  if Self.Height < 200 then
343    Self.Height := 200;
344end;
345
346
347
348
349procedure TForm_Preview.FormCreate(Sender: TObject);
350begin
351  SetLength(bitmaps, 0);
352  Self.Width  := 260;
353  Self.Height := 300;
354end;
355
356
357
358
359procedure TForm_Preview.FormClose(Sender: TObject; var Action: TCloseAction);
360begin
361  Action := caFree;
362end;
363
364end.
Note: See TracBrowser for help on using the repository browser.