Текущий архив: 2004.04.25;
Скачать: CL | DM;

Вниз

Оцените компонент AnimIcon!   Найти похожие ветки 

← →
V-Isa ©   (2004-04-02 14:45) [0]

Здравствуйте!
Не так давно попробовал свои силы в написании компонент. Первый мой компонент AnimIcon позволяет изменять через заданные промежутки времени иконки приложения, формы, главной формы приложения, контроля ImageList и в SysTray. Хотелось бы, чтобы Вы оценили его и ткнули носом в ошибки и недочеты. Хотел еще сделать возможность подкючения какого-либо компонента подобного SysTrayComp, но что-то не получилось (все, что в комментариях - связано с этим). Протестируйте пжлста... Распространяется as is... FreeWare!!!

unit AnimIcon;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, ShellApi,TypInfo;

const
 WM_FROMTRAYICON = WM_USER+59;

type
 TIconPlace = (ipAppIcon,ipAppMainFormIcon,ipFormIcon,ipImageCtrl,ipSysTray{, ipOtherTrayComp});
 TOnTimerEventOrder = (First,Second);
 TIconPlaceSet=Set Of TIconPlace;
 TTimerEvent=procedure(Sender:TObject) of object;
 TAnimIcon = class(TImageList)

 private
   { Private declarations }
   FIconPlaceSet:TIconPlaceSet;
   FEnabled:Boolean;
   FInterval:Cardinal;
   FNumIco:Integer;
   FOnTimer:TTimerEvent;
   FImage:TImage;
   FAuthor:String;
   FTip:String;
   FActionForIconOnSysTray:Byte;
   FOnTimerEventOrder:TOnTimerEventOrder;
   FhWnd : hWnd;
   //FOtherTrayComp:TComponent;
   procedure PlaceIcon;
 protected
   { Protected declarations }
   procedure Loaded;override;
   procedure SetEnabled(Value:Boolean);
   function GetEnabled:Boolean;
   procedure SetInterval(Value:Cardinal);
   function GetInterval:Cardinal;
   procedure OnAnimIconTimer(Sender: TObject);
   procedure SetImage(Value:TImage);
   function GetImage:TImage;
   //procedure SetOtherTrayComp(Value:TComponent);
   //function GetOtherTrayComp:TComponent;
   procedure SetAuthor(Value:String);
 public
   { Public declarations }
 published
   { Published declarations }
   constructor Create(AOwner:Tcomponent);override; //Конструктор
   destructor Destroy;override;
   property IconPlace: TIconPlaceSet Read FIconPlaceSet Write FIconPlaceSet;
   property Enabled:Boolean Read GetEnabled Write SetEnabled;
   property Interval:Cardinal Read GetInterval Write SetInterval;
   property OnTimer: TTimerEvent Read FOnTimer Write FOnTimer;
   property ImageCtrl: TImage Read GetImage Write SetImage;
   //property OtherTrayComp: TComponent Read GetOtherTrayComp Write SetOtherTrayComp;
   property Author:String Read FAuthor Write SetAuthor;
   property SysTrayTip:String Read FTip Write FTip;
   property OnTimerEventOrder:TOnTimerEventOrder Read FOnTimerEventOrder Write FOnTimerEventOrder;
 end;

var
 Timer:TTimer;

procedure Register;
function SysTrayIcon(hWindow:THandle; ID:Cardinal; ICON:hicon; CallbackMessage:Cardinal; Tip:String; Action:Byte):Boolean;

implementation

procedure Register;
begin
 RegisterComponents("MyComponents", [TAnimIcon]);
end;

function SysTrayIcon(hWindow:THandle; ID:Cardinal; Icon:hicon; CallbackMessage:Cardinal; Tip:String; Action:Byte):Boolean;
Var
NID : TNotifyIconData;
Begin
FillChar(NID, SizeOf(TNotifyIconData), 0);
with NID do begin
 cbSize := SizeOf(TNotifyIconData);
 Wnd:=hWindow;
 uID:=ID;
 uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
 uCallbackMessage:=CallbackMessage;
 hIcon:=Icon;
 If Length(Tip)>63 Then SetLength(Tip,63);
 StrPCopy(szTip, Tip);
 end;
Case Action Of
  1:Result := Shell_NotifyIcon( NIM_ADD, @NID );
  2:Result := Shell_NotifyIcon(NIM_MODIFY, @NID );
  3:Result := Shell_NotifyIcon( NIM_DELETE, @NID );
 Else Result := False;
End;
End;

procedure TAnimIcon.PlaceIcon;
Var
 Icon:TIcon;
 CallbackMessage:Cardinal;
