300大洋,请高手帮忙看看这个控件为什么不能正常工作??

Description of your first forum.

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子www » 星期一, 2002年8月5日 01:02


这个控件实现IE地址栏的功能,可是不知道为什么在上面用鼠标乱点几下就会
使程序失去相应(次数不定,有时点好多次都没事,有时点一下就死),请高手帮忙!!


unit IEAddress;

interface

uses
 Registry, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ActiveX, shellapi, shlobj, ImgList, filectrl, urlmon;

const
 SHACF_DEFAULT = $00000000; // Currently (SHACF_FILESYSTEM | SHACF_URLALL)
 SHACF_FILESYSTEM = $00000001; // This includes the File System as well as the rest of the shell (Desktop\My Computer\Control Panel\)
 SHACF_URLHISTORY = $00000002; // URLs in the User's History
 SHACF_URLMRU = $00000004; // URLs in the User's Recently Used list.
 SHACF_URLALL = (SHACF_URLHISTORY + SHACF_URLMRU);
 SHACF_AUTOSUGGEST_FORCE_ON = $10000000; // Ignore the registry default and force the feature on.
 SHACF_AUTOSUGGEST_FORCE_OFF = $20000000; // Ignore the registry default and force the feature off.
 SHACF_AUTOAPPEND_FORCE_ON = $40000000; // Ignore the registry default and force the feature on. (Also know as AutoComplete)
 SHACF_AUTOAPPEND_FORCE_OFF = $80000000; // Ignore the registry default and force the feature off. (Also know as AutoComplete)


type

 TFileOption = (FileSystem, UrlHistory, UrlMRU);
 TFileOptions = set of TFileOption;

 TAutoComplete = (acDefault, acForceOn, acForceOff);
 TAutoSuggest = (asDefault, asForceOn, asForceOff);

 TOnUrlSelectedEvent = procedure(Sender : TObject; Url: string) of object;

 TCustomIEAddress = class(TCustomComboBox)
 private
   FIconLeft,
   FIconTop        : Integer;
   FDefaultProtocol : String;
   FUrl: string;
   FRegistryUpdate: Boolean;
   FAbout: String;
   FAutoComplete: TAutoComplete;
   FAutoSuggest: TAutoSuggest;
   FFileOptions: TFileOptions;
   FOnUrlSelected: TOnUrlSelectedEvent;
   FHasBorder,
   FHasDropDown: Boolean;
   FCanvas: TControlCanvas;
   FImageList:TImageList;
   FImageSize:Integer;
   FSelImageIndex,FImageIndex:Integer;
   function GetImageIndex(aUrl:string):Integer;
   procedure SetDropDown(const Value: Boolean);
   procedure SetHasBorder(const Value: Boolean);

 protected
   procedure CalculateRGN;
   procedure Click; override;
   procedure CreateWindowHandle(const Params: TCreateParams);override;
   procedure Change;override;
   procedure GetTypedURLs;
   procedure Keydown(var Key: Word; Shift: TShiftState); override;
   procedure Loaded; override;
   procedure CreateWnd; override;
   procedure CreateParams( var  Params:  TCreateParams);  override;
   procedure SetUrl(UrlToSet: string);
   Procedure UpdateTypedUrls;
   procedure DrawItem(Index: Integer;Rect:TRect; State: TOwnerDrawState);override;
   procedure SetEdit;
   procedure WndProc(var Message : TMessage); override;

   procedure WMPaint(var Msg: TMessage); message WM_Paint;

   property AutoComplete: TAutoComplete read FAutoComplete write FAutoComplete;
   property AutoSuggest: TAutoSuggest read FAutoSuggest write FAutoSuggest;
   property DefaultProtocol : String Read FDefaultProtocol write FDefaultProtocol;
   property DropDownCount;
   property FileOptions: TFileOptions read FFileOptions write FFileOptions;
   property HasBorder   : Boolean read FHasBorder write SetHasBorder;
   property HasDropDown : Boolean read FHasDropDown write SetDropDown;
   property IconLeft : Integer read FIconLeft write FIconLeft;
   property IconTop : Integer read FIconTop write FIconTop;
   property RegistryUpdate : Boolean read FRegistryUpdate write FRegistryUpdate;
   property Url: string read FUrl write SetUrl;

   property OnUrlSelected: TOnUrlSelectedEvent read FOnUrlSelected write FOnUrlSelected;
 public
   procedure SetBounds(Left, Top, Width, Height: Integer);override;
   constructor Create(AOwner: TComponent);override;
   destructor Destroy;override;
 published
   property About: String read FAbout write FAbout;
 end;

 TIEAddress = class(TCustomIEAddress)
 public
   property URL;
 published
   property Style; //Appar
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子Nizvoo » 星期一, 2002年8月5日 01:45


顶顶。
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子zm30 » 星期二, 2002年8月6日 13:57


问题好象出在这里:
initialization
 Oleinitialize(nil);

finalization
 OleUninitialize;
你把这两句去掉看看
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子www » 星期四, 2002年8月8日 12:19


to zm30:
为什么呀??
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子zm30 » 星期四, 2002年8月8日 12:39


不知为什么,可能是DELPHI对COM的支持有问题,不过我看去掉这两句对这个构件的影响只
是下拉列表中的图标不对了,这个我想通过别的途径可以解决的吧。
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子山泉 » 星期二, 2002年8月13日 20:19


这个IEAddress还有个问题,当的的text为空是,你看看他的图标,再输入网址看看,好像也有问题

 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子ljsh2008 » 星期二, 2002年8月13日 21:08


关注
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子eski » 星期五, 2002年8月16日 15:51


可能是SetEdit中 SetWindowPos 引起 Windows Paint该控件,
而WMPaint过程中又调用SetEdit,不断重复调用WMPaint过程引起的。
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子天崖无爱 » 星期一, 2002年8月19日 15:01


关注
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子jsxjd » 星期四, 2002年8月22日 10:44


动态创建很好啊,你在窗口放了什么?
我放图象,编辑框,Memo都很好!
var
 Form1: TForm1;
 c:TCustomIEAddress;
implementation



procedure TForm1.FormCreate(Sender: TObject);
begin
 c:=TCustomIEAddress.create(self);
 c.parent:=self;
 c.width:=300;
 c.visible:=true;
end;
 
 
 

300大洋,请高手帮忙看看这个控件为什么不能正常工作??

帖子www » 星期五, 2002年9月20日 15:21


多人接受答案了。