⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 gifmain.pas

📁 RxRich很有用的文字图像显示控件,这是它的Demo
💻 PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
{*******************************************************}
{                                                       }
{     Delphi VCL Extensions (RX) demo program           }
{                                                       }
{     Copyright (c) 1997 Master-Bank                    }
{                                                       }
{*******************************************************}

{$I RX.INC}

unit GIFMain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Placemnt, SpeedBar, Grids, RXCtrls,
  ComCtrls {$IFDEF RX_D3}, ExtDlgs {$IFNDEF CBUILDER}, Jpeg {$ENDIF} {$ENDIF},
  RxGIF, Mask, RxSpin, ToolEdit {$IFDEF RX_D4}, ImgList {$ENDIF};

type
  TAnimatorForm = class(TForm)
    SpeedBar: TSpeedBar;
    SpeedbarSection1: TSpeedbarSection;
    NewBtn: TSpeedItem;
    OpenBtn: TSpeedItem;
    SaveBtn: TSpeedItem;
    SaveAsBtn: TSpeedItem;
    InsertBtn: TSpeedItem;
    SpeedbarSection2: TSpeedbarSection;
    SpeedbarSection3: TSpeedbarSection;
    Storage: TFormStorage;
    CutBtn: TSpeedItem;
    CopyBtn: TSpeedItem;
    PasteBtn: TSpeedItem;
    DeleteBtn: TSpeedItem;
    SpeedbarSection4: TSpeedbarSection;
    AboutBtn: TSpeedItem;
    UpBtn: TSpeedItem;
    DownBtn: TSpeedItem;
    PreviewBtn: TSpeedItem;
    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: TRxLabel;
    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: TComboEdit;
    Label7: TLabel;
    Label8: TLabel;
    FrameW: TLabel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    FrameH: TLabel;
    Label11: TLabel;
    ImageLeft: TRxSpinEdit;
    Label9: TLabel;
    Label10: TLabel;
    ImageTop: TRxSpinEdit;
    Label12: TLabel;
    DelayTime: TRxSpinEdit;
    DisposalCombo: TComboBox;
    Label13: TLabel;
    TransColor: TComboEdit;
    TransBox: TCheckBox;
    TransColorLabel: TRxLabel;
    Label14: TLabel;
    GIFVersion: TLabel;
    Bevel6: TBevel;
    FlatBtns: TCheckBox;
    AlwaysOnTop: TCheckBox;
    AlwaysOnTopLabel: TRxLabel;
    GrayscaleBtn: TSpeedItem;
    ToolbarImages: TImageList;
    RepeatCnt: TRxSpinEdit;
    LoopBox: TCheckBox;
    LoopLbl: TRxLabel;
    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: TGIFImage;
    FTopIndex: Integer;
    FFileName: string;
    FModified: Boolean;
    FLoading: Boolean;
    FUpdating: Boolean;
    FAborting: Boolean;
    FProgressPos: Integer;
{$IFDEF RX_D3}
    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, VclUtils, AppUtils, MaxMin, RxProps, RxGraph, RxHints,
  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.AsInteger := FImage.RepeatCount;
    TrailingComment.Lines := FImage.Comment;
    GIFVersion.Caption := GIFVersionName(FImage.Version);
    if FImage.FrameIndex >= 0 then begin
      with FImage.Frames[FImage.FrameIndex] do begin
        FrameComment.Lines := Comment;
        FrameW.Caption := IntToStr(Width);
        FrameH.Caption := IntToStr(Height);
        ImageLeft.AsInteger := Origin.X;
        ImageTop.AsInteger := Origin.Y;
        DelayTime.AsInteger :=
          FImage.Frames[FImage.FrameIndex].AnimateInterval div 10;
        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 := MaxMin.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: TGIFFrame;
  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 := TGIFImage.Create;
  EnableTabs;
  EnableButtons;
  ColorDepthCombo.ItemIndex := Ord(DefaultMappingMethod);
{$IFDEF RX_D3}
  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(TGIFImage);
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -