P
puremoonstone
Unregistered / Unconfirmed
GUEST, unregistred user!
下面的程序中，TddgLaunchPad是从TScrollBox继承下来的，它的一个属性是RunButtons,这个属性的类型是
TCollection的派生类。RunButtons用于管理一组从TCollectionItem继承下来的TRunBtnItem对象，
TRunBtnItem的作用是创建放在TddgLaunchPad上的TddgRunButton组件。我已经将ddgLaunchPad添加到面板上了，
但当编辑RunButtons属性的时候，出现错误：Invalid selection:'TRunButtons' has no owner,请大家帮忙
看看该怎么改呢？谢谢。
unit LnchPad;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ExtCtrls,ddgRunButton;
type
TddgLaunchPad=class;
TRunBtnItem=class(TCollectionItem)
private
FCommandLine:string
//store the command line
FTop:Integer;
FLeft:Integer
//store the positional properties for the TddgRunButton.
FRunButton:TddgRunButton
//reference to a TddgRunButton
FWidth:Integer
//keep track of the width and height
FHeight:Integer;
procedure SetCommandLine(const Value:String);
procedure SetLeft(Value:Integer);
procedure SetTop(Value:Integer);
public
constructor Create(Collection:TCollection);override;
destructor Destroy;override;
procedure Assign(Source:TPersistent);override;
property Width:Integer read FWidth;
property Height:Integer read FHeight;
published
{The published properties will be streamed}
property CommandLine:String read FCommandLine write SetCommandLine;
property Left:Integer read FLeft write Setleft;
property Top:Integer read FTop write SetTop;
end;
TRunButtons=class(TCollection)
private
FLaunchPad:TddgLaunchPad
//keep a reference to the TddgLaunchPad
function GetItem(Index:Integer):TRunBtnItem;
procedure SetItem(Index:Integer;Value:TRunBtnItem);
protected
procedure Update(Item:TCollectionItem);override;
public
constructor Create(LaunchPad:TddgLaunchPad);
function Add:TRunBtnItem;
procedure UpdateRunButtons;
property Items[Index:Integer]:TRunBtnItem read GetItem write SetItem;default;
end;
TddgLaunchPad = class(TScrollBar)
private
{ Private declarations }
FRunButtons:TRunButtons;
TopAlign:Integer;
LeftAlign:Integer;
procedure SetRunButtons(Value:TRunButtons);
procedure UpdateRunButton(Index:Integer);
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure GetChildren(Proc:TGetChildProc;Root:TComponent);override;
{ Public declarations }
published
{ Published declarations }
property RunButtons:TRunButtons read FRunButtons write SetRunButtons;
end;
procedure Register;
implementation
{TRunBtnItem}
constructor TRunbtnItem.Create(Collection:TCollection);
//This constructor gets the TCollection that owns this TRunBtnItem.
begin
inherited Create(Collection);
{Create an FRunButton instance.Make the launch pad the ownder and parent.
Then initialize its various properties.}
FRunButton:=TddgRunButton.Create(TRunButtons(Collection).FLaunchPad);
FRunButton.Parent:=TRunButtons(Collection).FLaunchPad;
FWidth:=FRunButton.Width
//keep track of the width and the height
FHeight:=FRunButton.Height;
end;
destructor TRunBtnItem.Destroy;
begin
FRunButton.Free
//Destroy the TddgRunButton instance
inherited Destroy
//Call the inherited Destroy destructor
end;
procedure TRunBtnItem.Assign(Source:TPersistent);
{It is necessary to override the TCollectionItem.Assign method so that
it knows how to copy from one TRunBtnItem to another.If this is done,then don't
call the inherited Assign().}
begin
if Source is TRunBtnItem then
begin
{Insted of assigning the command line to the FCommandLine storage field,
make the assignment to the property so that the accessor method will be called.
The accessor method as some side_effects that we want to occur.}
CommandLine:=TRunBtnItem(Source).CommandLine;
//copy values to the remaining fields.then exit the procedure.
FLeft:=TRunBtnItem(Source).Left;
FTop:=TRunBtnItem(Source).Top;
Exit;
end;
inherited Assign(Source);
end;
procedure TRunBtnItem.SetCommandLine(const Value:String);
{This is the write accessor method for TRunBtnItem.CommandLine.It ensures that
the private TddgRunButton instance,FRunButton,gets assigned the specified string
from Value}
begin
if FRunButton<>nil then
begin
FCommandLine:=Value;
FRunButton.CommandLine:=FCommandLine;
{This will cause the TRunButtons.Update method to be called for each TRunBtnItem}
Changed(False);
end;
end;
procedure TRunBtnItem.SetLeft(Value:Integer);
{Access method for the TRunBtnItem.Left property.}
begin
if FRunButton<>nil then
begin
FLeft:=Value;
FRunButton.Left:=FLeft;
end;
end;
procedure TRunBtnItem.SetTop(Value:Integer);
{Access method for the TRunBtnItem.Top property}
begin
if FRunButton<>nil then
begin
FTop:=Value;
FRunButton.Top:=FTop;
end;
end;
{TRunButtons}
constructor TRunButtons.Create(LaunchPad:TddgLaunchPad);
{The constructor points FLaunchPad to the TddgLaunchPad parameter.
LaunchPad is the owner of this collection.It is necessary to keep a reference
to LaunchPad as it will be accessed internally.}
begin
inherited Create(TRunBtnItem);
FLaunchPad:=LaunchPad;
end;
function TRunButtons.GetItem(Index:Integer):TRunBtnItem;
{Access method for TRunButtons.Items which returns the TRunBtnItem instance}
begin
Result:=TRunBtnItem(inherited GetItem(Index));
end;
procedure TRunButtons.SetItem(Index:Integer;Value:TRunBtnItem);
{Access method for TddgRunButton.Items which makes the assignment to
the specified indexed item.}
begin
inherited SetItem(Index,Value);
end;
procedure TRunButtons.Update(Item:TCollectionItem);
{TCollection.Update is called by TCollectionItems whenever a change is made to
any of the collection items.This is initially an abstract method.
It must be overridden to contain whatever logic is necessary when a
TCollectionItem has changed.
We use it to redraw the item by calling TddglaunchPad.UpdateRunButton}
begin
if Item<>nil then
FLaunchPad.UpdateRunButton(Item.Index);
end;
procedure TRunButtons.UpdateRunButtons;
{UpdateRunButtons is a public procedure that we made available so that users
of TRunButtons can force all run_buttons to be re_drawn.
This method calls TddgLaunchPad.UpdateRunButton for each TRunBtnItem instance.}
var
i:integer;
begin
for i:=0 to Count-1 do
FLaunchPad.UpdateRunButton(i);
end;
function TRunButtons.Add:TRunBtnItem;
{This method must be overridden to return the TRunBtnItem instance when
the inherited Add method is called.This is done by typecasting the original result}
begin
Result:=TRunBtnItem(inherited Add);
end;
{TddgLaunchPad}
constructor TddgLaunchPad.Create(AOwner:TComponent);
{Initializes the TRunButtons instance and internal variables used for positioning of
the TRunBtnItem as they are drawn}
begin
inherited Create(AOwner);
FRunButtons:=TRunButtons.Create(Self);
TopAlign:=0;
LeftAlign:=0;
end;
destructor TddgLaunchPad.Destroy;
begin
FRunButtons.Free
//Free the TRunButtons instance
inherited Destroy
//Call the inherited destroy method.
end;
procedure TddgLaunchPad.GetChildren(Proc:TGetChildProc;Root:TComponent);
{Override GetChildren to cause TddgLaunchPad to ignore any TRunButtons
that it owns since they do not need to be streamed in the context
TddgLaunchPad.The information necessary for creating the TddgRunButton
instances is already streamed as published properties of the
TCollectionItem descendant,TRunBtnItem.This method prevents the
TddgRunButton's from being streamed twice.}
var
i:integer;
begin
for i:=0 to ControlCount-1 do
begin
{Ignore the run buttons and the scrollbox}
if not (Controls is TddgRunButton) then
Proc(TComponent(Controls));
end;
end;
procedure TddgLaunchPad.SeTRunButtons(Value:TRunButtons);
{Access method for the RunButtons property}
begin
FRunButtons.Assign(Value);
end;
procedure TddgLaunchPad.UpdateRunButton(Index:integer);
{This method is responsible for drawing the TRunBtnItem instances.
It ensures that the TRunBtnItem's do not extend beyond the width of the
TddgLaunchPad.If so,it creates rows.This is only in effect as the user
is adding/removing TRunBtnItems.The user can still resize the TddgLaunchPad
so that it is smaller than the width of a TRunBtnItem}
begin
{If the first item begin drawn,set both positions to zero.}
if Index=0 then
begin
TopAlign:=0;
LeftAlign:=0;
end;
{If the width of the current row of TRunBtnItems is more than the width
of the TddgLaunchPad,then start a new row of TRunBtnItems.}
if ((LeftAlign+FRunButtons[Index].width)>width) then
begin
TopAlign:=TopAlign+FRunButtons[Index].Height;
LeftAlign:=0;
end;
FRunButtons[Index].Left:=LeftAlign;
FRunButtons[Index].Top:=TopAlign;
LeftAlign:=LeftAlign+FRunButtons[Index].Width;
end;
procedure Register;
begin
RegisterComponents('ddg', [TddgLaunchPad]);
end;
end.
unit ddgRunButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons,runbtnpe,DsgnIntf;
//runbtnpe单元提供对CommandLine用对话框编辑属性的功能
type
TCommandLine=type string;
TddgRunButton = class(TSpeedButton)
private
{ Private declarations }
FCommandLine:TCommandLine;
//Hiding Properties from the Object Inspector
FCaption:TCaption;
FAllowAllUp:Boolean;
FFont:TFont;
FGroupIndex:Integer;
FLayOut:TButtonLayout;
procedure SetCommandLine(Value:TCommandLine);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Click;override;
published
{ Published declarations }
property CommandLine:TCommandLine read FCommandLine write SetCommandLine;
//Read Only Properties are hidden
property Caption:TCaption read FCaption;
property AllowAllUp:Boolean read FAllowAllUp;
property Font:TFont read FFont;
property GroupIndex:Integer read FGroupIndex;
property LayOut:TButtonLayOut read FLayOut;
end;
procedure Register;
implementation
uses ShellAPI;
const
EXEExtension='.EXE';
function ProcessExecute(CommandLine:TCommandLine;cShow:Word):Integer;
{This method encapsulates the call to CreateProcess() which creates
a new process and its primary thread.This is the method used in Win32
to execute another application.This method requires the use of the
TStartInfo and TProcessInformation structures.These structures are
not documented as part of the Delphi 5 online help but rather the
Win32 help as STARTUPInfo and PROCESS_INFORMATION.
The CommandLine parameter specifies the pathname of the file to execute.
The cShow parameter specifies one fo the SW_XXXX constants which
specifies how to display the window.This value is assigned to the
sShowWindow field of the TStartUpInfo Structure.}
var
Rslt:LongBool;
StartUpInfo:TStartUpInfo
//documented as STARTUPINFO
ProcessInfo:TProcessInformation
//documented as PROCESS_INFORMATION
begin
{Clear the StartupInfo structures}
FillChar(StartupInfo,SizeOf(TStartupInfo),0);
{Initialize the StartupInfo structure with required data.
Here,we assign the SW_XXXX constant to the wShowWindow field of StartupInfo.
When specifying a value to this field ,the STARTF_USESHOWWINDOW flag must be
set in the dwFlags field.
Addtional information on the TStartupInfo is provided in the Win32
online help under STARTUPINFO.}
with StartUpInfo do
begin
cb:=SizeOf(TStartUpInfo)
//Specify size of structure
dwFlags:=STARTF_USESHOWWINDOW OR STARTF_FORCEONFEEDBACK;
wShowWindow:=cShow;
end;
{Create the process by calling CreateProcess().This function fills the
ProcessInfo structure with information about the new process and its
primary thread.Detailed information is provided in the Win32 online help
for the TProcessInfo structure under PROCESS_INFORMATION.}
Rslt:=CreateProcess(PChar(CommandLine),nil,nil,nil,False,NORMAL_PRIORITY_CLASS,nil,nil,StartUpInfo,ProcessInfo);
{If Rslt is true,then the CreateProcess call is sucessful.
Otherwise,GetLastError will return an error code representing the error which occurred.}
If Rslt then
begin
with ProcessInfo do
begin
{Wait until the process is in idle.}
WaitForInputIdle(hProcess,INFINITE);
CloseHandle(hThread)
//Free the hThread handle
CloseHandle(hProcess)
//Free the hProcess handle
Result:=0
//Set Result to 0,meaning successful
end;
end
else
begin
Result:=GetLastError
//Set result to the error code.
end;
end;
function IsExecutableFile(Value:TCommandLine):Boolean;
{This method returns whether or not the value represents a valid executable file by ensuring that its file extension is 'EXE'}
var
Ext:String[4];
begin
Ext:=ExtractFileExt(Value);
Result:=((UpperCase(Ext))=(EXEExtension));
end;
constructor TddgRunButton.Create(AOwner:TComponent);
{The constructor sets the default hieght and width properties to 45*45}
begin
inherited Create(AOwner);
Height:=45;
Width:=45;
end;
procedure TddgRunButton.SetCommandLine(Value:TCommandLine);
{This write access method sets the FCommandLine field to value, but only if
value represents a valid executable field name.It also sets the icon for the
TddgRunButton to the application icon of the file specified by value.}
var
Icon:TIcon;
begin
{First check to see that Value is an executalbe file and that it actually exists where specified.}
if not IsExecutableFile(Value) then
begin
Raise Exception.Create(Value+' is not an executable file.');
end;
if not FileExists(Value) then
begin
Raise EXception.Create(Value+' can not be found.');
end;
FCommandLine:=Value
//Store the value in FCommandLine
{Now draw the application icon for the file specified by value on the TddgButton icon.
This requires us to create a TIcon instance to which to load the icon.
It is then copied form this TIcon instance to the TddgButton's Canvas.
We must use the Win32 API function ExtractIcon() to retrieve the icon for the application.}
Icon:=TIcon.Create
//Create the TIcon instance
try
{Retrieve the icon from the application's file}
Icon.Handle:=ExtractIcon(hInstance,PChar(FCommandLine),0);
with Glyph do
begin
//Set the IddgButton properties so that the icon held by Icon can be copied onto it.
//First,Clear the canvas.This is required in case another icon was previously drawn on the canvas
Canvas.Brush.Style :=bsSolid;
Canvas.FillRect(Canvas.ClipRect);
//Set the Icon's width and height
Width:=Icon.Width
Height:=Icon.Height
Canvas.Draw(0,0,Icon)
//Draw the icon to TddgButton's Canvas
end;
finally
Icon.Free
//Free the TIcon instance
end;
end;
procedure TddgRunButton.Click;
var
WERetVal:Word;
begin
inherited Click
//Call the inherited click method
{Execute the ProcessExecute method and check it's return value.
If the return value is <>0 then raise an exception becuase
an error occurred.The error code is shown in the exception
}
WERetVal:=ProcessExecute(FCommandLine,SW_ShowNormal);
if WERetVal <>0 then
begin
raise Exception.Create('Error executing program.Error Code:'+IntToStr(WERetVal));
end;
end;
procedure Register;
begin
RegisterComponents('ddg', [TddgRunButton]);
RegisterPropertyEditor(TypeInfo(TCommandLine),TddgRunButton,'',TCommandLineProperty);
end;
end.
unit runbtnpe;
interface
uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,
Buttons,DsgnIntF,TypInfo;
type
{Descend from the TStringProperty class so that this editor ihherits the
string property editing capabilities}
TCommandLineProperty = class(TStringProperty)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
function GetAttributes:TPropertyAttributes;override;
procedure Edit;override;
published
{ Published declarations }
end;
implementation
function TCommandLineProperty.GetAttributes:TPropertyAttributes;
begin
Result:=[paDialog]
//Display a dialog in the Edit method
end;
procedure TCommandLineProperty.Edit;
{The Edit method displays a TOpenDialog from which the user obtains
an executable file name that gets assigned to the property}
var
OpenDialog:TOpenDialog;
begin
{Create the TOpenDialog}
OpenDialog:=TOpenDialog.Create(Application);
try
OpenDialog.Filter:='Executable Files|*.EXE';
{If the user selects a file,then assign it to the property.}
if OpenDialog.Execute then
SetStrValue(OpenDialog.FileName);
finally
OpenDialog.Free
//Free the TOpenDialog instance
end;
end;
end.
