TColorBox的Bug～～

[王集鹄]

现象:
TColorBox::Style属性加上cbCustomColor，运行后选择Custom...跳出颜色对话框～～
选择自定义颜色中未定义的一组，将抛出异常(Delphi6、Delphi7都有)～～

function TCustomColorBox.PickCustomColor: Boolean;
var
LColor: TColor;
begin
with TColorDialog.Create(nil) do
try
LColor := ColorToRGB(TColor(Items.Objects[0]));
Color := LColor;
CustomColors.Text := Format('ColorA=%.8x', [LColor]);
Result := Execute;
if Result then
begin
Items.Objects[0] := TObject(Color); //Color值为-1
Self.Invalidate;
end;
finally
Free;
end;
end;

原因:
function TCustomComboBoxStrings.GetObject(Index: Integer): TObject;
begin
Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
if Longint(Result) = CB_ERR then //ComboBox获取Item的Data时-1正好是错误标识CB_ERR～
Error(SListIndexError, Index);
end;

[sixgj]

呵呵，一学！

[yoisyois]

...

[王集鹄]

up#

[王集鹄]

unit ufrm_main;
interface
uses
Windows, Controls, Forms,ComCtrls,Classes,StdCtrls;
type
Tfrm_main = class(TForm)
btn_backup: TButton;
ProgressBar: TProgressBar;
procedure btn_backupClick(Sender: TObject);
private
public
end;
var
frm_main: Tfrm_main;
implementation
uses SQLDMO, ComObj;
{$R *.DFM}
type
TBackupSink = class(TInterfacedObject, BackupSink)
private
function PercentComplete(const Message: WideString; Percent: Integer): HResult; stdcall;
function NextMedia(const Message: WideString): HResult; stdcall;
function Complete(const Message: WideString): HResult; stdcall;
end;

function TBackupSink.PercentComplete(const Message: WideString; Percent: Integer): HResult;
begin
frm_main.ProgressBar.Position := Percent;
Result := S_OK;
end;

function TBackupSink.NextMedia(const Message: WideString): HResult;
begin
Result := S_OK;
end;

function TBackupSink.Complete(const Message: WideString): HResult;
begin
Result := S_OK;
end;

Procedure Tfrm_main.btn_backupClick(Sender: TObject);
var
FInterfaceConnection: Integer;
Backup : Variant;
SQL_SERVER : Variant;
begin
SQL_SERVER := CreateOLEObject('SQLDMO.SQLServer');
Backup := CreateOLEObject('SQLDMO.Backup');
Backup.Action := SQLDMOBackup_Database;
Backup.Database := 'test';
Backup.BackupSetName:= 'test';

SQL_SERVER.LoginSecure := False;
// SQL_SERVER.LoginSecure := True; // Win Auth.
SQL_SERVER.login := 'login';
SQL_SERVER.password := 'heslo';
Backup.Files := 'c:\test.bak';

SQL_SERVER.Connect('(local)');

InterfaceConnect(Backup, IID_BackupSink, TBackupSink.Create, FInterfaceConnection);
Backup.SQLBackup (SQL_SERVER);
InterfaceDisconnect(Backup, IID_BackupSink, FInterfaceConnection);
ProgressBar.Position := 0;
end;

end.