gifmain.pas

jvcl driver development envionment

  FOpenDlg := TOpenPictureDialog.Create(Self);
  FSaveDlg := TSavePictureDialog.Create(Self);
  {$ELSE}
  FOpenDlg := TOpenDialog.Create(Self);
  FSaveDlg := TSaveDialog.Create(Self);
  {$ENDIF}
  with FOpenDlg do
  begin
    Name := 'OpenDialog';
    Options := [ofHideReadOnly, ofFileMustExist];
    DefaultExt := GraphicExtension(TJvGIFImage);
    Filter := GraphicFilter(TGraphic);
    InitialDir := ExtractFileDir(Application.ExeName) + '\data';
  end;
  with FSaveDlg do
  begin
    Name := 'SaveDialog';
    Options := [ofHideReadOnly, ofOverwritePrompt];
    DefaultExt := GraphicExtension(TJvGIFImage);
    Filter := GraphicFilter(TJvGIFImage);
  end;
  { Add dialogs to storage }
//!!!  with Storage.StoredProps do begin
//!!!    AddObject(CreateStoredItem(FOpenDlg.Name, 'InitialDir'), FOpenDlg);
//!!!    AddObject(CreateStoredItem(FSaveDlg.Name, 'InitialDir'), FSaveDlg);
//!!!  end;
  Application.OnActivate := FormActivate;
  FImage.OnProgress := GraphicProgress;
  FImage.OnChange := ImageChanged;
  Status.Caption := SReady;
  FModified := False;
end;

procedure TAnimatorForm.FormDestroy(Sender: TObject);
begin
  FImage.Free;
end;

procedure TAnimatorForm.FormActivate(Sender: TObject);
begin
  PasteBtn.Enabled := EnablePaste;
end;

procedure TAnimatorForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  ConfirmSave;
end;

procedure TAnimatorForm.PreviewBtnClick(Sender: TObject);
begin
  PreviewGIF(FImage);
end;

procedure TAnimatorForm.OpenBtnClick(Sender: TObject);
begin
  ConfirmSave;
  FOpenDlg.Filter := GraphicFilter(TJvGIFImage);
  try
    if FOpenDlg.Execute then
    begin
      StartWait;
      FLoading := True;
      try
        FOpenDlg.InitialDir := ExtractFilePath(FOpenDlg.FileName);
        Status.Caption := 'Press <Esc> to cancel';
        Application.ProcessMessages;
        try
          FImage.LoadFromFile(FOpenDlg.FileName);
          FImage.DecodeAllFrames;
          FModified := False;
        except
          FImage.Clear;
          FFileName := '';
          raise;
        end;
        FFileName := FOpenDlg.FileName;
        UpdateControls;
      finally
        FLoading := False;
        FAborting := False;
        FModified := False;
        StopWait;
        Status.Caption := SReady;
        InvalidateImage(True);
        UpdateCaption;
        EnableButtons;
      end;
    end;
  finally
    FOpenDlg.Filter := GraphicFilter(TGraphic);
  end;
end;

procedure TAnimatorForm.PaintBoxPaint(Sender: TObject);
var
  ImageIndex, Size: Integer;
  W, H, L, T: Integer;
  DrawRect: TRect;
  Frame: TJvGIFFrame;
