source: oup/current/Tools/Preview.pas@ 167

unit Preview;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Template, ExtCtrls, Math, StrUtils,
  ConnectionManager, OniImgClass, Data, TypeDefs, Menus, Buttons;

type
  TForm_Preview = class(TForm_ToolTemplate)
    lbl_notpossible: TLabel;
    panel_buttons: TPanel;
    btn_dec: TButton;
    btn_startstop: TButton;
    btn_inc: TButton;
    img: TImage;
    timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure NewFile(fileinfo: TFileInfo);

    procedure PreviewImage;
    procedure PreviewTXAN;
    procedure btn_incClick(Sender: TObject);
    procedure btn_decClick(Sender: TObject);
    procedure btn_startstopClick(Sender: TObject);
    procedure timerTimer(Sender: TObject);
    procedure panel_buttonsResize(Sender: TObject);

    procedure DrawImage(index: Integer);
    procedure SetBitmapCount(Count: Integer);
    procedure LoadImage(fileid, index: Integer);
  private
    bitmaps:   array of TBitmap;
    actualimg: Byte;
    _fileid:   Integer;
  public
  end;

var
  Form_Preview: TForm_Preview;

implementation
{$R *.dfm}


procedure TForm_Preview.FormCreate(Sender: TObject);
begin
  inherited;
  Self.OnNewFileSelected := NewFile;
end;


procedure TForm_Preview.NewFile(fileinfo: TFileInfo);
var
  ext: String;
begin
  _fileid := fileinfo.ID;
  if _fileid >= 0 then
  begin
    lbl_notpossible.Visible := False;
    Self.img.Visible := True;
    Self.timer.Enabled := False;
    Self.panel_buttons.Visible := False;
    ext     := fileinfo.Extension;
    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
  else
  begin
    Self.img.Visible := False;
    lbl_notpossible.Visible := False;
    Self.timer.Enabled := False;
    Self.panel_buttons.Visible := False;
  end;
end;


procedure TForm_Preview.LoadImage(fileid, index: Integer);
var
  memstream: TMemoryStream;
  OniImage:  TOniImage;
begin
  OniImage := TOniImage.Create;
  OniImage.Load(ConnectionID, fileid);
  memstream := TMemoryStream.Create;
  OniImage.GetAsBMP(TStream(memstream));
  OniImage.Free;
  bitmaps[index].LoadFromStream(memstream);
  memstream.Free;
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.PreviewImage;
begin
  SetBitmapCount(1);
  LoadImage(_fileid, 0);
  DrawImage(0);
end;


procedure TForm_Preview.PreviewTXAN;
var
  loop_speed: Word;
  linkcount: Integer;
  link: Integer;
  i:    Byte;
begin
  ConManager.Connection[ConnectionID].LoadDatFilePart(_fileid, $14, SizeOf(loop_speed), @loop_speed);
  ConManager.Connection[ConnectionID].LoadDatFilePart(_fileid, $1C, SizeOf(linkcount), @linkcount);
  SetBitmapCount(linkcount);
  for i := 0 to linkcount - 1 do
  begin
    ConManager.Connection[ConnectionID].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 ' + ConManager.Connection[ConnectionID].GetFileInfo(_fileid).Name +
    ' (' + 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 ' + ConManager.Connection[ConnectionID].GetFileInfo(_fileid).Name +
    ' (' + 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;


begin
  AddToolListEntry('preview', 'Preview-Window', '');
end.