Основные принципы разработки графического пользовательского интерфейса

procedure HideMainForm;

end;

var

look: Tlook;

implementation

{$R *.dfm}

uses

ComObj, activex, ShellApi,

registry,StdCtrls,ADOTableofset, Setuping;

procedure Tlook.CreateTrayIcon(n:Integer);

var

nidata : TNotifyIconData;

begin

with nidata do

begin

cbSize := SizeOf(TNotifyIconData);

Wnd := Self.Handle;

uID := 1;

uFlags := NIF

_ICON or NIF_MESSAGE or NIF_TIP;

uCallBackMessage := WM_MYICONNOTIFY;

hIcon := Application.Icon.Handle;

StrPCopy(szTip,Application.Title);

end;

Shell_NotifyIcon(NIM_ADD, @nidata);

end;

procedure Tlook.DeleteTrayIcon(n: Integer);

var nidata : TNotifyIconData;

begin

with nidata do

begin

cbSize := SizeOf(TNotifyIconData);

Wnd := Self.Handle;

uID := 1;

end;

Shell_NotifyIcon(NIM_DELETE, @nidata);

end;

procedure Tlook.FormCreate(Sender: TObject);

begin

ShownOnce:= False;

CreateTrayIcon(1);

end;

procedure Tlook.FormDestroy(Sender: TObject);

begin

DeleteTrayIcon(1);

end;

procedure Tlook.HideMainForm;

begin

Application.ShowMainForm := False;

ShowWindow(Application.Handle, SW_HIDE);

ShowWindow(Application.MainForm.Handle, SW_HIDE);

end;

procedure Tlook.N1Click(Sender: TObject);

begin

RestoreMainForm;

DeleteTrayIcon(1);

N1.Enabled := False;

N2.Enabled := True;

end;

procedure Tlook.N2Click(Sender: TObject);

begin

HideMainForm;

CreateTrayIcon(1);

n2.Enabled := False;

n1.Enabled := True;

end;

procedure Tlook.N4Click(Sender: TObject);

begin

close;

end;

procedure Tlook.RestoreMainForm;

var i,j : Integer;

begin

Application.ShowMainForm := True;

ShowWindow(Application.Handle, SW_RESTORE);

ShowWindow(Application.MainForm.Handle, SW_RESTORE);

if not ShownOnce then

begin

for I := 0 to Application.MainForm.ComponentCount -1 do

if Application.MainForm.Components[I] is TWinControl then

with Application.MainForm.Components[I] as TWinControl do

if Visible then

begin

ShowWindow(Handle, SW_SHOWDEFAULT);

for J := 0 to ComponentCount -1 do

if Components[J] is TWinControl then

ShowWindow((Components[J] as TWinControl).Handle, SW_SHOWDEFAULT);

end;

ShownOnce := True;

end;end;

procedure Tlook.WMICON(var msg: TMessage);

var P : TPoint;

begin

case msg.LParam of

WM_LBUTTONDOWN:

begin

GetCursorPos(p);

SetForegroundWindow(Application.MainForm.Handle);

PopupMenu1.Popup(P.X, P.Y);

end;

WM_LBUTTONDBLCLK : n1Click(Self);

end;

end;

procedure Tlook.WMSYSCOMMAND(var msg: TMessage);

begin

inherited;

if (Msg.wParam=SC_MINIMIZE) then n2Click(Self);

end;

procedure Tlook.FormActivate(Sender: TObject);

begin

n2.Click;

end;

procedure Tlook.oreinstall1Click(Sender: TObject);

begin

setup.Show;

end;

procedure Tlook.Exit1Click(Sender: TObject);

begin

close;

end;

procedure Tlook.Edit1Click(Sender: TObject);

begin

hide;

TabSheetset.Show;

end;

end.

Модуль Setup:

unit setuping;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, ShlObj, ComObj, ActiveX, DB, ADODB;

type

Tsetup = class(TForm)

ProgressBar1: TProgressBar;

Button1: TButton;

ListBox1: TListBox;

