}

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

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

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