aniicoed.pas

Delphi 开发的的热键操作 很值得看的

unit AniIcoEd;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, ExtCtrls, StdCtrls, Buttons, DsgnIntf, AniIcons, ComCtrls, Dialogs;

type
  TAnimatedIconsProperty = class( TPropertyEditor )
    function GetAttributes : TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TAnimatedIconsPropertyEditDlg = class( TForm )
    pnlFrames: TPanel;
    btnOk: TButton;
    btnCancel: TButton;
    lblIcons: TLabel;
    lstIcons: TListBox;
    pnlInformation: TPanel;
    lblTitle: TLabel;
    edtTitle: TEdit;
    grpSpiffies: TGroupBox;
    lblSpiffies: TLabel;
    edtSpiffies: TEdit;
    udSpiffies: TUpDown;
    lblSpiffies2: TLabel;
    lblExplainSpiffies: TLabel;
    grpPreview: TGroupBox;
    pnlPreview: TPanel;
    edtAuthor: TEdit;
    lblAuthor: TLabel;
    btnStop: TSpeedButton;
    btnPlay: TSpeedButton;
    pnlButtons: TPanel;
    btnLoadFrame: TSpeedButton;
    btnDeleteFrame: TSpeedButton;
    btnSaveFrames: TSpeedButton;
    btnLoadFrames: TSpeedButton;
    dlgOpenFrame: TOpenDialog;
    dlgSaveFrames: TSaveDialog;
    dlgOpenFrames: TOpenDialog;
    pbxIcon: TPaintBox;
    btnUp: TSpeedButton;
    btnDown: TSpeedButton;
    procedure FormCreate( Sender : TObject );
    procedure FormDestroy( Sender : TObject );
    procedure edtSpiffiesKeyPress(Sender: TObject; var Key: Char);
    procedure lstIconsMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure lstIconsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure edtTitleChange(Sender: TObject);
    procedure edtAuthorChange(Sender: TObject);
    procedure btnLoadFrameClick(Sender: TObject);
    procedure lstIconsClick(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure edtSpiffiesChange(Sender: TObject);
    procedure btnSaveFramesClick(Sender: TObject);
    procedure btnLoadFramesClick(Sender: TObject);
    procedure btnDeleteFrameClick(Sender: TObject);
    procedure pbxIconPaint(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
  private
    FIgnore   : Boolean;
    FIconSize : Integer;
    FPropName : string;
    FIcons    : TAnimatedIcons;
    procedure NewFrame(Sender: TObject; Frame: Integer);
    function  GetDisplayTime(const Index: Integer): String;
    procedure CheckButtons;
    procedure SetIcons(Value: TAnimatedIcons);
    procedure PaintIcon(Index: Integer);
    procedure SetFormVars;
  public
    property PropName  : string read FPropName write FPropName;
    property Icons     : TAnimatedIcons read FIcons write SetIcons;
  end;


implementation

{$R *.DFM}
type
  TPanelCracker = class(TPanel);

{ TAnimatedIconsProperty }

function TAnimatedIconsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TAnimatedIconsProperty.GetValue : string;
begin
  Result := Format('(%s)', [GetPropType^.Name]);
end;

procedure TAnimatedIconsProperty.Edit;
var
  Dialog : TAnimatedIconsPropertyEditDlg;
begin
  Dialog := TAnimatedIconsPropertyEditDlg.Create(Application);
  try
    if PropCount = 1 then
    begin
      Dialog.PropName := TComponent(GetComponent(0)).Owner.Name + '.' +
                         TComponent(GetComponent(0)).Name + '.' + GetName;
      Dialog.Caption :=  Dialog.PropName + ' - ' + Dialog.Caption;
    end;

    Dialog.Icons := TAnimatedIcons(GetOrdValue);
    if Dialog.ShowModal = mrOK then
     begin
       SetOrdValue(Longint(Dialog.Icons));
       Modified;
     end;
  finally
    Dialog.Free;
  end;
end;

{ TAnimatedIconsPropertyEditDlg }
procedure TAnimatedIconsPropertyEditDlg.FormCreate(Sender: TObject);
begin
  FIcons := TAnimatedIcons.Create(is32x32);
  FIcons.OnNewFrame := NewFrame;
end;

procedure TAnimatedIconsPropertyEditDlg.FormDestroy(Sender: TObject);
begin
  FIcons.Free;
end;

function TAnimatedIconsPropertyEditDlg.GetDisplayTime(const Index: Integer): String;
begin
  Result := IntToStr(Icons[Index].DisplayTime);
  if Icons[Index].DisplayTime=1 then Result := Result + ' spiffy ' else Result := Result + ' spiffies';
end;

procedure TAnimatedIconsPropertyEditDlg.SetFormVars;
var
  i : integer;
begin
  edtTitle.Text := Icons.Title;
  edtAuthor.Text := Icons.Author;
  if Icons.IconSize=is16x16 then FIconSize := 16 else FIconSize := 32;
  lstIcons.Clear;
  for i:=0 to Icons.Count-1 do
   lstIcons.Items.Add(IntToStr(Icons[i].DisplayTime));
  CheckButtons;
  PaintIcon(0);
end;

procedure TAnimatedIconsPropertyEditDlg.SetIcons(Value: TAnimatedIcons);
begin
  FIcons.Assign(Value);
  SetFormVars;
end;

procedure TAnimatedIconsPropertyEditDlg.edtSpiffiesKeyPress(Sender: TObject;
  var Key: Char);
begin
  if not (Key in [#8, '0'..'9']) then Key := #0;
end;

procedure TAnimatedIconsPropertyEditDlg.lstIconsMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  Height := FIconSize+2;
end;

procedure TAnimatedIconsPropertyEditDlg.lstIconsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  with (Control As TListBox).Canvas do
   begin
     FillRect(Rect);
     if (Index>=0) and (Index<TListBox(Control).Items.Count) then
      begin
        Icons.DrawIcon((Control As TListBox).Canvas, Rect.left+1, Rect.top+1, Index, Brush.Color);
        inc(Rect.left, FIconSize + 4);
        DrawText(Handle, PChar(GetDisplayTime(Index)), -1, Rect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      end;
   end;
end;

procedure TAnimatedIconsPropertyEditDlg.CheckButtons;
var
  i, iSelCount : integer;
  iLastSelected: integer;
  bUpEnabled,
  bFirst       : Boolean;
begin
  btnSaveFrames.Enabled := lstIcons.Items.Count>0;
  btnPlay.Enabled := btnSaveFrames.Enabled and not FIcons.Playing;
  btnStop.Enabled := btnSaveFrames.Enabled;
  iSelCount := 0;
  iLastSelected := 0;
  bFirst := True;
  bUpEnabled := False;
  if btnSaveFrames.Enabled then
   for i:=0 to lstIcons.Items.Count-1 do
    if lstIcons.Selected[i] then
     begin
       if bFirst and (i>0) then bUpEnabled := True;
       bFirst := False;
       iLastSelected := i;
       inc(iSelCount);
       if iSelCount=1 then
        begin
          FIgnore := True;
          edtSpiffies.Text := lstIcons.Items[i];
          FIgnore := False;
        end;
     end;
  if iSelCount>0 then
   begin
     edtSpiffies.Enabled := True;
     udSpiffies.Enabled := True;
     btnDeleteFrame.Enabled := True;
     if iSelCount=1 then
      grpSpiffies.Caption := '1 frame selected'
     else if iSelCount=lstIcons.Items.Count then
      grpSpiffies.Caption := 'All frames selected'
     else
      grpSpiffies.Caption := IntToStr(iSelCount)+' frames selected';
     btnUp.Enabled := bUpEnabled;
     btnDown.Enabled := iLastSelected<lstIcons.Items.Count-1;
   end
  else
   begin
     grpSpiffies.Caption := 'No frames selected';
     edtSpiffies.Enabled := False;
     udSpiffies.Enabled := False;
     btnDeleteFrame.Enabled := False;
     btnUp.Enabled := False;
     btnDown.Enabled := False;
   end;
end;

procedure TAnimatedIconsPropertyEditDlg.edtTitleChange(Sender: TObject);
begin
  Icons.Title := edtTitle.Text;
end;

procedure TAnimatedIconsPropertyEditDlg.edtAuthorChange(Sender: TObject);
begin
  Icons.Author := edtAuthor.Text;
end;

procedure TAnimatedIconsPropertyEditDlg.btnLoadFrameClick(Sender: TObject);
var
  Icon : TAnimatedIcon;
  i    : Integer;
begin
  if dlgOpenFrame.Execute then
   begin
     for i:=0 to dlgOpenFrame.Files.Count-1 do
      begin
        Icon := TAnimatedIcon.Create;
        Icon.Handle := LoadImage(0, PChar(dlgOpenFrame.Files[i]), IMAGE_ICON, FIconSize, FIconSize, LR_LOADFROMFILE); //LR_LOADREALSIZE or LR_LOADFROMFILE);
        Icon.DisplayTime := 10;
        Icons.Add(Icon);
        lstIcons.Items.Add('10');
        lstIcons.ItemIndex := lstIcons.Items.Count-1;
      end;
     CheckButtons;
   end;
end;

procedure TAnimatedIconsPropertyEditDlg.NewFrame(Sender: TObject; Frame: Integer);
begin
  PaintIcon(Frame);
end;

procedure TAnimatedIconsPropertyEditDlg.lstIconsClick(Sender: TObject);
begin
  CheckButtons;
  if (lstIcons.ItemIndex<>-1) and not Icons.Playing then PaintIcon(lstIcons.ItemIndex);
end;

procedure TAnimatedIconsPropertyEditDlg.btnPlayClick(Sender: TObject);
begin
  btnPlay.Enabled := False;
  btnDeleteFrame.Enabled := False;
  Icons.Play(0);
end;

procedure TAnimatedIconsPropertyEditDlg.PaintIcon(Index : Integer);
begin
  if (Index>=0) and (Index<Icons.Count) then
   Icons.DrawIcon(TPanelCracker(pnlPreview).Canvas, 26 - (FIconSize div 2), (26 - FIconSize div 2), Index, clBtnFace);
end;

procedure TAnimatedIconsPropertyEditDlg.btnStopClick(Sender: TObject);
begin
  if FIcons.Playing then
   begin
     FIcons.Stop;
     btnPlay.Enabled := True;
     btnDeleteFrame.Enabled := edtSpiffies.Enabled;
   end;
end;

procedure TAnimatedIconsPropertyEditDlg.btnOkClick(Sender: TObject);
begin
  btnStopClick(Self);
  ModalResult := mrOk;
end;

procedure TAnimatedIconsPropertyEditDlg.btnCancelClick(Sender: TObject);
begin
  btnStopClick(Self);
  ModalResult := mrCancel;
end;

procedure TAnimatedIconsPropertyEditDlg.edtSpiffiesChange(Sender: TObject);
var
  i, NewVal : integer;
begin
  if FIgnore then Exit;
  try
    NewVal := StrToInt(edtSpiffies.Text);
  except
    NewVal := 1;
  end;
  lstIcons.Items.BeginUpdate;
  for i:=0 to Icons.Count-1 do
   begin
     if lstIcons.Selected[i] then
      begin
        Icons[i].DisplayTime := NewVal;
        lstIcons.Items[i] := edtSpiffies.Text;
        lstIcons.Selected[i] := True;
      end;
   end;
  lstIcons.Items.EndUpdate;
end;

procedure TAnimatedIconsPropertyEditDlg.btnSaveFramesClick(Sender: TObject);
begin
  if dlgSaveFrames.Execute then
   Icons.SaveToFile(dlgSaveFrames.FileName);
end;

procedure TAnimatedIconsPropertyEditDlg.btnLoadFramesClick(Sender: TObject);
begin
  if dlgOpenFrames.Execute then
   begin
     btnStopClick(Self);
     Icons.LoadFromFile(dlgOpenFrames.FileName);
     SetFormVars;
   end;
end;

procedure TAnimatedIconsPropertyEditDlg.btnDeleteFrameClick(Sender: TObject);
var
  i : integer;
begin
  btnStopClick(Self);
  i := 0;
  while i<Icons.Count do
   if lstIcons.Selected[i] then
    begin
      lstIcons.Items.Delete(I);
      Icons.Delete(I);
    end
   else
    inc(i);
  CheckButtons;
end;

procedure TAnimatedIconsPropertyEditDlg.pbxIconPaint(Sender: TObject);
begin
  if (lstIcons.ItemIndex<>-1) and not Icons.Playing then
   PaintIcon(lstIcons.ItemIndex)
  else
   PaintIcon(0);
end;

procedure TAnimatedIconsPropertyEditDlg.btnDownClick(Sender: TObject);
var
  i : integer;
begin
  for i:=lstIcons.Items.Count-2 downto 0 do
   begin
     if lstIcons.Selected[i] then
      begin
        lstIcons.Items.Move(i, i+1);
        Icons.Move(i, i+1);
        lstIcons.Selected[i+1] := True;
      end;
   end;
  CheckButtons;
end;

procedure TAnimatedIconsPropertyEditDlg.btnUpClick(Sender: TObject);
var
  i : integer;
begin
  for i:=1 to lstIcons.Items.Count-1 do
   begin
     if lstIcons.Selected[i] then
      begin
        lstIcons.Items.Move(i, i-1);
        Icons.Move(i, i-1);
        lstIcons.Selected[i-1] := True;
      end;
   end;
  CheckButtons;
end;

end.