|
From: Peter T. <pe...@us...> - 2003-08-24 00:57:52
|
Update of /cvsroot/jvcl/dev/JVCL3/examples/JvGIFAnimator
In directory sc8-pr-cvs1:/tmp/cvs-serv4702/JVCL3/examples/JvGIFAnimator
Added Files:
About.pas GIFANIM.ICO GIFMAIN.PAS GIFMAIN.dfm GIFPAL.DFM
GIFPAL.PAS Gifprvw.dfm Gifprvw.pas RXGIFANM.RES RxGIFAnm.dof
RxGIFAnm.dpr TBIMG.BMP
Log Message:
- Copied jvcl/devtools and jvcl/examples dev/JVCL3
- Copied JVCLConvert *.dat files to dev/JVCL3/converter
--- NEW FILE: About.pas ---
unit About;
{$I JVCL.INC}
interface
uses Classes, Graphics, Controls;
procedure ShowAbout(const Developer, Company: string;
HiVer, LoVer, Year: Integer);
procedure ShowAboutDialog(const AppTitle, Developer, Company: string;
AppIcon: TIcon; HiVer, LoVer, Year: Integer);
procedure VerAboutBox;
implementation
uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
SysUtils, Messages, Consts, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons,
JvVCLUtils, JvVerInf, JvConst, JvDateUtil;
{$IFDEF COMPILER3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
sYear = '%s © %d';
sFreeMemory = '%s KB';
sAbout = 'About';
{$IFDEF WIN32}
sFreeMemoryLabel = 'Physical memory:';
sFreeResourcesLabel = 'Memory in use:';
{$ELSE}
sFreeMemoryLabel = 'Free memory:';
sFreeResourcesLabel = 'Free system resources:';
{$ENDIF WIN32}
sVersion = 'Version %d.%.2d';
sFileVer = 'Version %s';
sExeFile = 'Executable file %s';
{ TAboutDialog }
type
TAboutDialog = class(TForm)
FProgramIcon: TImage;
FProductName: TLabel;
FProductVersion: TLabel;
FCopyright: TLabel;
FYearLabel: TLabel;
FMemSize: TLabel;
FPercent: TLabel;
private
procedure UpdateMemoryInfo;
function GetWindowsVersion: string;
procedure SetVersion(LoVer, HiVer: Integer);
procedure SetCopyright(const Developer, Company: string; Year: Integer);
procedure SetAppData(const AppTitle: string; AIcon: TIcon);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
{ Utility routines }
function MakeAboutDialog: TForm;
begin
Result := TAboutDialog.Create(Application);
with Result do
{ scale to screen res }
if Screen.PixelsPerInch <> 96 then begin
ScaleBy(Screen.PixelsPerInch, 96);
{ The ScaleBy method does not scale the font well, so set the
font back to the original info. }
Font.Name := 'MS Sans Serif';
Font.Size := 8;
Font.Style := [];
Font.Color := clWindowText;
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
end;
end;
procedure VerAboutBox;
const
DefVersion = '0.09';
SCopyright = 'Copyright © %d';
var
JvVerInf: TJvVersionInfo ;
begin
JvVerInf := TJvVersionInfo .Create(Application.ExeName);
try
with TAboutDialog(MakeAboutDialog) do
try
if JvVerInf.Valid then begin
FYearLabel.Caption := JvVerInf.LegalCopyright;
if FYearLabel.Caption = '' then
FYearLabel.Caption := Format(SCopyright,
[ExtractYear(JvVerInf.VerFileDate)]);
FProductVersion.Caption := Format(sFileVer, [JvVerInf.FileVersion]);
end
else begin
FYearLabel.Caption := Format(SCopyright,
[ExtractYear(JvVerInf.VerFileDate)]);
FProductVersion.Caption := Format(sFileVer, [DefVersion]);
end;
FCopyright.Caption := Format(sExeFile,
[FormatDateTime('c', JvVerInf.VerFileDate)]);
SetAppData(Application.Title, Application.Icon);
ShowModal;
finally
Free;
end;
finally
JvVerInf.Free;
end
end;
procedure ShowAboutDialog(const AppTitle, Developer, Company: string;
AppIcon: TIcon; HiVer, LoVer, Year: Integer);
begin
with TAboutDialog(MakeAboutDialog) do
try
SetVersion(LoVer, HiVer);
SetCopyright(Developer, Company, Year);
SetAppData(AppTitle, AppIcon);
ShowModal;
finally
Free;
end;
end;
procedure ShowAbout(const Developer, Company: string;
HiVer, LoVer, Year: Integer);
begin
ShowAboutDialog(Application.Title, Developer, Company, Application.Icon,
HiVer, LoVer, Year);
end;
{ TAboutDialog }
constructor TAboutDialog.Create(AOwner: TComponent);
begin
{$IFDEF CBUILDER}
inherited CreateNew(AOwner, 0);
{$ELSE}
inherited CreateNew(AOwner);
{$ENDIF}
BorderStyle := bsDialog;
Position := poScreenCenter;
ClientHeight := 143;
ClientWidth := 339;
Caption := sAbout;
with Font do begin
{$IFNDEF WIN32}
Color := clWindowText;
Size := 8;
Name := 'MS Sans Serif';
{$ENDIF}
Style := [];
end;
FProgramIcon := TImage.Create(Self);
with FProgramIcon do begin
Parent := Self;
Left := 12;
Top := 8;
Width := 32;
Height := 32;
AutoSize := True;
end;
FProductName := TLabel.Create(Self);
with FProductName do begin
Parent := Self;
Left := 60;
Top := 6;
Width := 205;
Height := 13;
ParentFont := True;
ShowAccelChar := False;
end;
FProductVersion := TLabel.Create(Self);
with FProductVersion do begin
Parent := Self;
Left := 60;
Top := 23;
Width := 205;
Height := 13;
ParentFont := True;
Caption := sVersion;
end;
FCopyright := TLabel.Create(Self);
with FCopyright do begin
Parent := Self;
Left := 60;
Top := 57;
Width := 273;
Height := 13;
ParentFont := True;
end;
FYearLabel := TLabel.Create(Self);
with FYearLabel do begin
Parent := Self;
Left := 60;
Top := 40;
Width := 273;
Height := 13;
ParentFont := True;
end;
with TBevel.Create(Self) do begin
Parent := Self;
Shape := bsTopLine;
Style := bsLowered;
Left := 60;
Top := 81;
Width := 273;
Height := 2;
end;
with TLabel.Create(Self) do begin
Parent := Self;
Left := 60;
Top := 91;
Width := 269;
Height := 13;
ParentFont := True;
Caption := GetWindowsVersion;
end;
with TLabel.Create(Self) do begin
Parent := Self;
Left := 60;
Top := 107;
Width := 130;
Height := 13;
ParentFont := True;
Caption := sFreeMemoryLabel;
end;
FMemSize := TLabel.Create(Self);
with FMemSize do begin { free memory }
Parent := Self;
Left := 210;
Top := 107;
Width := 125;
Height := 13;
ParentFont := True;
end;
with TLabel.Create(Self) do begin
Parent := Self;
Left := 60;
Top := 123;
Width := 130;
Height := 13;
ParentFont := True;
Caption := sFreeResourcesLabel;
end;
FPercent := TLabel.Create(Self);
with FPercent do begin { free resources or memory in use }
Parent := Self;
Left := 210;
Top := 123;
Width := 125;
Height := 13;
ParentFont := True;
end;
with TButton.Create(Self) do begin
Parent := Self;
Left := 272;
Top := 6;
Width := 61;
Height := 25;
Caption := ResStr(SOkButton);
Cursor := crHand;
Default := False;
Cancel := True;
ModalResult := mrOk;
end;
UpdateMemoryInfo;
end;
procedure TAboutDialog.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if Application.MainForm <> nil then
Params.WndParent := Application.MainForm.Handle;
end;
procedure TAboutDialog.SetCopyright(const Developer, Company: string;
Year: Integer);
begin
FYearLabel.Caption := Format(sYear, [Company, Year]);
FCopyright.Caption := Developer;
end;
procedure TAboutDialog.SetVersion(LoVer, HiVer: Integer);
begin
FProductVersion.Caption := Format(sVersion, [HiVer, LoVer]);
end;
procedure TAboutDialog.UpdateMemoryInfo;
{$IFDEF WIN32}
var
MemStatus: TMemoryStatus;
{$ENDIF}
begin
{$IFDEF WIN32}
MemStatus.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(MemStatus);
FMemSize.Caption := Format(sFreeMemory, [FormatFloat(',0.##',
MemStatus.dwTotalPhys / 1024.0)]);
FPercent.Caption := Format('%d %%', [MemStatus.dwMemoryLoad]);
{$ELSE}
FMemSize.Caption := Format(sFreeMemory, [FormatFloat(',0.##',
GetFreeSpace(0) / 1024.0)]);
FPercent.Caption := Format('%d %%',
[GetFreeSystemResources(GFSR_SYSTEMRESOURCES)]);
{$ENDIF}
end;
function TAboutDialog.GetWindowsVersion: string;
begin
Result := JvVCLUtils.GetWindowsVersion;
end;
procedure TAboutDialog.SetAppData(const AppTitle: string; AIcon: TIcon);
begin
if (AIcon <> nil) and not AIcon.Empty then Icon := AIcon
else Icon.Handle := LoadIcon(0, IDI_APPLICATION);
FProductName.Caption := AppTitle;
FProgramIcon.Picture.Icon := Icon;
end;
end.
--- NEW FILE: GIFANIM.ICO ---
(This appears to be a binary file; contents omitted.)
--- NEW FILE: GIFMAIN.PAS ---
{*******************************************************}
{ }
{ 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, JvPlacemnt, JvSpeedbar, Grids, JvxCtrls,
ComCtrls {$IFDEF COMPILER3_UP}, ExtDlgs {$IFNDEF CBUILDER}, Jpeg {$ENDIF} {$ENDIF},
JvGIF, JvLabel, Mask, JvToolEdit {$IFDEF COMPILER4_UP}, ImgList, JvComponent {$ENDIF};
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;
public
{ Public declarations }
end;
var
AnimatorForm: TAnimatorForm;
implementation
uses Clipbrd, JvVCLUtils, JvAppUtils, JvMaxMin, JvProps, JvGraph, JvHints,
GIFPrvw, GIFPal, About;
{$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 := JvMaxMin.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 Beep;
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 }
RegUseAppTitle := True;
DefCompanyName := 'RX';
{ Initialization }
ToolbarImages.ResourceLoad(rtBitmap, 'TOOLBAR_IMAGES', clFuchsia);
SetHintStyle(hsRectangle, 3, False, taCenter);
UpdateCaption;
FTopIndex := -1;
FImage := TJvGIFImage .Create;
EnableTabs;
EnableButtons;
ColorDepthCombo.ItemIndex := Ord(DefaultMappingMethod);
{$IFDEF COMPILER3_UP}
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);
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 <= WidthOf(DrawRect)) and
(H <= HeightOf(DrawRect)) then
begin
DrawRect := Bounds(L, T, Frame.Width, Frame.Height);
end
else begin
Size := DrawRect.Top + MulDiv(H, WidthOf(DrawRect), W);
if Size > DrawRect.Bottom then begin
L := MulDiv(L, HeightOf(DrawRect), H);
T := MulDiv(T, HeightOf(DrawRect), H);
W := MulDiv(Frame.Width, HeightOf(DrawRect), H);
H := MulDiv(Frame.Height, HeightOf(DrawRect), H);
DrawRect := Bounds(L, T, W, H);
end
else begin
L := MulDiv(L, WidthOf(DrawRect), W);
T := MulDiv(T, WidthOf(DrawRect), W);
H := MulDiv(Frame.Height, WidthOf(DrawRect), W);
W := MulDiv(Frame.Width, WidthOf(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
ShowAbout('RX GIF Image Format Support', 'RX Library Demo Program',
1, 1, 1998);
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.
--- NEW FILE: GIFMAIN.dfm ---
object AnimatorForm: TAnimatorForm
Left = 282
Top = 113
AutoScroll = False
BorderIcons = [biSystemMenu, biMinimize]
ClientHeight = 421
ClientWidth = 366
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPreview = True
OldCreateOrder = True
OnActivate = FormActivate
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnShow = FormActivate
PixelsPerInch = 96
TextHeight = 13
object Bevel: TBevel
Left = 4
Top = 40
Width = 157
Height = 357
Shape = bsFrame
end
object Frame1Lbl: TLabel
Left = 12
Top = 119
Width = 39
Height = 13
Caption = 'Frame #'
Transparent = True
Visible = False
end
object Frame2Lbl: TLabel
Tag = 1
Left = 12
Top = 206
Width = 39
Height = 13
Caption = 'Frame #'
Transparent = True
Visible = False
end
object Frame3Lbl: TLabel
Tag = 2
Left = 12
Top = 292
Width = 39
Height = 13
Caption = 'Frame #'
Transparent = True
Visible = False
end
object Frame4Lbl: TLabel
Tag = 3
Left = 12
Top = 379
Width = 39
Height = 13
Caption = 'Frame #'
Transparent = True
Visible = False
end
object No1: TLabel
Left = 62
Top = 119
Width = 24
Height = 13
Alignment = taRightJustify
Caption = '2000'
Visible = False
end
object No2: TLabel
Tag = 1
Left = 62
Top = 206
Width = 24
Height = 13
Alignment = taRightJustify
Caption = '2000'
Visible = False
end
object No3: TLabel
Tag = 2
Left = 62
Top = 292
Width = 24
Height = 13
Alignment = taRightJustify
Caption = '2000'
Visible = False
end
object No4: TLabel
Tag = 3
Left = 62
Top = 379
Width = 24
Height = 13
Alignment = taRightJustify
Caption = '2000'
Visible = False
end
object Status: TLabel
Left = 8
Top = 403
Width = 152
Height = 13
AutoSize = False
Transparent = True
end
object JvSpeedbar: TJvSpeedBar
Left = 0
Top = 0
Width = 366
Height = 31
ParentFont = True
BoundLines = [blBottom]
Options = [sbFlatBtns, sbGrayedBtns]
BtnOffsetHorz = 3
BtnOffsetVert = 3
BtnWidth = 24
BtnHeight = 23
IniStorage = Storage
Images = ToolbarImages
BevelOuter = bvNone
TabOrder = 4
OnDblClick = SpeedBarDblClick
InternalVer = 1
object SpeedbarSection1: TJvSpeedbarSection
Caption = 'File'
end
object SpeedbarSection2: TJvSpeedbarSection
Caption = 'Edit'
end
object SpeedbarSection3: TJvSpeedbarSection
Caption = 'Image'
end
object SpeedbarSection4: TJvSpeedbarSection
Caption = 'Help'
end
object NewBtn: TJvSpeedItem
Caption = 'New'
Hint = 'New|'
ImageIndex = 8
Spacing = 1
Left = 11
Top = 3
Visible = True
OnClick = NewBtnClick
SectionName = 'File'
end
object OpenBtn: TJvSpeedItem
Caption = 'Open'
Hint = 'Open|'
ImageIndex = 9
Spacing = 1
Left = 35
Top = 3
Visible = True
OnClick = OpenBtnClick
SectionName = 'File'
end
object SaveBtn: TJvSpeedItem
Caption = 'Save'
Enabled = False
Hint = 'Save|'
ImageIndex = 12
Spacing = 1
Left = 59
Top = 3
Visible = True
OnClick = SaveBtnClick
SectionName = 'File'
end
object SaveAsBtn: TJvSpeedItem
Caption = 'SaveAs'
Enabled = False
Hint = 'SaveAs|'
ImageIndex = 13
Spacing = 1
Left = 83
Top = 3
Visible = True
OnClick = SaveAsBtnClick
SectionName = 'File'
end
object InsertBtn: TJvSpeedItem
Caption = 'Insert'
Hint = 'Insert|'
ImageIndex = 5
Spacing = 1
Left = 107
Top = 3
Visible = True
OnClick = InsertBtnClick
SectionName = 'File'
end
object CutBtn: TJvSpeedItem
Caption = 'Cut'
Enabled = False
Hint = 'Cut|'
ImageIndex = 3
Spacing = 1
Left = 139
Top = 3
Visible = True
OnClick = CutBtnClick
SectionName = 'Edit'
end
object CopyBtn: TJvSpeedItem
Caption = 'Copy'
Enabled = False
Hint = 'Copy|'
ImageIndex = 2
Spacing = 1
Left = 163
Top = 3
Visible = True
OnClick = CopyBtnClick
SectionName = 'Edit'
end
object PasteBtn: TJvSpeedItem
Caption = 'Paste'
Enabled = False
Hint = 'Paste|'
ImageIndex = 10
Spacing = 1
Left = 187
Top = 3
Visible = True
OnClick = PasteBtnClick
SectionName = 'Edit'
end
object DeleteBtn: TJvSpeedItem
Caption = 'Delete'
Enabled = False
Hint = 'Delete|'
ImageIndex = 4
Spacing = 1
Left = 211
Top = 3
Visible = True
OnClick = DeleteBtnClick
SectionName = 'Edit'
end
object UpBtn: TJvSpeedItem
Caption = 'Move Up'
Enabled = False
Hint = 'Move Up|'
ImageIndex = 7
Spacing = 1
Left = 243
Top = 3
Visible = True
OnClick = UpBtnClick
SectionName = 'Image'
end
object DownBtn: TJvSpeedItem
Caption = 'Move Down'
Enabled = False
Hint = 'Move Down|'
ImageIndex = 6
Spacing = 1
Left = 267
Top = 3
Visible = True
OnClick = DownBtnClick
SectionName = 'Image'
end
object GrayscaleBtn: TJvSpeedItem
Caption = 'Grayscale'
Hint = 'Grayscale|'
ImageIndex = 0
Spacing = 1
Left = 323
Top = 3
OnClick = GrayscaleBtnClick
SectionName = 'Image'
end
object PreviewBtn: TJvSpeedItem
Caption = 'Preview'
Enabled = False
Hint = 'Preview|'
ImageIndex = 11
Spacing = 1
Left = 299
Top = 3
Visible = True
OnClick = PreviewBtnClick
SectionName = 'Image'
end
object AboutBtn: TJvSpeedItem
Caption = 'About'
Hint = 'About|'
ImageIndex = 1
Spacing = 1
Left = 331
Top = 3
OnClick = AboutBtnClick
SectionName = 'Help'
end
end
object Pages: TPageControl
Left = 168
Top = 40
Width = 191
Height = 357
ActivePage = OptionsTab
TabOrder = 6
object OptionsTab: TTabSheet
Caption = 'Options'
object Label1: TLabel
Left = 16
Top = 245
Width = 101
Height = 13
Caption = 'Color Depth Method: '
FocusControl = ColorDepthCombo
end
object ThumbnailsLabel: TJvLabel
Left = 30
Top = 27
Width = 125
Height = 26
Caption = 'Thumbnails Reflect Image'#13#10'Position'
FocusControl = ThumbnailsBox
ShadowSize = 0
ShowFocus = True
OnMouseDown = CheckLabelMouseDown
end
object AlwaysOnTopLabel: TJvLabel
Left = 30
Top = 99
Width = 100
Height = 26
Caption = 'Main Dialog Window'#13#10'Always On Top'
FocusControl = AlwaysOnTop
ShadowSize = 0
ShowFocus = True
OnMouseDown = CheckLabelMouseDown
end
object ColorDepthCombo: TComboBox
Left = 16
Top = 261
Width = 153
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 1
OnChange = ColorDepthComboChange
Items.Strings = (
'Frequency of use'
'Quantizing'
'Truncate 7x8x4'
'Truncate 6x6x6'
'Tripel ')
end
object ThumbnailsBox: TCheckBox
Left = 13
Top = 31
Width = 17
Height = 17
Checked = True
State = cbChecked
TabOrder = 0
OnClick = ThumbnailsBoxClick
end
object FlatBtns: TCheckBox
Left = 13
Top = 67
Width = 148
Height = 17
Caption = 'Flat Toolbar Buttons '
Checked = True
State = cbChecked
TabOrder = 2
OnClick = FlatBtnsClick
end
object AlwaysOnTop: TCheckBox
Left = 13
Top = 103
Width = 17
Height = 17
TabOrder = 3
OnClick = AlwaysOnTopClick
end
end
object AnimationTab: TTabSheet
Caption = 'Animation'
object Bevel6: TBevel
Left = 106
Top = 85
Width = 69
Height = 21
end
object Bevel3: TBevel
Left = 106
Top = 60
Width = 69
Height = 21
end
object Label2: TLabel
Left = 7
Top = 213
Width = 90
Height = 13
Caption = '&Trailing Comment: '
FocusControl = TrailingComment
end
object Label4: TLabel
Left = 7
Top = 15
Width = 86
Height = 13
Caption = 'Animation Width: '
end
object Label5: TLabel
Left = 7
Top = 40
Width = 89
Height = 13
Caption = 'Animation Height: '
end
object Bevel1: TBevel
Left = 106
Top = 11
Width = 69
Height = 21
end
object Bevel2: TBevel
Left = 106
Top = 35
Width = 69
Height = 21
end
object ScreenW: TLabel
Left = 111
Top = 14
Width = 58
Height = 15
AutoSize = False
Caption = '0'
end
object ScreenH: TLabel
Left = 111
Top = 38
Width = 58
Height = 15
AutoSize = False
Caption = '0'
end
object Label6: TLabel
Left = 7
Top = 64
Width = 69
Height = 13
Caption = 'Image Count: '
end
object ImageCount: TLabel
Left = 111
Top = 63
Width = 58
Height = 15
AutoSize = False
Caption = '0'
end
object Label7: TLabel
Left = 7
Top = 114
Width = 94
Height = 13
Caption = '&Background Color: '
FocusControl = BackColor
end
object Label14: TLabel
Left = 7
Top = 89
Width = 64
Height = 13
Caption = 'GIF Version: '
end
object GIFVersion: TLabel
Left = 111
Top = 88
Width = 58
Height = 15
AutoSize = False
Caption = '87a'
end
object LoopLbl: TJvLabel
Left = 27
Top = 167
Width = 75
Height = 14
Caption = '&Repeat Count: '
Enabled = False
FocusControl = RepeatCnt
ShadowSize = 0
end
object TrailingComment: TMemo
Left = 4
Top = 229
Width = 176
Height = 96
ScrollBars = ssVertical
TabOrder = 1
OnChange = CommentChange
end
object BackColor: TJvComboEdit
Left = 106
Top = 110
Width = 69
Height = 21
ButtonFlat = False
Color = clBlack
DirectInput = False
GlyphKind = gkEllipsis
ButtonWidth = 17
NumGlyphs = 1
TabOrder = 0
OnButtonClick = BackColorButtonClick
end
object RepeatCntBtn: TUpDown
Left = 161
Top = 163
Width = 15
Height = 21
Associate = RepeatCnt
Enabled = False
Min = 0
Max = 30000
Position = 0
TabOrder = 2
Wrap = False
end
object RepeatCnt: TEdit
Left = 106
Top = 163
Width = 55
Height = 21
CharCase = ecUpperCase
Enabled = False
MaxLength = 5
TabOrder = 3
Text = '0'
OnChange = LoopChange
end
object LoopBox: TCheckBox
Left = 4
Top = 140
Width = 97
Height = 17
Caption = '&Looping'
TabOrder = 4
OnClick = LoopChange
end
object RepeatForever: TCheckBox
Left = 27
Top = 191
Width = 97
Height = 17
Caption = 'Repeat &Forever'
Enabled = False
TabOrder = 5
OnClick = LoopChange
end
end
object ImageTab: TTabSheet
Caption = 'Image'
object Bevel4: TBevel
Left = 108
Top = 7
Width = 69
Height = 21
end
object Label3: TLabel
Left = 6
Top = 238
Width = 85
Height = 13
Caption = 'Image Comment: '
FocusControl = FrameComment
end
object Label8: TLabel
Left = 6
Top = 11
Width = 69
Height = 13
Caption = 'Image Width: '
end
object FrameW: TLabel
Left = 113
Top = 10
Width = 58
Height = 15
AutoSize = False
Caption = '0'
end
object Bevel5: TBevel
Left = 108
Top = 32
Width = 69
Height = 21
end
object FrameH: TLabel
Left = 113
Top = 35
Width = 58
Height = 15
AutoSize = False
Caption = '0'
end
object Label11: TLabel
Left = 6
Top = 37
Width = 72
Height = 13
Caption = 'Image Height: '
end
object Label9: TLabel
Left = 6
Top = 64
Width = 27
Height = 13
Caption = 'Left: '
FocusControl = ImageLeft
end
object Label10: TLabel
Left = 6
Top = 92
Width = 28
Height = 13
Caption = 'Top: '
FocusControl = ImageTop
end
object Label12: TLabel
Left = 6
Top = 120
Width = 95
Height = 13
Caption = 'Duration (1/100 s): '
FocusControl = DelayTime
end
object Label13: TLabel
Left = 6
Top = 144
Width = 85
Height = 13
Caption = 'Undraw Method: '
FocusControl = DisposalCombo
end
object TransColorLabel: TJvLabel
Left = 6
Top = 216
Width = 96
Height = 14
Caption = 'Transparent Color: '
Enabled = False
FocusControl = TransColor
ShadowSize = 0
end
object FrameComment: TMemo
Left = 1
Top = 254
Width = 180
Height = 71
ScrollBars = ssVertical
TabOrder = 9
OnChange = CommentChange
end
object ImageLeft: TEdit
Left = 108
Top = 60
Width = 55
Height = 21
CharCase = ecUpperCase
MaxLength = 5
TabOrder = 0
Text = '0'
OnChange = TopLeftChange
end
object ImageLeftBtn: TUpDown
Left = 163
Top = 60
Width = 15
Height = 21
Associate = ImageLeft
Min = 0
Max = 32767
Position = 0
TabOrder = 1
Wrap = False
end
object ImageTop: TEdit
Left = 108
Top = 88
Width = 55
Height = 21
CharCase = ecUpperCase
MaxLength = 5
TabOrder = 2
Text = '0'
OnChange = TopLeftChange
end
object ImageTopBtn: TUpDown
Left = 163
Top = 88
Width = 15
Height = 21
Associate = ImageTop
Min = 0
Max = 32767
Position = 0
TabOrder = 3
Wrap = False
end
object DelayTime: TEdit
Left = 108
Top = 116
Width = 55
Height = 21
CharCase = ecUpperCase
MaxLength = 10
TabOrder = 4
Text = '0'
OnChange = DelayTimeChange
end
object DelayTimeBtn: TUpDown
Left = 163
Top = 116
Width = 15
Height = 21
Associate = DelayTime
Min = 0
Max = 32767
Position = 0
TabOrder = 5
Wrap = False
end
object DisposalCombo: TComboBox
Left = 6
Top = 160
Width = 171
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 6
OnChange = DisposalComboChange
Items.Strings = (
'Undefined'
'Leave'
'Restore Background'
'Restore Previous')
end
object TransColor: TJvComboEdit
Left = 124
Top = 212
Width = 52
Height = 21
ButtonFlat = False
Color = clBlack
DirectInput = False
GlyphKind = gkEllipsis
ButtonWidth = 17
NumGlyphs = 1
TabOrder = 8
OnButtonClick = TransColorButtonClick
end
object TransBox: TCheckBox
Left = 6
Top = 191
Width = 99
Height = 17
Caption = 'Transparency '
TabOrder = 7
OnClick = TransBoxClick
end
end
end
object Progress: TProgressBar
Left = 169
Top = 403
Width = 189
Height = 13
Min = 0
Max = 100
TabOrder = 7
end
object ImageScroll: TScrollBar
Left = 139
Top = 46
Width = 16
Height = 345
Enabled = False
Kind = sbVertical
LargeChange = 4
Max = 1
PageSize = 0
TabOrder = 5
OnChange = ImageScrollChange
end
object Frame1: TPanel
Left = 12
Top = 48
Width = 121
Height = 69
BevelOuter = bvLowered
ParentColor = True
TabOrder = 0
object PaintBox1: TPaintBox
Left = 1
Top = 1
Width = 119
Height = 67
Align = alClient
OnMouseDown = PaintBoxMouseDown
OnPaint = PaintBoxPaint
end
end
object Frame2: TPanel
Tag = 1
Left = 12
Top = 135
Width = 121
Height = 69
BevelOuter = bvLowered
ParentColor = True
TabOrder = 1
object PaintBox2: TPaintBox
Tag = 1
Left = 1
Top = 1
Width = 119
Height = 67
Align = alClient
OnMouseDown = PaintBoxMouseDown
OnPaint = PaintBoxPaint
end
end
object Frame3: TPanel
Tag = 2
Left = 12
Top = 222
Width = 121
Height = 69
BevelOuter = bvLowered
ParentColor = True
TabOrder = 2
object PaintBox3: TPaintBox
Tag = 2
Left = 1
Top = 1
Width = 119
Height = 67
Align = alClient
OnMouseDown = PaintBoxMouseDown
OnPaint = PaintBoxPaint
end
end
object Frame4: TPanel
Tag = 3
Left = 12
Top = 309
Width = 121
Height = 69
BevelOuter = bvLowered
ParentColor = True
TabOrder = 3
object PaintBox4: TPaintBox
Tag = 3
Left = 1
Top = 1
Width = 119
Height = 67
Align = alClient
OnMouseDown = PaintBoxMouseDown
OnPaint = PaintBoxPaint
end
end
object Storage: TJvFormStorage
PreventResize = True
UseRegistry = True
StoredProps.Strings = (
'ThumbnailsBox.Checked'
'FlatBtns.Checked'
'AlwaysOnTop.Checked')
StoredValues = <>
Left = 8
Top = 32
end
object ToolbarImages: TImageList
Height = 15
Left = 36
Top = 32
end
end
--- NEW FILE: GIFPAL.DFM ---
object PaletteForm: TPaletteForm
Left = 217
Top = 137
BorderStyle = bsToolWindow
Caption = 'Palette'
ClientHeight = 253
ClientWidth = 339
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object RightPanel: TPanel
Left = 244
Top = 0
Width = 95
Height = 253
Align = alRight
BevelOuter = bvNone
Ctl3D = False
ParentCtl3D = False
TabOrder = 0
object OkBtn: TButton
Left = 10
Top = 8
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
end
object CancelBtn: TButton
Left = 10
Top = 40
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object GridPanel: TPanel
Left = 0
Top = 0
Width = 244
Height = 253
Align = alClient
BevelOuter = bvNone
BorderWidth = 5
TabOrder = 1
object ColorGrid: TJvDrawGrid
Left = 5
Top = 5
Width = 234
Height = 243
Align = alClient
ColCount = 16
Ctl3D = True
DefaultColWidth = 15
DefaultRowHeight = 15
DefaultDrawing = False
FixedCols = 0
RowCount = 16
FixedRows = 0
Options = []
ParentColor = True
ParentCtl3D = False
ScrollBars = ssNone
TabOrder = 0
OnDrawCell = ColorGridDrawCell
end
end
end
--- NEW FILE: GIFPAL.PAS ---
{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) demo program }
{ }
{ Copyright (c) 1997 Master-Bank }
{ }
{*******************************************************}
unit GIFPal;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Grids, JvxCtrls, Jvgrids;
const
NumPaletteEntries = 256;
type
TPaletteForm = class(TForm)
RightPanel: TPanel;
OkBtn: TButton;
CancelBtn: TButton;
GridPanel: TPanel;
ColorGrid: TJvDrawGrid ;
procedure ColorGridDrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FPaletteEntries: array[0..NumPaletteEntries - 1] of TPaletteEntry;
FPalette: HPALETTE;
FCount: Integer;
function CellColor(Row, Col: Longint): TColor;
procedure DrawSquare(Row, Col: Longint; CellRect: TRect; ShowSelector: Boolean);
procedure ColorToCell(AColor: TColor; var Col, Row: Longint);
protected
function GetPalette: HPALETTE; override;
public
{ Public declarations }
procedure SetPalette(Palette: HPALETTE);
end;
var
PaletteForm: TPaletteForm;
function SelectColor(Palette: HPALETTE; AColor: TColor): TColor;
implementation
uses JvVCLUtils, JvMaxMin;
{$R *.DFM}
function SelectColor(Palette: HPALETTE; AColor: TColor): TColor;
var
Col, Row: Longint;
begin
Result := AColor;
if Palette = 0 then begin
Beep; Exit;
end;
with TPaletteForm.Create(Application) do
try
SetPalette(Palette);
ColorToCell(AColor, Col, Row);
ColorGrid.Col := Col;
ColorGrid.Row := Row;
ActiveControl := ColorGrid;
if ShowModal = mrOk then begin
Result := CellColor(ColorGrid.Row, ColorGrid.Col);
end;
finally
Free;
end;
end;
procedure TPaletteForm.ColorToCell(AColor: TColor; var Col, Row: Longint);
var
I: Word;
begin
I := GetNearestPaletteIndex(FPalette, ColorToRGB(AColor));
if I < FCount then begin
Row := I div ColorGrid.RowCount;
Col := I - (ColorGrid.ColCount * Row);
end
else begin
Col := -1;
Row := -1;
end;
end;
function TPaletteForm.CellColor(Row, Col: Longint): TColor;
var
PalIndex: Integer;
begin
PalIndex := Col + (Row * ColorGrid.ColCount);
with FPaletteEntries[PalIndex] do
Result := TColor(RGB(peRed, peGreen, peBlue));
end;
procedure TPaletteForm.DrawSquare(Row, Col: Longint; CellRect: TRect;
ShowSelector: Boolean);
var
SavePal: HPalette;
begin
ColorGrid.Canvas.Pen.Color := clBtnFace;
with CellRect do ColorGrid.Canvas.Rectangle(Left, Top, Right, Bottom);
InflateRect(CellRect, -1, -1);
Frame3D(ColorGrid.Canvas, CellRect, clBtnShadow, clBtnHighlight, 2);
SavePal := 0;
if FPalette <> 0 then begin
SavePal := SelectPalette(ColorGrid.Canvas.Handle, FPalette, False);
RealizePalette(ColorGrid.Canvas.Handle);
end;
ColorGrid.Canvas.Brush.Color := PaletteColor(CellColor(Row, Col));
ColorGrid.Canvas.Pen.Color := PaletteColor(CellColor(Row, Col));
with CellRect do
ColorGrid.Canvas.Rectangle(Left, Top, Right, Bottom);
if FPalette <> 0 then
SelectPalette(ColorGrid.Canvas.Handle, SavePal, True);
if ShowSelector then begin
ColorGrid.Canvas.Brush.Color := Self.Color;
ColorGrid.Canvas.Pen.Color := Self.Color;
InflateRect(CellRect, -1, -1);
ColorGrid.Canvas.DrawFocusRect(CellRect);
end;
end;
function TPaletteForm.GetPalette: HPALETTE;
begin
if FPalette <> 0 then Result := FPalette
else Result := inherited GetPalette;
end;
procedure TPaletteForm.SetPalette(Palette: HPALETTE);
var
I: Integer;
begin
FCount := Min(PaletteEntries(Palette), NumPaletteEntries);
FPalette := Palette;
GetPaletteEntries(Palette, 0, FCount, FPaletteEntries);
if FCount <= 16 then begin
ColorGrid.RowCount := 2;
ColorGrid.ColCount := 8;
ColorGrid.DefaultColWidth := 31;
ColorGrid.DefaultRowHeight := 31;
end
else begin
ColorGrid.RowCount := FCount div 16;
if FCount mod 16 > 0 then
ColorGrid.RowCount := ColorGrid.RowCount + 1;
ColorGrid.ColCount := 16;
ColorGrid.DefaultColWidth := 18;
ColorGrid.DefaultRowHeight := 18;
end;
for I := FCount to NumPaletteEntries - 1 do
FillChar(FPaletteEntries[I], SizeOf(TPaletteEntry), $80);
ClientWidth := (ColorGrid.ColCount * ColorGrid.DefaultColWidth) +
(GridPanel.BorderWidth * 2) + RightPanel.Width +
(ColorGrid.Width - ColorGrid.ClientWidth);
ClientHeight := (ColorGrid.RowCount * ColorGrid.DefaultRowHeight) +
(GridPanel.BorderWidth * 2) + (ColorGrid.Height - ColorGrid.ClientHeight);
if HandleAllocated then PostMessage(Handle, WM_QUERYNEWPALETTE, 0, 0);
end;
procedure TPaletteForm.ColorGridDrawCell(Sender: TObject; Col,
Row: Longint; Rect: TRect; State: TGridDrawState);
begin
DrawSquare(Row, Col, Rect, gdFocused in State);
end;
procedure TPaletteForm.FormCreate(Sender: TObject);
begin
with ColorGrid.Canvas do begin
Brush.Style := bsSolid;
Pen.Color := clBlack;
end;
end;
end.
--- NEW FILE: Gifprvw.dfm ---
object PreviewForm: TPreviewForm
Left = 210
Top = 112
BorderStyle = bsToolWindow
Caption = 'Preview'
ClientHeight = 183
ClientWidth = 282
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPrev...
[truncated message content] |