RandomClear icon

How to replace dialog icon

RandomClear | PRO | 11/25/13 12:05:34 PM UTC | 0 ⭐ | 593 👁️ | Never ⏰ | []
Delphi |

2.02 KB

|

None

|

0 👍

/

0 👎

// EurekaLog offers you feature to use generic error icon or icon of your application for error dialogs.
// However, you may want to use some other icon for that. 
// There is no such feature in EurekaLog, but you can easily fix that with such code - see below.
// Obviously, this code replaces icon for one particular dialog type (MS Classic style). 
// If you want to alter icon for several classes (such as EurekaLog-style dialog), 
// then you have to write more your own child classes.
 
unit Unit1;
 
interface
 
// ...
 
implementation
 
uses
  EBase, ECore, EModules, EListView, EDialog, EDialogWinAPIMSClassic;
 
{$R *.dfm}
 
// To test our customization code
procedure TForm1.Button1Click(Sender: TObject);
begin
  raise Exception.Create('Error Message');
end;
 
type
  // Our child class - inheriting from standard TMSClassicDialog 
  TMSClassicDialogCustom = class(TMSClassicDialog)
  private
    FCustomIcon: HBITMAP; // our new icon
  protected 
    // Init/done:
    procedure WindowInit; override;
    procedure WindowDone; override;
    // Replacing icon drawing:
    function Paint(const ADC: HDC; const ARect: TRect): Integer; override;
  end;
 
{ TMSClassicDialogCustom }
 
procedure TMSClassicDialogCustom.WindowInit;
var
  Ico: HIcon;
begin
  inherited;
 
  Ico := LoadIcon(HInstance, 'CUSTOMICON');
  FCustomIcon := IcoToBmp(Ico, GetStockObject(WHITE_BRUSH), 32, 32);
end;
 
function TMSClassicDialogCustom.Paint(const ADC: HDC; const ARect: TRect): Integer;
begin
  Result := inherited;
  DrawBmp(ADC, FCustomIcon, MonitorLeft, MonitorTop, 32, 32);
end;
 
procedure TMSClassicDialogCustom.WindowDone;
begin
  DeleteObject(FCustomIcon);
  inherited;
end;
 
initialization
 
  if IsEurekaLogInstalled then
  begin
    // You have to register dialog before using it:
    RegisterDialogClass(TMSClassicDialogCustom);
    // Once registered - now you can use it in options:
    CurrentEurekaLogOptions.ExceptionDialogType := TMSClassicDialogCustom.ClassName;
  end;
 
end.

Comments