begin
  ImageIndex := FTopIndex + TPaintBox(Sender).Tag;
  if (ImageIndex >= 0) and (ImageIndex < FImage.Count) then
  begin
    DrawRect := TPaintBox(Sender).ClientRect;
    Frame := FImage.Frames[ImageIndex];
    with TPaintBox(Sender).Canvas do
    begin
      if ImageIndex = FImage.FrameIndex then
      begin
        Pen.Color := clActiveCaption;
        Pen.Width := 3;
        with DrawRect do
          Rectangle(Left, Top, Right, Bottom);
      end;
      InflateRect(DrawRect, -3, -3);
      if ThumbnailsBox.Checked then
      begin
        W := FImage.ScreenWidth;
        H := FImage.ScreenHeight;
        L := Frame.Origin.X;
        T := Frame.Origin.Y;
      end
      else
      begin
        W := Frame.Width;
        H := Frame.Height;
        L := 0;
        T := 0;
      end;

      if (W <= RectWidth(DrawRect)) and
        (H <= RectHeight(DrawRect)) then
      begin
        DrawRect := Bounds(L, T, Frame.Width, Frame.Height);
      end
      else
      begin
        Size := DrawRect.Top + MulDiv(H, RectWidth(DrawRect), W);
        if Size > DrawRect.Bottom then
        begin
          L := MulDiv(L, RectHeight(DrawRect), H);
          T := MulDiv(T, RectHeight(DrawRect), H);
          W := MulDiv(Frame.Width, RectHeight(DrawRect), H);
          H := MulDiv(Frame.Height, RectHeight(DrawRect), H);
          DrawRect := Bounds(L, T, W, H);
        end
        else
        begin
          L := MulDiv(L, RectWidth(DrawRect), W);
          T := MulDiv(T, RectWidth(DrawRect), W);
          H := MulDiv(Frame.Height, RectWidth(DrawRect), W);
          W := MulDiv(Frame.Width, RectWidth(DrawRect), W);
          DrawRect := Bounds(L, T, W, H);
        end;
      end;
      OffsetRect(DrawRect, 3, 3);
      Frame.Draw(TPaintBox(Sender).Canvas, DrawRect, False);
    end;
  end;
end;

procedure TAnimatorForm.ImageScrollChange(Sender: TObject);
begin
  SetSelectedIndex(ImageScroll.Position, False);
end;

procedure TAnimatorForm.PaintBoxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ImageIndex: Integer;
begin
  if (FImage.Count > 0) then
  begin
    if ImageScroll.Enabled then
      ActiveControl := ImageScroll;
    ImageIndex := FTopIndex + TPaintBox(Sender).Tag;
    if (ImageIndex >= 0) and (ImageIndex < FImage.Count) then
      SetSelectedIndex(ImageIndex, True);
  end;
end;

procedure TAnimatorForm.NewBtnClick(Sender: TObject);
begin
  ConfirmSave;
  if not FImage.Empty then
    FImage.Clear;
  FFileName := '';
  UpdateCaption;
  Status.Caption := SReady;
  FModified := False;
end;

procedure TAnimatorForm.SaveBtnClick(Sender: TObject);
begin
  if FFileName = '' then
    SaveAsBtnClick(Sender)
  else
  begin
    StartWait;
    try
      FImage.SaveToFile(FFileName);
      FModified := False;
    finally
      StopWait;
      Status.Caption := SReady;
    end;
  end;
end;

procedure TAnimatorForm.SaveAsBtnClick(Sender: TObject);
begin
  if FFileName <> '' then
  begin
    FSaveDlg.FileName := FFileName;
    FSaveDlg.InitialDir := ExtractFilePath(FSaveDlg.FileName);
  end;
  if not FImage.Empty and FSaveDlg.Execute then
  begin
    Application.ProcessMessages;
    StartWait;
    try
      FSaveDlg.InitialDir := ExtractFilePath(FSaveDlg.FileName);
      FImage.SaveToFile(FSaveDlg.FileName);
      FModified := False;
      FFileName := FSaveDlg.FileName;
      UpdateCaption;
    finally
      StopWait;
      Status.Caption := SReady;
    end;
  end;
end;

procedure TAnimatorForm.InsertBtnClick(Sender: TObject);
var
  Pic: TPicture;
