Mega Code Archive

 
Categories / Delphi / System
 

Add Link to MsgBox (Updated)

Title: Add Link to MsgBox (Updated) Question: How to add Link in MsgBox? Answer: if the not create msg boxses link or Link Componenttes not Found? this now is EASY! LinkedMsgBox component is add link in MsgBox Qualities: Set style to win32/win31 style Allow set on/off internet link type Allow change buttons caption Allow dislabe/enable button(s) Allow hide/show buttons and create customized MsgBox ... Source: unit LinkedMsgBox; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellApi, StdCtrls, ExtCtrls; type TDlgStyle = (dsWinInstaller, dsNormal); TNotifyEvent = procedure(Sender: TObject) of object; TLinkedMsgBox = class(TControl) private FLink: TNotifyEvent; FPage: String; FMsg: String; FType: TMsgDlgType; FButtons: TMsgDlgButtons; FTitle: String; aMsgDlg: TForm; FClose: Boolean; FInternetLink: Boolean; FO: Boolean; FC: Boolean; FWF: Boolean; FP: Boolean; FOCap: String; FCap: String; Fekea: Boolean; DES: Cardinal; Timer: TTimer; FStyle: TDlgStyle; FVO: Boolean; FVC: Boolean; procedure TimerCloser(Sender: TObject); procedure SetGray(Value: Boolean); procedure HandleLink(Sender: TObject); procedure SetStyle(Value: TDlgStyle); function MyMessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; protected // public // published property InternetLink: Boolean read FInternetLink write FInternetLink; property OnLinkClicked: TNotifyEvent read FLink write FLink; property LPage: string read FPage write FPage; property Msg: String read FMsg write FMsg; property GrayOk: Boolean read FO write FO; property GrayCancel: Boolean read FC write FC; property HideOk: Boolean read FVO write FVO; property HideCancel: Boolean read FVC write FVC; property OkButtonCaption: String read FOCap write FOCap; property CancelButtonCaption: String read FCap write FCap; property MsgBoxType: TMsgDlgType read FType write FType; property MsgBoxButtons: TMsgDlgButtons read FButtons write FButtons; property Caption: String read FTitle write FTitle; property CloseBox: Boolean read FClose write FClose; property Win31Style: Boolean read FWF write FWF; property GrayCloseButton: Boolean read FP write FP; property CloseOnTimer: Boolean read Fekea write Fekea; property TimerIntervinial: Cardinal read DES write DES default 5000; property DlgStyle: TDlgStyle read FStyle write FStyle; function Exec: Integer; end; procedure Register; implementation procedure Register; begin RegisterComponents('Artun oma komponetit', [TLinkedMsgBox]); end; procedure TLinkedMsgBox.HandleLink(Sender: TObject); begin TLabel(aMsgDlg.Components[1]).Font.Color:=clOlive; if Assigned(FLink) then begin FLink(Self) end; if FInternetLink = True then begin ShellApi.ShellExecute(0, nil, PChar(FPage), '', nil, SW_SHOWNORMAL); end; if FClose = True then aMsgDlg.Close end; function TLinkedMsgBox.MyMessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; var i: Integer; dlgButton: TButton; begin { Create the Dialog } { Dialog erzeugen } aMsgDlg := CreateMessageDialog(Msg, DlgType, Buttons); SetGray(FP); TLabel(aMsgDlg.Components[1]).Font.Style:=[fsUnderline]; TLabel(aMsgDlg.Components[1]).OnClick:=HandleLink; TLabel(aMsgDlg.Components[1]).Cursor:=crHandPoint; TLabel(aMsgDlg.Components[1]).Font.Color:=clBlue; SetStyle(FStyle); Timer:=TTimer.Create(Application); Timer.Interval:=Des; Timer.Enabled:=Fekea; Timer.OnTimer:=TimerCloser; if FWF = True then begin TLabel(aMsgDlg.Components[1]).Font.Style:=[fsUnderline, fsBold]; for i := 0 to aMsgDlg.ComponentCount - 1 do begin { If the object is of type TButton, then } { Wenn es ein Button ist, dann...} if (aMsgDlg.Components[i] is TButton) then begin dlgButton := TButton(aMsgDlg.Components[i]); dlgButton.Font.Style:=[fsBold]; end; end; end; if (mbOk in MsgBoxButtons) then begin TButton(aMsgDlg.Components[2]).Caption:=FOCap; if FO then TButton(aMsgDlg.Components[2]).Enabled:=False; if FVO then TButton(aMsgDlg.Components[2]).Visible:=False; end; if (mbCancel in MsgBoxButtons) then begin TButton(aMsgDlg.Components[3]).Caption:=FCap; if FC then TButton(aMsgDlg.Components[3]).Enabled:=False; if FVC then TButton(aMsgDlg.Components[3]).Visible:=False; end; aMsgDlg.Caption:=Caption; Result := aMsgDlg.ShowModal; end; function TLinkedMsgBox.Exec: Integer; begin Result:=MyMessageDialog(Msg, MsgBoxType, MsgBoxButtons); end; procedure TLinkedMsgBox.SetGray(Value: Boolean); begin if Value = True then EnableMenuItem(GetSystemMenu(aMsgDlg.Handle, False), SC_CLOSE, MF_BYCOMMAND or MF_GRAYED) else EnableMenuItem(GetSystemMenu(aMsgDlg.Handle, False), SC_CLOSE, MF_BYCOMMAND or MF_ENABLED) end; procedure TLinkedMsgBox.TimerCloser(Sender: TObject); begin aMsgDlg.Close; Timer.Destroy end; procedure TLinkedMsgBox.SetStyle(Value: TDlgStyle); begin if Value = dsWinInstaller then begin aMsgDlg.Font.Name:='Tahoma'; TLabel(aMsgDlg.Components[1]).Font.Name:='Tahoma' end else aMsgDlg.Font.Name:='MS Sans Serif'; TLabel(aMsgDlg.Components[1]).Font.Name:='MS Sans Serif' end; end.//Warning, only private use!