gifmain.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, 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/MPL-1_1Final.html

 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.

******************************************************************}

{*******************************************************}
{                                                       }
{     Delphi VCL Extensions (RX) demo program           }
{                                                       }
{     Copyright (c) 1997 Master-Bank                    }
{                                                       }
{*******************************************************}

{$I jvcl.inc}

unit GIFMain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, JvSpeedbar, Grids,
  ComCtrls, ExtDlgs{$IFNDEF BCB}, Jpeg{$ENDIF},
  JvGIF, JvLabel, Mask, JvToolEdit, ImgList,
  JvComponent, JvFormPlacement, JvExControls, JvExExtCtrls, JvExMask;

type
  TAnimatorForm = class(TForm)
    JvSpeedbar: TJvSpeedBar;
    SpeedbarSection1: TjvSpeedbarSection;
    NewBtn: TjvSpeedItem;
    OpenBtn: TjvSpeedItem;
    SaveBtn: TjvSpeedItem;
    SaveAsBtn: TjvSpeedItem;
    InsertBtn: TjvSpeedItem;
    SpeedbarSection2: TjvSpeedbarSection;
    SpeedbarSection3: TjvSpeedbarSection;
    Storage: TJvFormStorage;
    CutBtn: TjvSpeedItem;
    CopyBtn: TjvSpeedItem;
    PasteBtn: TjvSpeedItem;
    DeleteBtn: TjvSpeedItem;
    SpeedbarSection4: TjvSpeedbarSection;
    AboutBtn: TjvSpeedItem;
    UpBtn: TjvSpeedItem;
    DownBtn: TjvSpeedItem;
    PreviewBtn: TjvSpeedItem;
    Pages: TPageControl;
    OptionsTab: TTabSheet;
    AnimationTab: TTabSheet;
    ImageTab: TTabSheet;
    Progress: TProgressBar;
    Bevel: TBevel;
    ImageScroll: TScrollBar;
    Frame1: TPanel;
    Frame2: TPanel;
    Frame3: TPanel;
    Frame4: TPanel;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox4: TPaintBox;
    No1: TLabel;
    No2: TLabel;
    No3: TLabel;
    No4: TLabel;
    Status: TLabel;
    ColorDepthCombo: TComboBox;
    Label1: TLabel;
    ThumbnailsBox: TCheckBox;
    ThumbnailsLabel: TJvLabel;
    Frame1Lbl: TLabel;
    Frame2Lbl: TLabel;
    Frame3Lbl: TLabel;
    Frame4Lbl: TLabel;
    TrailingComment: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    FrameComment: TMemo;
    Label4: TLabel;
    Label5: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    ScreenW: TLabel;
    ScreenH: TLabel;
    Label6: TLabel;
    ImageCount: TLabel;
    Bevel3: TBevel;
    BackColor: TJvComboEdit;
    Label7: TLabel;
    Label8: TLabel;
    FrameW: TLabel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    FrameH: TLabel;
    Label11: TLabel;
    ImageLeft: TEdit;
    ImageLeftBtn: TUpDown;
    Label9: TLabel;
    Label10: TLabel;
    ImageTop: TEdit;
    ImageTopBtn: TUpDown;
    Label12: TLabel;
    DelayTime: TEdit;
    DelayTimeBtn: TUpDown;
    DisposalCombo: TComboBox;
    Label13: TLabel;
    TransColor: TJvComboEdit;
    TransBox: TCheckBox;
    TransColorLabel: TJvLabel;
    Label14: TLabel;
    GIFVersion: TLabel;
    Bevel6: TBevel;
    FlatBtns: TCheckBox;
    AlwaysOnTop: TCheckBox;
    AlwaysOnTopLabel: TJvLabel;
    GrayscaleBtn: TjvSpeedItem;
    ToolbarImages: TImageList;
    RepeatCntBtn: TUpDown;
    RepeatCnt: TEdit;
    LoopBox: TCheckBox;
    LoopLbl: TJvLabel;
    RepeatForever: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PreviewBtnClick(Sender: TObject);
    procedure OpenBtnClick(Sender: TObject);
    procedure AboutBtnClick(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure ImageScrollChange(Sender: TObject);
    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure SaveAsBtnClick(Sender: TObject);
    procedure InsertBtnClick(Sender: TObject);
    procedure CutBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
    procedure PasteBtnClick(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure UpBtnClick(Sender: TObject);
    procedure DownBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ThumbnailsBoxClick(Sender: TObject);
    procedure ColorDepthComboChange(Sender: TObject);
    procedure CommentChange(Sender: TObject);
    procedure BackColorButtonClick(Sender: TObject);
    procedure TopLeftChange(Sender: TObject);
    procedure DelayTimeChange(Sender: TObject);
    procedure DisposalComboChange(Sender: TObject);
    procedure TransColorButtonClick(Sender: TObject);
    procedure TransBoxClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedBarDblClick(Sender: TObject);
    procedure FlatBtnsClick(Sender: TObject);
    procedure AlwaysOnTopClick(Sender: TObject);
    procedure CheckLabelMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GrayscaleBtnClick(Sender: TObject);
    procedure LoopChange(Sender: TObject);
  private
    { Private declarations }
    FImage: TJvGIFImage;
    FTopIndex: Integer;
    FFileName: string;
    FModified: Boolean;
    FLoading: Boolean;
    FUpdating: Boolean;
    FAborting: Boolean;
    FProgressPos: Integer;
    {$IFDEF COMPILER3_UP}
    FOpenDlg: TOpenPictureDialog;
    FSaveDlg: TSavePictureDialog;
    {$ELSE}
    FOpenDlg: TOpenDialog;
    FSaveDlg: TSaveDialog;
    {$ENDIF}
    procedure GraphicProgress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    procedure SetSelectedIndex(Index: Integer; Force: Boolean);
    procedure ImageChanged(Sender: TObject);
    procedure EnableButtons;
    procedure EnableTabs;
    procedure UpdateControls;
    procedure UpdateCaption;
    procedure SelectBackColor;
    procedure SelectTransColor;
    procedure ConfirmSave;
    procedure GrayscaleImage;
    procedure InvalidateImage(UpdateAll: Boolean);
  protected
    function GetPalette: HPALETTE; override;
  end;

var
  AnimatorForm: TAnimatorForm;

implementation

uses
  Clipbrd, JvJVCLUtils, JvJCLUtils, JvHints, GIFPrvw, GIFPal, Math;

{$R *.DFM}

const
  SReady = 'Ready';

function EnablePaste: Boolean; near;
begin
  Result := Clipboard.HasFormat(CF_GIF) or Clipboard.HasFormat(CF_BITMAP);
end;

{ TAnimatorForm }

procedure TAnimatorForm.GraphicProgress(Sender: TObject;
  Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
  const R: TRect; const Msg: string);
begin
  if Stage in [psStarting, psEnding] then
  begin
    FProgressPos := 0;
    Progress.Position := 0;
    Application.ProcessMessages;
  end
  else
  if Stage = psRunning then
  begin
    if PercentDone >= FProgressPos + 10 then
    begin
      Progress.Position := PercentDone;
      FProgressPos := PercentDone;
    end;
  end;
  if Msg <> '' then
  begin
    Status.Caption := Msg;
    Status.Update;
  end;
  if FLoading and FAborting then
  begin
    FAborting := False;
    Abort;
  end;
end;

procedure TAnimatorForm.UpdateCaption;
begin
  Caption := Application.Title;
  if (FFileName <> '') then
    Caption := Caption + ' - ' + ExtractFileName(FFileName);
end;

procedure TAnimatorForm.UpdateControls;
begin
  FUpdating := True;
  try
    ScreenW.Caption := IntToStr(FImage.ScreenWidth);
    ScreenH.Caption := IntToStr(FImage.ScreenHeight);
    ImageCount.Caption := IntToStr(FImage.Count);
    BackColor.Color := PaletteColor(FImage.BackgroundColor);
    LoopBox.Checked := FImage.Looping;
    RepeatForever.Checked := FImage.RepeatCount = 0;
    RepeatCnt.Text := IntToStr(FImage.RepeatCount);
    TrailingComment.Lines := FImage.Comment;
    case FImage.Version of
      gv87a: GIFVersion.Caption := '87a';
      gv89a: GIFVersion.Caption := '89a';
    else
      GIFVersion.Caption := '';
    end;
    if FImage.FrameIndex >= 0 then
    begin
      with FImage.Frames[FImage.FrameIndex] do
      begin
        FrameComment.Lines := Comment;
        FrameW.Caption := IntToStr(Width);
        FrameH.Caption := IntToStr(Height);
        ImageLeftBtn.Position := Origin.X;
        ImageTopBtn.Position := Origin.Y;
        DelayTimeBtn.Position :=
          FImage.Frames[FImage.FrameIndex].AnimateInterval div 10;
        DelayTime.Text := IntToStr(DelayTimeBtn.Position);
        if DisposalMethod in [dmUndefined..dmRestorePrevious] then
          DisposalCombo.ItemIndex := Ord(DisposalMethod)
        else
          DisposalCombo.ItemIndex := 0;
        TransBox.Checked := TransparentColor <> clNone;
        TransColor.Enabled := TransBox.Checked;
        TransColorLabel.Enabled := TransBox.Checked;
        TransColor.Color := PaletteColor(TransparentColor);
      end;
    end
    else
    begin
      FrameComment.Lines.Clear;
      FrameW.Caption := '';
      FrameH.Caption := '';
    end;
  finally
    FUpdating := False;
  end;
end;

function TAnimatorForm.GetPalette: HPALETTE;
begin
  Result := FImage.Palette;
  if Result = 0 then
    Result := inherited GetPalette;
end;

procedure TAnimatorForm.EnableButtons;
var
  IsSelected: Boolean;
begin
  IsSelected := not FImage.Empty and (FImage.FrameIndex >= 0);
  SaveBtn.Enabled := (FFileName <> '') and IsSelected;
  SaveAsBtn.Enabled := IsSelected;
  CutBtn.Enabled := IsSelected;
  CopyBtn.Enabled := IsSelected;
  DeleteBtn.Enabled := IsSelected;
  GrayscaleBtn.Enabled := not FImage.Empty;
  PasteBtn.Enabled := EnablePaste;
  UpBtn.Enabled := IsSelected and (FImage.FrameIndex > 0);
  DownBtn.Enabled := IsSelected and (FImage.FrameIndex < FImage.Count - 1);
  PreviewBtn.Enabled := IsSelected;
end;

procedure TAnimatorForm.GrayscaleImage;
begin
  if not FImage.Empty then
  begin
    FImage.Grayscale(True);
    FModified := True;
  end;
end;

procedure TAnimatorForm.ImageChanged(Sender: TObject);
var
  Enable: Boolean;
begin
  with ImageScroll do
  begin
    Min := 0;
    Max := Math.Max(0, FImage.Count - 1);
    Enable := (Max > Min) and not FImage.Empty;
    if not Enable then
      ActiveControl := Pages;
    Enabled := Enable;
  end;
  SetSelectedIndex(Max(0, FImage.FrameIndex), True);
  EnableTabs;
  if not FLoading then
  begin
    if Active and HandleAllocated then
      PostMessage(Handle, WM_QUERYNEWPALETTE, 0, 0);
    UpdateControls;
    EnableButtons;
  end;
end;

procedure TAnimatorForm.SetSelectedIndex(Index: Integer; Force: Boolean);
var
  I: Integer;
  Labl: TLabel;
begin
  if Force or (Index <> FImage.FrameIndex) then
  begin
    I := FTopIndex;
    Index := Min(FImage.Count - 1, Max(Index, -1));
    if (FImage.Count > 0) then
      FTopIndex := Max(FTopIndex, 0);
    while (FTopIndex < Index - 3) do
      Inc(FTopIndex);
    if Index < FTopIndex then
      FTopIndex := Index;
    FImage.FrameIndex := Index;
    if FImage.FrameIndex <> ImageScroll.Position then
      ImageScroll.Position := FImage.FrameIndex;
    InvalidateImage(I <> FTopIndex);
  end;
  for I := 1 to 4 do
  begin
    Labl := TLabel(FindComponent(Format('Frame%dLbl', [I])));
    if Labl <> nil then
      Labl.Visible := (FTopIndex + Labl.Tag < FImage.Count) and
        (FImage.Count > 0);
    Labl := TLabel(FindComponent(Format('No%d', [I])));
    if Labl <> nil then
    begin
      Labl.Caption := IntToStr(FTopIndex + Labl.Tag + 1);
      Labl.Visible := (FTopIndex + Labl.Tag < FImage.Count) and
        (FImage.Count > 0);
    end;
  end;
end;

procedure TAnimatorForm.EnableTabs;
var
  Empty: Boolean;
begin
  Empty := FImage.Empty;
  AnimationTab.Enabled := not Empty;
  AnimationTab.TabVisible := not Empty;
  ImageTab.Enabled := not Empty;
  ImageTab.TabVisible := not Empty;
  if Empty then
    Pages.ActivePage := OptionsTab;
end;

procedure TAnimatorForm.InvalidateImage(UpdateAll: Boolean);
begin
  if not FLoading then
  begin
    PaintBox1.Invalidate;
    PaintBox2.Invalidate;
    PaintBox3.Invalidate;
    PaintBox4.Invalidate;
  end;
end;

procedure TAnimatorForm.SelectBackColor;
var
  AColor, NewColor: TColor;
begin
  AColor := FImage.BackgroundColor;
  NewColor := SelectColor(FImage.Palette, AColor);
  if NewColor <> AColor then
  begin
    FImage.BackgroundColor := NewColor;
    FModified := True;
  end;
end;

procedure TAnimatorForm.SelectTransColor;
var
  Frame: TJvGIFFrame;
  AColor, NewColor: TColor;
begin
  if FImage.FrameIndex >= 0 then
  begin
    Frame := FImage.Frames[FImage.FrameIndex];
    AColor := Frame.TransparentColor;
    NewColor := SelectColor(FImage.Palette, AColor);
    if NewColor <> AColor then
    begin
      Frame.TransparentColor := NewColor;
      FModified := True;
    end;
  end
  else
    MessageBeep(MB_ICONEXCLAMATION);
end;

procedure TAnimatorForm.ConfirmSave;
var
  Res: TModalResult;
begin
  if FModified then
  begin
    Res := MessageDlg('Save changes to current animation?', mtWarning,
      [mbYes, mbNo, mbCancel], 0);
    case Res of
      mrYes: SaveBtnClick(nil);
      mrCancel: Abort;
    end;
  end;
end;

procedure TAnimatorForm.FormCreate(Sender: TObject);
begin
  { Registry settings }
  // (rom) deactivated not part of JVCL anymore
  //RegUseAppTitle := True;
  //DefCompanyName := 'RX';
  { Initialization }
  SetHintStyle(hsRectangle, 3, False, taCenter);
  UpdateCaption;
  FTopIndex := -1;
  FImage := TJvGIFImage.Create;
  EnableTabs;
  EnableButtons;
  ColorDepthCombo.ItemIndex := Ord(DefaultMappingMethod);
  {$IFDEF COMPILER3_UP}