begin
  if FOpenDlg.Execute then
  begin
    Application.ProcessMessages;
    StartWait;
    Pic := TPicture.Create;
    try
      FOpenDlg.InitialDir := ExtractFilePath(FOpenDlg.FileName);
      {$IFDEF COMPILER3_UP}
      Pic.OnProgress := GraphicProgress;
      {$ENDIF}
      Pic.LoadFromFile(FOpenDlg.FileName);
      if (Pic.Graphic <> nil) and not Pic.Graphic.Empty then
      begin
        FImage.AddFrame(Pic.Graphic);
        FModified := True;
        ImageChanged(FImage);
        StartWait;
        try
          FImage.EncodeAllFrames;
        finally
          StopWait;
        end;
      end;
    finally
      Pic.Free;
      StopWait;
      Status.Caption := SReady;
    end;
  end;
end;

procedure TAnimatorForm.PasteBtnClick(Sender: TObject);
var
  Temp: TPicture;
begin
  if not EnablePaste then
    Exit;
  Temp := TPicture.Create;
  try
    Temp.Assign(Clipboard);
    if (Temp.Graphic <> nil) and not Temp.Graphic.Empty then
    begin
      FImage.AddFrame(Temp.Graphic);
      FModified := True;
      ImageChanged(FImage);
      StartWait;
      try
        FImage.EncodeAllFrames;
      finally
        StopWait;
      end;
    end;
  finally
    Temp.Free;
    Status.Caption := SReady;
  end;
end;

procedure TAnimatorForm.CutBtnClick(Sender: TObject);
begin
  CopyBtnClick(Sender);
  DeleteBtnClick(Sender);
end;

procedure TAnimatorForm.CopyBtnClick(Sender: TObject);
var
  Temp: TJvGIFImage;
begin
  if not FImage.Empty and (FImage.FrameIndex >= 0) then
  begin
    Temp := TJvGIFImage.Create;
    try
      Temp.Assign(FImage.Frames[FImage.FrameIndex]);
      Clipboard.Assign(Temp);
      PasteBtn.Enabled := EnablePaste;
    finally
      Temp.Free;
    end;
  end;
end;

procedure TAnimatorForm.DeleteBtnClick(Sender: TObject);
begin
  if FImage.FrameIndex >= 0 then
  begin
    FImage.DeleteFrame(FImage.FrameIndex);
    FModified := True;
  end;
end;

procedure TAnimatorForm.UpBtnClick(Sender: TObject);
begin
  if FImage.FrameIndex > 0 then
  begin
    FImage.MoveFrame(FImage.FrameIndex, FImage.FrameIndex - 1);
    FModified := True;
  end;
end;

procedure TAnimatorForm.DownBtnClick(Sender: TObject);
begin
  if (FImage.FrameIndex >= 0) and (FImage.FrameIndex < FImage.Count - 1) then
  begin
    FImage.MoveFrame(FImage.FrameIndex, FImage.FrameIndex + 1);
    FModified := True;
  end;
end;

