home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1999 February
/
PCWorld_1999-02_cd.bin
/
temacd
/
HotKeys
/
AniBmpEd.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1998-06-19
|
12KB
|
422 lines
unit AniBmpEd;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, ExtCtrls, StdCtrls, Buttons, DsgnIntf, AniIcons, ComCtrls, Dialogs;
type
TAnimatedBitmapsProperty = class( TPropertyEditor )
function GetAttributes : TPropertyAttributes; override;
function GetValue: string; override;
procedure Edit; override;
end;
TAnimatedBitmapsPropertyEditDlg = class( TForm )
pnlFrames: TPanel;
btnOk: TButton;
btnCancel: TButton;
lblBitmaps: TLabel;
lstBitmaps: 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 lstBitmapsMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure lstBitmapsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure edtTitleChange(Sender: TObject);
procedure edtAuthorChange(Sender: TObject);
procedure btnLoadFrameClick(Sender: TObject);
procedure lstBitmapsClick(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;
FPropName : string;
FBitmaps : TAnimatedBitmaps;
procedure NewFrame(Sender: TObject; Frame: Integer);
function GetDisplayTime(const Index: Integer): String;
procedure CheckButtons;
procedure SetBitmaps(Value: TAnimatedBitmaps);
procedure PaintBitmap(Index: Integer);
procedure SetFormVars;
public
property PropName : string read FPropName write FPropName;
property Bitmaps : TAnimatedBitmaps read FBitmaps write SetBitmaps;
end;
implementation
{$R *.DFM}
type
TPanelCracker = class(TPanel);
{ TAnimatedBitmapsProperty }
function TAnimatedBitmapsProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
function TAnimatedBitmapsProperty.GetValue : string;
begin
Result := Format('(%s)', [GetPropType^.Name]);
end;
procedure TAnimatedBitmapsProperty.Edit;
var
Dialog : TAnimatedBitmapsPropertyEditDlg;
begin
Dialog := TAnimatedBitmapsPropertyEditDlg.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.Bitmaps := TAnimatedBitmaps(GetOrdValue);
if Dialog.ShowModal = mrOK then
begin
SetOrdValue(Longint(Dialog.Bitmaps));
Modified;
end;
finally
Dialog.Free;
end;
end;
{ TAnimatedBitmapsPropertyEditDlg }
procedure TAnimatedBitmapsPropertyEditDlg.FormCreate(Sender: TObject);
begin
FBitmaps := TAnimatedBitmaps.Create;
FBitmaps.OnNewFrame := NewFrame;
end;
procedure TAnimatedBitmapsPropertyEditDlg.FormDestroy(Sender: TObject);
begin
FBitmaps.Free;
end;
function TAnimatedBitmapsPropertyEditDlg.GetDisplayTime(const Index: Integer): String;
begin
Result := IntToStr(Bitmaps[Index].DisplayTime);
if Bitmaps[Index].DisplayTime=1 then Result := Result + ' spiffy ' else Result := Result + ' spiffies';
end;
procedure TAnimatedBitmapsPropertyEditDlg.SetFormVars;
var
i : integer;
begin
edtTitle.Text := Bitmaps.Title;
edtAuthor.Text := Bitmaps.Author;
lstBitmaps.Clear;
for i:=0 to Bitmaps.Count-1 do
lstBitmaps.Items.Add(IntToStr(Bitmaps[i].DisplayTime));
CheckButtons;
PaintBitmap(0);
end;
procedure TAnimatedBitmapsPropertyEditDlg.SetBitmaps(Value: TAnimatedBitmaps);
begin
FBitmaps.Assign(Value);
SetFormVars;
end;
procedure TAnimatedBitmapsPropertyEditDlg.edtSpiffiesKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in [#8, '0'..'9']) then Key := #0;
end;
procedure TAnimatedBitmapsPropertyEditDlg.lstBitmapsMeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
begin
Height := FBitmaps[Index].Height+2;
end;
procedure TAnimatedBitmapsPropertyEditDlg.lstBitmapsDrawItem(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
Bitmaps.DrawBitmap((Control As TListBox).Canvas, Rect.left+1, Rect.top+1, Index, (Control As TListBox).Canvas.Brush.Color);
inc(Rect.left, FBitmaps[Index].Width + 4);
DrawText(Handle, PChar(GetDisplayTime(Index)), -1, Rect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
end;
end;
end;
procedure TAnimatedBitmapsPropertyEditDlg.CheckButtons;
var
i, iSelCount : integer;
iLastSelected: integer;
bUpEnabled,
bFirst : Boolean;
begin
btnSaveFrames.Enabled := lstBitmaps.Items.Count>0;
btnPlay.Enabled := btnSaveFrames.Enabled and not FBitmaps.Playing;
btnStop.Enabled := btnSaveFrames.Enabled;
iSelCount := 0;
iLastSelected := 0;
bFirst := True;
bUpEnabled := False;
if btnSaveFrames.Enabled then
for i:=0 to lstBitmaps.Items.Count-1 do
if lstBitmaps.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 := lstBitmaps.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=lstBitmaps.Items.Count then
grpSpiffies.Caption := 'All frames selected'
else
grpSpiffies.Caption := IntToStr(iSelCount)+' frames selected';
btnUp.Enabled := bUpEnabled;
btnDown.Enabled := iLastSelected<lstBitmaps.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 TAnimatedBitmapsPropertyEditDlg.edtTitleChange(Sender: TObject);
begin
Bitmaps.Title := edtTitle.Text;
end;
procedure TAnimatedBitmapsPropertyEditDlg.edtAuthorChange(Sender: TObject);
begin
Bitmaps.Author := edtAuthor.Text;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnLoadFrameClick(Sender: TObject);
var
Bitmap : TAnimatedBitmap;
i : Integer;
begin
if dlgOpenFrame.Execute then
begin
for i:=0 to dlgOpenFrame.Files.Count-1 do
begin
Bitmap := TAnimatedBitmap.Create;
TBitmap(Bitmap).LoadFromFile(dlgOpenFrame.Files[i]);
Bitmap.Transparent := True;
Bitmap.DisplayTime := 10;
Bitmaps.Add(Bitmap);
lstBitmaps.Items.Add('10');
lstBitmaps.ItemIndex := lstBitmaps.Items.Count-1;
end;
CheckButtons;
end;
end;
procedure TAnimatedBitmapsPropertyEditDlg.NewFrame(Sender: TObject; Frame: Integer);
begin
PaintBitmap(Frame);
end;
procedure TAnimatedBitmapsPropertyEditDlg.lstBitmapsClick(Sender: TObject);
begin
CheckButtons;
if (lstBitmaps.ItemIndex<>-1) and not Bitmaps.Playing then PaintBitmap(lstBitmaps.ItemIndex);
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnPlayClick(Sender: TObject);
begin
btnPlay.Enabled := False;
btnDeleteFrame.Enabled := False;
Bitmaps.Play(0);
end;
procedure TAnimatedBitmapsPropertyEditDlg.PaintBitmap(Index : Integer);
begin
if (Index>=0) and (Index<Bitmaps.Count) then
Bitmaps.DrawBitmap(TPanelCracker(pnlPreview).Canvas, (90 - Bitmaps[Index].Width) div 2, (90 - Bitmaps[Index].Height) div 2, Index, pnlPreview.Color);
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnStopClick(Sender: TObject);
begin
if FBitmaps.Playing then
begin
FBitmaps.Stop;
btnPlay.Enabled := True;
btnDeleteFrame.Enabled := edtSpiffies.Enabled;
end;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnOkClick(Sender: TObject);
begin
btnStopClick(Self);
ModalResult := mrOk;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnCancelClick(Sender: TObject);
begin
btnStopClick(Self);
ModalResult := mrCancel;
end;
procedure TAnimatedBitmapsPropertyEditDlg.edtSpiffiesChange(Sender: TObject);
var
i, NewVal : integer;
begin
if FIgnore then Exit;
try
NewVal := StrToInt(edtSpiffies.Text);
except
NewVal := 1;
end;
lstBitmaps.Items.BeginUpdate;
for i:=0 to Bitmaps.Count-1 do
begin
if lstBitmaps.Selected[i] then
begin
Bitmaps[i].DisplayTime := NewVal;
lstBitmaps.Items[i] := edtSpiffies.Text;
lstBitmaps.Selected[i] := True;
end;
end;
lstBitmaps.Items.EndUpdate;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnSaveFramesClick(Sender: TObject);
begin
if dlgSaveFrames.Execute then
Bitmaps.SaveToFile(dlgSaveFrames.FileName);
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnLoadFramesClick(Sender: TObject);
begin
if dlgOpenFrames.Execute then
begin
btnStopClick(Self);
Bitmaps.LoadFromFile(dlgOpenFrames.FileName);
SetFormVars;
end;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnDeleteFrameClick(Sender: TObject);
var
i : integer;
begin
btnStopClick(Self);
i := 0;
while i<Bitmaps.Count do
if lstBitmaps.Selected[i] then
begin
lstBitmaps.Items.Delete(I);
Bitmaps.Delete(I);
end
else
inc(i);
CheckButtons;
end;
procedure TAnimatedBitmapsPropertyEditDlg.pbxIconPaint(Sender: TObject);
begin
if (lstBitmaps.ItemIndex<>-1) and not Bitmaps.Playing then
PaintBitmap(lstBitmaps.ItemIndex)
else
PaintBitmap(0);
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnDownClick(Sender: TObject);
var
i : integer;
begin
for i:=lstBitmaps.Items.Count-2 downto 0 do
begin
if lstBitmaps.Selected[i] then
begin
lstBitmaps.Items.Move(i, i+1);
Bitmaps.Move(i, i+1);
lstBitmaps.Selected[i+1] := True;
end;
end;
CheckButtons;
end;
procedure TAnimatedBitmapsPropertyEditDlg.btnUpClick(Sender: TObject);
var
i : integer;
begin
for i:=1 to lstBitmaps.Items.Count-1 do
begin
if lstBitmaps.Selected[i] then
begin
lstBitmaps.Items.Move(i, i-1);
Bitmaps.Move(i, i-1);
lstBitmaps.Selected[i-1] := True;
end;
end;
CheckButtons;
end;
end.