Label1: TLabel;

Button2: TButton;

DataSource1: TDataSource;

ADOConnection1: TADOConnection;

ADOTable1: TADOTable;

ADOTable2: TADOTable;

ADOTable3: TADOTable;

ADOTable4: TADOTable;

ADOTable5: TADOTable;

ADOTable1N: TAutoIncField;

ADOTable1Run: TWideStringField;

ADOTable1Program: TWideStringField;

ADOTable2N: TAutoIncField;

ADOTable2Run: TWideStringField;

ADOTable2Program: TWideStringField;

ADOTable3N: TAutoIncField;

ADOTable3Run: TWideStringField;

ADOTable3Program: TWideStringField;

ADOTable4N: TAutoIncField;

ADOTable4Run: TWideStringField;

ADOTable4Program: TWideStringField;

ADOTable5N: TAutoIncField;

ADOTable5Run: TWideStringField;

ADOTable5Program: TWideStringField;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

end;

var

setup: Tsetup;

f:Text;

implementation

{$R *.dfm}

procedure Tsetup.Button1Click(Sender: TObject);

var

i:integer;

s1,s2:string;

procedure LookDir(StartDir, Mask : String;List : TStrings);

var

SearchRec : TSearchRec;

s,k:string;

begin

if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';

if FindFirst(StartDir+'*.*', faAnyFile, SearchRec) = 0 then

begin

repeat

if (SearchRec.Attr and faDirectory) <> faDirectory then

begin

if ExtractFileExt(StartDir+SearchRec.Name) = Mask then

begin

List.Add(StartDir+SearchRec.Name);

s:=StartDir+SearchRec.Name;

k:=SearchRec.Name;

writeln(f,s);

writeln(f,k);i:=i+1;

ProgressBar1.Position:=i;

end;end

else

if (SearchRec.Name <> ' ') and (SearchRec.Name <> '.') then

begin

LookDir(StartDir + SearchRec.Name + '', Mask,list);

end;

until FindNext(SearchRec) <> 0;

FindClose(SearchRec);

end;end;

procedure jarlik(const PathObj, PathLink, Desc, Param: string);

var

IObject: IUnknown;

SLink: IShellLink;

PFile: IPersistFile;

begin

IObject := CreateComObject(CLSID_ShellLink);

SLink := IObject as IShellLink;

PFile := IObject as IPersistFile;

with SLink do

begin

SetArguments(PChar(Param));

SetDescription(PChar(Desc));

SetPath(PChar(PathObj));

end;

PFile.Save(PWChar(WideString(PathLink)), FALSE);

end;

procedure setap;

begin

while not eof(f) do

begin i:=i+1;

ProgressBar1.Position:=i;

readln(f,s1);readln(f,s2);

ADOTable1.First;

ADOTable2.First;ADOTable3.First;

ADOTable4.First;ADOTable5.First;

while not ADOTable1.Eof do

begin

if s2=ADOTable1Run.AsString then

jarlik(s1,'C:\setup\Entertainments\'+ADOTable1Program.AsString+'.lnk','','')

ADOTable1.Next;

end;

while not ADOTable2.Eof do

begin

if s2=ADOTable2Run.AsString then

jarlik(s1,'C:\setup\Games\'+ADOTable2Program.AsString+'.lnk','','');

ADOTable2.Next;

end;

while not ADOTable3.Eof do

begin

if s2=ADOTable3Run.AsString then

jarlik(s1,'C:\setup\Internet\'+ADOTable3Program.AsString+'.lnk','','');

ADOTable3.Next;

end;

while not ADOTable4.Eof do

begin

if s2=ADOTable4Run.AsString then

jarlik(s1,'C:\setup\Office\'+ADOTable4Program.AsString+'.lnk','','');

ADOTable4.Next;

end;

while not ADOTable5.Eof do

begin

if s2=ADOTable5Run.AsString then

jarlik(s1,'C:\setup\Utilites\'+ADOTable5Program.AsString+'.lnk','','');

 Скачать реферат