procedure TAnimatorForm.AboutBtnClick(Sender: TObject);
begin
 MessageDlg(
   'RX GIF Image Format Support'+#13+#10+
   'RX Library Demo Program'+#13+#10+'1, 1, 1998', mtInformation, [mbOK], 0);
end;

procedure TAnimatorForm.ThumbnailsBoxClick(Sender: TObject);
begin
  InvalidateImage(True);
end;

procedure TAnimatorForm.ColorDepthComboChange(Sender: TObject);
begin
  DefaultMappingMethod := TMappingMethod(ColorDepthCombo.ItemIndex);
end;

procedure TAnimatorForm.BackColorButtonClick(Sender: TObject);
begin
  SelectBackColor;
end;

procedure TAnimatorForm.TransColorButtonClick(Sender: TObject);
begin
  SelectTransColor;
end;

procedure TAnimatorForm.LoopChange(Sender: TObject);
begin
  RepeatForever.Enabled := LoopBox.Checked;
  LoopLbl.Enabled := RepeatForever.Enabled and not RepeatForever.Checked;
  RepeatCnt.Enabled := LoopLbl.Enabled;
  RepeatCntBtn.Enabled := LoopLbl.Enabled;
  if not (FLoading or FUpdating) then
  begin
    if RepeatForever.Checked then
      FImage.RepeatCount := 0
    else
      FImage.RepeatCount := StrToIntDef(RepeatCnt.Text, FImage.RepeatCount);
    FImage.Looping := LoopBox.Checked;
    FModified := True;
  end;
end;

procedure TAnimatorForm.CommentChange(Sender: TObject);
begin
  if not (FLoading or FUpdating) then
  begin
    if (Sender = FrameComment) and (FImage.FrameIndex >= 0) then
      FImage.Frames[FImage.FrameIndex].Comment := FrameComment.Lines
    else
    if Sender = TrailingComment then
      FImage.Comment := TrailingComment.Lines;
    FModified := True;
  end;
end;

procedure TAnimatorForm.TopLeftChange(Sender: TObject);
begin
  if not (FLoading or FUpdating) and (FImage.FrameIndex >= 0) then
  begin
    FImage.Frames[FImage.FrameIndex].Origin := Point(
      StrToIntDef(ImageLeft.Text, ImageLeftBtn.Position),
      StrToIntDef(ImageTop.Text, ImageTopBtn.Position));
    FModified := True;
  end;
end;

procedure TAnimatorForm.DelayTimeChange(Sender: TObject);
begin
  if not (FLoading or FUpdating) and (FImage.FrameIndex >= 0) then
  begin
    FImage.Frames[FImage.FrameIndex].AnimateInterval :=
      StrToIntDef(DelayTime.Text, DelayTimeBtn.Position) * 10;
    FModified := True;
  end;
end;

procedure TAnimatorForm.DisposalComboChange(Sender: TObject);
begin
  if not (FLoading or FUpdating) and (FImage.FrameIndex >= 0) then
  begin
    if DisposalCombo.ItemIndex >= 0 then
    begin
      FImage.Frames[FImage.FrameIndex].DisposalMethod :=
        TDisposalMethod(DisposalCombo.ItemIndex);
      FModified := True;
    end;
  end;
end;

procedure TAnimatorForm.TransBoxClick(Sender: TObject);
begin
  TransColor.Enabled := TransBox.Checked;
  TransColorLabel.Enabled := TransBox.Checked;
  if not (FLoading or FUpdating) and (FImage.FrameIndex >= 0) then
  begin
    if not TransBox.Checked then
    begin
      FImage.Frames[FImage.FrameIndex].TransparentColor := clNone;
      FModified := True;
    end;
  end;
end;

procedure TAnimatorForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #27) and FLoading then
  begin
    FAborting := True;
    Key := #0;
  end;
end;

procedure TAnimatorForm.SpeedBarDblClick(Sender: TObject);
begin
  JvSpeedbar.Customize(0);
end;

procedure TAnimatorForm.FlatBtnsClick(Sender: TObject);
begin
  if TCheckBox(Sender).Checked then
    JvSpeedbar.Options := JvSpeedbar.Options + [sbFlatBtns]
  else
    JvSpeedbar.Options := JvSpeedbar.Options - [sbFlatBtns];
end;

procedure TAnimatorForm.AlwaysOnTopClick(Sender: TObject);
begin
  if AlwaysOnTop.Checked then
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE)
  else
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE);
end;

procedure TAnimatorForm.CheckLabelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and not (ssDouble in Shift) then
  begin
    if TJvLabel(Sender).FocusControl.CanFocus then
      ActiveControl := TJvLabel(Sender).FocusControl;
    if (TJvLabel(Sender).FocusControl is TCheckBox) then
      with TCheckBox(TJvLabel(Sender).FocusControl) do
        if Enabled then
          Checked := not Checked;
  end;
end;

procedure TAnimatorForm.GrayscaleBtnClick(Sender: TObject);
begin
  GrayscaleImage;
end;

end.