Delphi.int.ru — Портал программистов

Вход Регистрация | Забыли пароль?

Просмотр кода

Идентификатор: 30d3b5ea Описание: MetaDialogs.pas Код загружен: 3 июля 2011, 17:23 (mirt.steelwater)

  1. unit MetaDialogs;
  2. {******************************************************************************}
  3. {*  Meta Dialog Window Unit                                                   *}
  4. {*  Revolutionary Confederation of Anarcho Syndicalists                       *}
  5. {*  Written by: black.rabbit 2011                                             *}
  6. {******************************************************************************}
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  11.   Dialogs, StdCtrls, ExtCtrls, Buttons, ImgList,
  12.   acPNG,
  13.   sSkinProvider, sSkinManager,
  14.   sPanel, sButton, sBitBtn, acAlphaImageList,
  15.   { kernel units }
  16.   VarRecs, EClasses;
  17.  
  18. { иконки }
  19. const
  20.     dlgCustom       = -1;
  21.     dlgWarning      = 0;
  22.     dlgError        = 1;
  23.     dlgInformation  = 2;
  24.     dlgConfirmation = 3;
  25.     dlgHelp         = 4;
  26.     dlgLogin        = 5;
  27.     dlgPassword     = 6;
  28.     dlgRandom       = 7;
  29.     dlgSettings     = 8;
  30.     dlgAdd          = 9;
  31.     dlgEdit         = 10;
  32.     dlgDelete       = 11;
  33.  
  34. { кнопки }
  35. const
  36.     bntCustom       = -1;
  37.     btnOK           = 0;
  38.     btnCancel       = 1;
  39.  
  40. type
  41. { кнопка диалогового окна }
  42. {$M+}
  43.     EDialogButton = class (EClass) end;
  44.     CDialogButton = class of TDialogButton;
  45.     PDialogButton = ^TDialogButton;
  46.     TDialogButton = class (TsBitBtn)
  47.     private
  48.         f_ModalResult: Integer;
  49.     public
  50.         class procedure _raise (anArgs: array of const;
  51.                                 const anEGUID: String = ''); overload; virtual;
  52.         class procedure _raise (anArgs: array of const;
  53.                                 anEGUID: array of const); overload; virtual;
  54.     public
  55.         constructor Create (anOwner: TComponent;
  56.                             aCaption: String = '';
  57.                             anImageList: TCustomImageList = NIL;
  58.                             anImageIndex: Integer = dlgCustom;
  59.                             aModalResult: Integer = mrNone;
  60.                             anOnClick: TNotifyEvent = NIL); overload; virtual;
  61.         constructor Create (anOwner: TComponent;
  62.                             anArgs: array of const;
  63.                             anImageList: TCustomImageList = NIL;
  64.                             anOnClick: TNotifyEvent = NIL); overload; virtual;
  65.         destructor Destroy; override;
  66.     public
  67.         property ModalResult: Integer read f_ModalResult write f_ModalResult;
  68.     end;
  69. {$M-}
  70.  
  71. resourcestring
  72.     ERR_TDIALOGBUTTON_CREATE  = 'Ошибка создания!';
  73.     ERR_TDIALOGBUTTON_DESTROY = 'Ошибка уничтожения!';
  74.  
  75. type
  76. { диалоговое окно }
  77. {$M+}
  78.     EMetaDialog = class (EClass) end;
  79.     CMetaDialog = class of TMetaDialog;
  80.     PMetaDialog = ^TMetaDialog;
  81.     TMetaDialog = class (TForm)
  82.         SkinBlack: TsSkinManager;
  83.         SkinProvider: TsSkinProvider;
  84.         pnlBack: TsPanel;
  85.         imgIcon: TImage;
  86.         imgIcons: TsAlphaImageList;
  87.         pnlControl: TsPanel;
  88.         imgButtons: TsAlphaImageList;
  89.     private
  90.         f_MinWidth: Integer;
  91.         f_MaxWidth: Integer;
  92.         f_MinHeight: Integer;
  93.         f_MaxHeight: Integer;
  94.         f_IconIndex: Integer;
  95.         f_Buttons: TList;
  96.     public
  97.         class procedure _raise (anArgs: array of const;
  98.                                 const anEGUID: String = ''); overload; virtual;
  99.         class procedure _raise (anArgs: array of const;
  100.                                 anEGUID: array of const); overload; virtual;
  101.     protected
  102.         procedure WMGetMinMaxInfo (var M: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  103.         procedure OnButtonClick (Sender: TObject); virtual;
  104.     public
  105.         procedure GetData (anArgs: array of const;
  106.                            aButtons: array of const); overload; virtual;
  107.         procedure SetData (anIndex: Integer); overload; virtual;
  108.     public
  109.         constructor Create (anArgs: array of const;
  110.                             aButtons: array of const); virtual;
  111.         destructor Destroy; override;
  112.         class function Open (anArgs: array of const;
  113.                              aButtons: array of const) : Integer; overload; virtual;
  114.     public
  115.         property minWidth: Integer read f_MinWidth write f_MinWidth;
  116.         property maxWidth: Integer read f_MaxWidth write f_MaxWidth;
  117.         property minHeight: Integer read f_MinHeight write f_MinHeight;
  118.         property maxHeight: Integer read f_MaxHeight write f_MaxHeight;
  119.         property IconIndex: Integer read f_IconIndex write f_IconIndex;
  120.     end;
  121. {$M-}
  122.  
  123. resourcestring
  124.     ERR_TMETADIALOG_CREATE   = 'Ошибка создания!';
  125.     ERR_TMETADIALOG_DESTROY  = 'Ошибка уничтожения!';
  126.  
  127.     ERR_TMETADIALOG_NOTIFY   = 'Ошибка обработки события!';
  128.     ERR_TMETADIALOG_RESIZE   = 'Ошибка изменения размера!';
  129.  
  130.     ERR_TMETADIALOG_GET_DATA = 'Ошибка чтения данных!';
  131.     ERR_TMETADIALOG_SET_DATA = 'Ошибка записи данных!';
  132.  
  133. implementation
  134.  
  135. {$R *.dfm}
  136.  
  137. class procedure TDialogButton._raise (anArgs: array of const;
  138.                                       const anEGUID: String = '');
  139. begin
  140.     raise EDialogButton.Create ( _([self],anArgs), anEGUID );
  141. end;
  142.  
  143. class procedure TDialogButton._raise (anArgs: array of const;
  144.                                       anEGUID: array of const);
  145. begin
  146.     raise EDialogButton.Create ( _([self],anArgs), anEGUID );
  147. end;
  148.  
  149. constructor TDialogButton.Create (anOwner: TComponent;
  150.                                   aCaption: String = '';
  151.                                   anImageList: TCustomImageList = NIL;
  152.                                   anImageIndex: Integer = dlgCustom;
  153.                                   aModalResult: Integer = mrNone;
  154.                                   anOnClick: TNotifyEvent = NIL);
  155. begin
  156.     try
  157.         inherited Create (anOwner);
  158.         Parent := TWinControl (Owner);
  159.         Caption := aCaption;
  160.         Width := Round ( Length (Caption) * Font.Size + 24 );
  161.         Align := alRight;
  162.         AlignWithMargins := TRUE;
  163.         Margins.Bottom := 5;
  164.         Margins.Left := 5;
  165.         Margins.Right := 5;
  166.         Margins.Top := 5;
  167.         Images := anImageList;
  168.         ImageIndex := ImageIndex;
  169.         if Assigned (Images) then
  170.             Width := Width + Images.Width;
  171.         ModalResult := aModalResult;
  172.         OnClick := anOnClick;
  173.     except on E: Exception do
  174.         _raise (['Create',ERR_TDIALOGBUTTON_CREATE,E],
  175.                 ['{366A0B63-4F7A-46D3-8E91-0A0714376342}']);
  176.     end;
  177. end;
  178.  
  179. constructor TDialogButton.Create (anOwner: TComponent;
  180.                                   anArgs: array of const;
  181.                                   anImageList: TCustomImageList = NIL;
  182.                                   anOnClick: TNotifyEvent = NIL);
  183. begin
  184.     try
  185.         Create (anOwner,'',anImageList,dlgCustom,mrNone,anOnClick);
  186.         { первый параметр - заголовок }
  187.         if notEmpty (0,anArgs) then
  188.             Caption := toString (anArgs [0]);
  189.         Width := Round ( Length (Caption) * Font.Size + 24 );
  190.         if Assigned (Images) then
  191.             Width := Width + Images.Width;
  192.         { второй параметр - иконка }
  193.         if notEmpty (1,anArgs) then
  194.             ImageIndex := toInteger (anArgs [1]);
  195.         { третий параметр - результат }
  196.         ModalResult := mrNone;
  197.         if notEmpty (2,anArgs) then
  198.             ModalResult := toInteger (anArgs [2]);
  199.     except on E: Exception do
  200.         _raise (['Create',ERR_TDIALOGBUTTON_CREATE,E],
  201.                 ['{F28E1C8D-DA29-4BA3-9004-473FA018C3B8}']);
  202.     end;
  203. end;
  204.  
  205. destructor TDialogButton.Destroy;
  206. begin
  207.     try
  208.         inherited Destroy;
  209.     except on E: Exception do
  210.         _raise (['Destroy',ERR_TDIALOGBUTTON_DESTROY,E],
  211.                 ['{BC9F7330-7CA8-41F6-BA1E-541B1F440F9C}']);
  212.     end;
  213. end;
  214.  
  215. class procedure TMetaDialog._raise (anArgs: array of const;
  216.                                     const anEGUID: String = '');
  217. begin
  218.     raise EMetaDialog.Create ( _([self],anArgs), anEGUID );
  219. end;
  220.  
  221. class procedure TMetaDialog._raise (anArgs: array of const;
  222.                                     anEGUID: array of const);
  223. begin
  224.     raise EMetaDialog.Create ( _([self],anArgs), anEGUID );
  225. end;
  226.  
  227. procedure TMetaDialog.WMGetMinMaxInfo (var M: TWMGetMinMaxInfo);
  228. begin
  229.     try
  230.         with M.MinMaxInfo^ do
  231.         begin
  232.             PTMaxSize.X := maxWidth;
  233.             PTMaxPosition.X := 0;
  234.             PTMaxTrackSize.X := maxWidth;
  235.             PTMinTrackSize.X := minWidth;
  236.             PTMaxSize.Y := maxHeight;
  237.             PTMaxPosition.Y := 0;
  238.             PTMaxTrackSize.Y := maxHeight;
  239.             PTMinTrackSize.Y := minHeight;
  240.         end;
  241.     except on E: Exception do
  242.         _raise (['WMGetMinMaxInfo',ERR_TMETADIALOG_RESIZE,E],
  243.                 ['{A2DEF069-797D-472F-9F6B-05E35EAED098}']);
  244.     end;
  245. end;
  246.  
  247. procedure TMetaDialog.OnButtonClick (Sender: TObject);
  248. begin
  249.     try
  250.         SetData ( TDialogButton (Sender).ModalResult );
  251.     except on E: Exception do
  252.         _raise (['OnButtonClick',ERR_TMETADIALOG_NOTIFY,E],
  253.                 ['{C0EC7356-493B-40EA-B5B3-28BEB743402C}']);
  254.     end;
  255. end;
  256.  
  257. procedure TMetaDialog.GetData (anArgs: array of const;
  258.                                aButtons: array of const);
  259. var
  260.     I      : Integer;
  261.     Button : TDialogButton;
  262. begin
  263.     try
  264.         { первый параметр - заголовок }
  265.         if not isEmpty (0,anArgs) then
  266.             Caption := toString (anArgs [0]);
  267.         { второй параметр - иконка }
  268.         if not isEmpty (1,anArgs) then
  269.         begin
  270.             IconIndex := toInteger (anArgs [1]);
  271.             if ( IconIndex > dlgCustom ) then
  272.                 imgIcons.GetBitmap32 (IconIndex, imgIcon.Picture.Bitmap);
  273.         end;
  274.         { остальные параметры - кнопки }
  275.         for I := 0 to High (aButtons) do
  276.             if not isEmpty (I,aButtons) then
  277.             begin
  278.                 Button := TDialogButton.Create( pnlControl,
  279.                                                 toArrayOfConst (aButtons [I]),
  280.                                                 imgButtons,
  281.                                                 OnButtonClick );
  282.                 f_Buttons.Add (Button);
  283.             end;
  284.     except on E: Exception do
  285.         _raise (['GetData',ERR_TMETADIALOG_GET_DATA,E],
  286.                 ['{879F7E53-19B5-4EC1-B9B0-B1BA90BAAFA1}']);
  287.     end;
  288. end;
  289.  
  290. procedure TMetaDialog.SetData (anIndex: Integer);
  291. begin
  292.     try
  293.         case anIndex of
  294.             mrNone : { do nothing };
  295.             else     ModalResult := anIndex;
  296.         end;
  297.     except on E: Exception do
  298.         _raise (['SetData',ERR_TMETADIALOG_SET_DATA,E],
  299.                 ['{03635422-DA19-4900-8573-3180F3C5560D}']);
  300.     end;
  301. end;
  302.  
  303. constructor TMetaDialog.Create (anArgs: array of const;
  304.                                 aButtons: array of const);
  305. begin
  306.     try
  307.         inherited Create (NIL);
  308.  
  309.         minWidth := 400;
  310.         maxWidth := Screen.Width;
  311.         minHeight := 200;
  312.         maxHeight := Screen.Height;
  313.         Left := (Screen.Width - Width) div 2;
  314.         Top := (Screen.Height - Height) div 2;
  315.         Caption := '';
  316.         IconIndex := dlgCustom;
  317.         f_Buttons := TList.Create;
  318.     except on E: Exception do
  319.         _raise (['Create',ERR_TMETADIALOG_CREATE,E],
  320.                 ['{17AE0EBC-7DA6-45E1-B0A4-37462556EBAF}']);
  321.     end;
  322. end;
  323.  
  324. destructor TMetaDialog.Destroy;
  325. var
  326.     I : Integer;
  327. begin
  328.     try
  329.         for I := 0 to f_Buttons.Count - 1 do
  330.             TDialogButton (f_Buttons.Items [I]).Free;
  331.         f_Buttons.Clear;
  332.         FreeAndNil (f_Buttons);
  333.  
  334.         inherited Destroy;
  335.     except on E: Exception do
  336.         _raise (['Destroy',ERR_TMETADIALOG_DESTROY,E],
  337.                 ['{1AE3B7BF-E68A-4D0F-9FB3-024FDA4B6741}']);
  338.     end;
  339. end;
  340.  
  341. class function TMetaDialog.Open (anArgs: array of const;
  342.                                  aButtons: array of const) : Integer;
  343. begin
  344.     with Create (anArgs,aButtons) do
  345.     try
  346.         GetData (anArgs,aButtons);
  347.         Result := ShowModal;
  348.     finally
  349.         Free;
  350.     end;
  351. end;
  352.  
  353. end.

Ссылка на данный код:

На главную страницу сервиса обмена кодом »