tinyavl.dpr

delphi 不需任何控件

{$A1,B-,C-,D-,E-,F-,G+,H+,I-,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y-,Z1}
{$WARNINGS OFF}
program TinyAVL;

{$R WinXP.res}
uses
  Windows, Messages,
  Arashi in 'Arashi.pas';

type
//----------------      测试Form
  PForm1 = ^TForm1;
  TForm1= object(TForm)
  public
    btn, btn2:PControl;
    procedure btnClick(Sender:PControl);
    procedure FileRun(Sender:PControl);
    procedure Create;
  end;

//----------------     测试COM对象
  Folder = IDispatch ;
  IShellDispatch = interface(IDispatch)
    ['{D8F015C0-C278-11CE-A49E-444553540000}']
    function Get_Application: IDispatch; safecall;
    function Get_Parent: IDispatch; safecall;
    function NameSpace(vDir: OleVariant): Folder; safecall;
    function BrowseForFolder(Hwnd: Integer; const Title: WideString; Options: Integer; RootFolder: OleVariant): Folder; safecall;
    function Windows: IDispatch; safecall;
    procedure Open(vDir: OleVariant); safecall;
    procedure Explore(vDir: OleVariant); safecall;
    procedure MinimizeAll; safecall;
    procedure UndoMinimizeALL; safecall;
    procedure FileRun; safecall;
    procedure CascadeWindows; safecall;
    procedure TileVertically; safecall;
    procedure TileHorizontally; safecall;
    procedure ShutdownWindows; safecall;
    procedure Suspend; safecall;
    procedure EjectPC; safecall;
    procedure SetTime; safecall;
    procedure TrayProperties; safecall;
    procedure Help; safecall;
    procedure FindFiles; safecall;
    procedure FindComputer; safecall;
    procedure RefreshMenu; safecall;
    procedure ControlPanelItem(const szDir: WideString); safecall;
    property Application: IDispatch read Get_Application;
    property Parent: IDispatch read Get_Parent;
  end;

function CLSIDFromProgID(pszProgID: PWideChar; out clsid: TGUID): HResult; stdcall;
	external 'ole32.dll';
function CoInitialize(pvReserved: Pointer): HResult; stdcall;
	external 'ole32.dll';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown;
  dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall;
	external 'ole32.dll';
  
//------------------    Code Here
var f:^TForm1;

procedure TForm1.btnClick(Sender:PControl);
begin
  MessageBox(Handle,Sender.Caption,Caption,MB_OK);
end;

procedure TForm1.FileRun(Sender:PControl);
var
  Shell:IShellDispatch;
  ClsID:TGUID;
begin
  CLSIDFromProgID('Shell.Application', ClsID);
  CoCreateInstance(ClsID, nil, 5, IDispatch, Shell); //此处必须采用IDisptch!!!
  Shell.FileRun; 
end;

procedure TForm1.Create;
var btnFileRun:PControl;
begin
  inherited Create(0,'Form Test');
  btn:= CreateCtrl(@Self,'button','This is A '#10#13'MultiLine Button',0,BS_MULTILINE);
  btn.SetBounds(200,220,250,160);
  btnFileRun:=CreateCtrl(@Self,'Button','Run File Dialog');
  btnFileRun.SetBounds(200,150,250,60);
  btnFileRun.OnClick:=FileRun;
  btn2:=CreateCtrl(@Self,'SysDateTimePick32','SysDateTimePick32');
  btn2.SetBounds(20,45,250,50);
  btn2.OnClick:=btnClick;
  btn.OnClick:=btnClick;
end;

begin
  CoInitialize(nil);
  New(f);
  f.Create;
  Application.Run;

end.