Begin
 Inc(FNumIco);
 If FNumIco>Count Then FNumIco:=1;
 If ipAppIcon In FIconPlaceSet Then
   Begin
     GetIcon(FNumIco-1, Application.Icon);
     Application.ProcessMessages;
   End;
 If ipFormIcon In FIconPlaceSet Then
   Begin
     GetIcon(FNumIco-1,TForm(Owner).Icon);
     Application.ProcessMessages;
   End;
 If ipAppMainFormIcon In FIconPlaceSet Then
   Begin
     If Assigned(Application.MainForm) Then
       GetIcon(FNumIco-1,Application.MainForm.Icon);
     Application.ProcessMessages;
   End;
 If ipImageCtrl In FIconPlaceSet Then
   Begin
     If FImage <> nil Then
       GetIcon(FNumIco-1,FImage.Picture.Icon);
       Application.ProcessMessages;
   End;
 If ipSysTray In FIconPlaceSet Then
   Begin
     Icon:=TIcon.Create;
     GetIcon(FNumIco-1,Icon);
     CallbackMessage := WM_FROMTRAYICON;
     SysTrayIcon(FhWnd,0,Icon.Handle,CallbackMessage,FTip,FActionForIconOnSysTray);
     Application.ProcessMessages;
     If FActionForIconOnSysTray=1 Then FActionForIconOnSysTray:=2;
   End;
 {If ipOtherTrayComp In FIconPlaceSet Then
   Begin
     Icon:=TIcon.Create;
     GetIcon(FNumIco-1,Icon);
     TPicture(FOtherTrayComp).Icon:=Icon;
     Application.ProcessMessages;
   End;}
End;

///... продолжение следует ...


---

← →
V-Isa ©   (2004-04-02 14:45) [1]

//... продолжение ...

constructor TAnimIcon.Create(AOwner:TComponent);
begin
inherited create(AOwner);
FAuthor:="V-Isa aka Inter";
FNumIco:=0;
Timer:=TTimer.Create(Self);
Application.ProcessMessages;
SetEnabled(False);
SetInterval(1000);
Timer.OnTimer:=OnAnimIconTimer;
FActionForIconOnSysTray:=0;
FOnTimerEventOrder:=First;
end;

destructor TAnimIcon.Destroy;
Var
 Icon:TIcon;
 CallbackMessage:Cardinal;
begin
Inc(FNumIco);
If FNumIco>Count Then FNumIco:=1;
If ipSysTray In FIconPlaceSet Then
   Begin
     Icon:=TIcon.Create;
     GetIcon(FNumIco-1,Icon);
     CallbackMessage := WM_FROMTRAYICON;
     SysTrayIcon(FhWnd,0,Icon.Handle,CallbackMessage,FTip,3);
     Application.ProcessMessages;
   End;
inherited destroy;
end;

procedure TAnimIcon.OnAnimIconTimer(Sender: TObject);
begin
 if Assigned(FOnTimer) And (FOnTimerEventOrder=First) then FOnTimer(Self);
 Application.ProcessMessages;
 If Count>0 Then
   Begin
     PlaceIcon;
   End;
 Application.ProcessMessages;
 if Assigned(FOnTimer) And (FOnTimerEventOrder=Second) then FOnTimer(Self);
 Application.ProcessMessages;
end;

procedure TAnimIcon.SetEnabled(Value:Boolean);
begin
 If (Value=True) And (csDesigning in ComponentState) Then
   Begin
     Value:=False;
     FNumIco:=0;
     FEnabled:=Value;
     Timer.Enabled:=FEnabled;
     Application.ProcessMessages;
     ShowMessage("Изменение данного свойства возможно только"+#13"во время выполнения программы!!!");
     Exit;
   End;
 If (Value=True) And (Count>0) Then
   Begin
     FActionForIconOnSysTray:=1;
     PlaceIcon;
   End;
 If Value=False Then
   Begin
     FActionForIconOnSysTray:=3;
     PlaceIcon;
   End;
 Application.ProcessMessages;
 If Value=False Then FNumIco:=0;
 FEnabled:=Value;
 Timer.Enabled:=FEnabled;
 Application.ProcessMessages;
end;

function TAnimIcon.GetEnabled:Boolean;
begin
 GetEnabled:=FEnabled;
end;

procedure TAnimIcon.SetInterval(Value:Cardinal);
Begin
 FInterval:=Value;
 Timer.Interval:=FInterval;
 Application.ProcessMessages;
End;

function TAnimIcon.GetInterval:Cardinal;
Begin
 GetInterval:=FInterval;
End;

procedure TAnimIcon.SetImage(Value:TImage);
begin
 FImage:=Value;
end;

function TAnimIcon.GetImage:TImage;
begin
 GetImage:=FImage;
end;

{procedure TAnimIcon.SetOtherTrayComp(Value:TComponent);
begin
 FOtherTrayComp:=Value;
end;

function TAnimIcon.GetOtherTrayComp:TComponent;
begin
 GetOtherTrayComp:=FOtherTrayComp;
end;}

procedure TAnimIcon.SetAuthor(Value:String);
begin
 FAuthor:="V-Isa aka Inter";
end;

procedure TAnimIcon.Loaded;
Begin
 inherited Loaded;
 FhWnd:=(Owner as TForm).Handle;
End;

end.

---

← →
Думкин ©   (2004-04-02 14:50) [2]

Как-то некрасиво столько кода тут - можно в нагрузку "Войну и мир" допечатать.

---

← →
V-Isa ©   (2004-04-02 14:52) [3]

Ну, соррри... просто не знал, как иначе...

---

Страницы: 1 вся ветка

Текущий архив: 2004.04.25;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.025 c