home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXCTLREG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  15.3 KB  |  507 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit RxCtlReg;
  12.  
  13. {$I RX.INC}
  14. {$D-,L-,S-}
  15.  
  16. interface
  17.  
  18. { Register custom useful controls }
  19.  
  20. procedure Register;
  21.  
  22. implementation
  23.  
  24. {$IFDEF WIN32}
  25.  {$R *.D32}
  26. {$ELSE}
  27.  {$R *.D16}
  28. {$ENDIF}
  29.  
  30. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, {$ENDIF} Classes, SysUtils,
  31.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, TypInfo, Controls, Graphics, ExtCtrls, Tabs, Dialogs, Forms,
  32.   {$IFDEF RX_D3} DsnConst, ExtDlgs, {$ELSE} LibConst, {$ENDIF} 
  33. {$IFDEF DCS}
  34.   {$IFDEF RX_D4} ImgEdit, {$ENDIF} {$IFDEF WIN32} ImgList, {$ENDIF}
  35. {$ENDIF DCS}
  36.   {$IFDEF WIN32} RxRichEd, {$ENDIF} Menus, FiltEdit, StdCtrls, Buttons,
  37.   RxLConst, RxCtrls, RxGrids, CurrEdit, ToolEdit, HintProp, DateUtil,
  38.   PickDate, RxSplit, RxSlider, RxClock, Animate, RxCombos, RxSpin, Consts,
  39.   RxDice, RxSwitch, CheckItm, VCLUtils, RxColors, AniFile, RxGraph,
  40.   {$IFDEF USE_RX_GIF} RxGIF, GIFCtrl, {$ENDIF} RxHints, ExcptDlg, RxCConst,
  41.   FileUtil, RxDsgn;
  42.  
  43. {$IFNDEF RX_D3}
  44.  
  45. { TDateProperty }
  46.  
  47. type
  48.   TDateProperty = class(TFloatProperty)
  49.   public
  50.     function GetValue: string; override;
  51.     procedure SetValue(const Value: string); override;
  52.   end;
  53.  
  54. function TDateProperty.GetValue: string;
  55. begin
  56.   if GetFloatValue = NullDate then Result := ''
  57.   else Result := FormatDateTime(ShortDateFormat, GetFloatValue);
  58. end;
  59.  
  60. procedure TDateProperty.SetValue(const Value: string);
  61. begin
  62.   if Value = '' then SetFloatValue(NullDate)
  63.   else SetFloatValue(StrToDateFmt(ShortDateFormat, Value));
  64. end;
  65.  
  66. { TRxModalResultProperty }
  67.  
  68. type
  69.   TRxModalResultProperty = class(TModalResultProperty)
  70.   public
  71.     function GetValue: string; override;
  72.     procedure GetValues(Proc: TGetStrProc); override;
  73.     procedure SetValue(const Value: string); override;
  74.   end;
  75.  
  76. const
  77.   ModalResults: array[mrAll..mrYesToAll] of string = (
  78.     'mrAll',
  79.     'mrNoToAll',
  80.     'mrYesToAll');
  81.  
  82. function TRxModalResultProperty.GetValue: string;
  83. var
  84.   CurValue: Longint;
  85. begin
  86.   CurValue := GetOrdValue;
  87.   case CurValue of
  88.     Low(ModalResults)..High(ModalResults):
  89.       Result := ModalResults[CurValue];
  90.     else Result := inherited GetValue;
  91.   end;
  92. end;
  93.  
  94. procedure TRxModalResultProperty.GetValues(Proc: TGetStrProc);
  95. var
  96.   I: Integer;
  97. begin
  98.   inherited GetValues(Proc);
  99.   for I := Low(ModalResults) to High(ModalResults) do
  100.     Proc(ModalResults[I]);
  101. end;
  102.  
  103. procedure TRxModalResultProperty.SetValue(const Value: string);
  104. var
  105.   I: Integer;
  106. begin
  107.   if (Value <> '') then
  108.     for I := Low(ModalResults) to High(ModalResults) do
  109.       if CompareText(ModalResults[I], Value) = 0 then begin
  110.         SetOrdValue(I);
  111.         Exit;
  112.       end;
  113.   inherited SetValue(Value);
  114. end;
  115.  
  116. {$ENDIF RX_D3}
  117.  
  118. function ValueName(E: Extended): string;
  119. begin
  120.   if E = High(Integer) then Result := 'MaxInt'
  121.   else if E = Low(Integer) then Result := 'MinInt'
  122.   else if E = High(Longint) then Result := 'MaxLong'
  123.   else if E = Low(Longint) then Result := 'MinLong'
  124.   else if E = High(ShortInt) then Result := 'MaxShort'
  125.   else if E = Low(ShortInt) then Result := 'MinShort'
  126.   else if E = High(Word) then Result := 'MaxWord'
  127.   else Result := '';
  128. end;
  129.  
  130. function StrToValue(const S: string): Longint;
  131. begin
  132.   if CompareText(S, 'MaxLong') = 0 then Result := High(Longint)
  133.   else if CompareText(S, 'MinLong') = 0 then Result := Low(Longint)
  134.   else if CompareText(S, 'MaxInt') = 0 then Result := High(Integer)
  135.   else if CompareText(S, 'MinInt') = 0 then Result := Low(Integer)
  136.   else if CompareText(S, 'MaxShort') = 0 then Result := High(ShortInt)
  137.   else if CompareText(S, 'MinShort') = 0 then Result := Low(ShortInt)
  138.   else if CompareText(S, 'MaxWord') = 0 then Result := High(Word)
  139.   else Result := 0;
  140. end;
  141.  
  142. { TRxIntegerProperty }
  143.  
  144. type
  145.   TRxIntegerProperty = class(TIntegerProperty)
  146.   public
  147.     function GetValue: string; override;
  148.     procedure SetValue(const Value: string); override;
  149.   end;
  150.  
  151. function TRxIntegerProperty.GetValue: string;
  152. begin
  153.   Result := ValueName(GetOrdValue);
  154.   if Result = '' then Result := IntToStr(GetOrdValue);
  155. end;
  156.  
  157. procedure TRxIntegerProperty.SetValue(const Value: String);
  158. var
  159.   L: Longint;
  160. begin
  161.   L := StrToValue(Value);
  162.   if L = 0 then L := StrToInt(Value);
  163.   inherited SetValue(IntToStr(L));
  164. end;
  165.  
  166. { TRxFloatProperty }
  167.  
  168. type
  169.   TRxFloatProperty = class(TFloatProperty)
  170.   public
  171.     function GetValue: string; override;
  172.     procedure SetValue(const Value: string); override;
  173.   end;
  174.  
  175. function TRxFloatProperty.GetValue: string;
  176. const
  177. {$IFDEF WIN32}
  178.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  179. {$ELSE}
  180.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18);
  181. {$ENDIF}
  182. begin
  183.   Result := ValueName(GetFloatValue);
  184.   if Result = '' then
  185.     Result := FloatToStrF(GetFloatValue, ffGeneral,
  186.       Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  187. end;
  188.  
  189. procedure TRxFloatProperty.SetValue(const Value: string);
  190. var
  191.   L: Longint;
  192. begin
  193.   L := StrToValue(Value);
  194.   if L <> 0 then SetFloatValue(L)
  195.   else SetFloatValue(StrToFloat(Value));
  196. end;
  197.  
  198. { TPaintBoxEditor }
  199.  
  200. type
  201.   TPaintBoxEditor = class(TDefaultEditor)
  202.   public
  203.     procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
  204.   end;
  205.  
  206. procedure TPaintBoxEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
  207. begin
  208.   if CompareText(Prop.GetName, 'OnPaint') = 0 then begin
  209.     Prop.Edit;
  210.     Continue := False;
  211.   end
  212.   else inherited EditProperty(Prop, Continue);
  213. end;
  214.  
  215. { TAnimatedEditor }
  216.  
  217. type
  218.   TAnimatedEditor = class(TComponentEditor)
  219.   private
  220.     FContinue: Boolean;
  221.     procedure CheckEdit(const Prop: IProperty);
  222.     procedure EditImage(Image: TAnimatedImage);
  223.     procedure LoadAniFile(Image: TAnimatedImage);
  224.   public
  225.     procedure ExecuteVerb(Index: Integer); override;
  226.     function GetVerb(Index: Integer): string; override;
  227.     function GetVerbCount: Integer; override;
  228.   end;
  229.  
  230. procedure TAnimatedEditor.CheckEdit(const Prop: IProperty);
  231. begin
  232.   try
  233.     if FContinue and (CompareText(Prop.GetName, 'GLYPH') = 0) then
  234.     begin
  235.       Prop.Edit;
  236.       FContinue := False;
  237.     end;
  238.   finally
  239.     //Prop.Free;
  240.   end;
  241. end;
  242.  
  243. procedure TAnimatedEditor.EditImage(Image: TAnimatedImage);
  244. var
  245.   Components: IDesignerSelections;
  246. begin
  247.   Components := CreateSelectionList;
  248.   try
  249.     FContinue := True;
  250.     Components.Add(Component);
  251.     GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  252.   finally
  253.     //Components.Free;
  254.   end;
  255. end;
  256.  
  257. procedure TAnimatedEditor.LoadAniFile(Image: TAnimatedImage);
  258. var
  259.   Dialog: TOpenDialog;
  260.   AniCursor: TAnimatedCursorImage;
  261.   CurDir: string;
  262. begin
  263.   CurDir := GetCurrentDir;
  264.   Dialog := TOpenDialog.Create(Application);
  265.   try
  266.     with Dialog do begin
  267.       Options := [ofHideReadOnly, ofFileMustExist];
  268.       DefaultExt := 'ani';
  269.       Filter := LoadStr(srAniCurFilter);
  270.       if Execute then begin
  271.         AniCursor := TAnimatedCursorImage.Create;
  272.         try
  273.           AniCursor.LoadFromFile(FileName);
  274.           AniCursor.AssignToBitmap(Image.Glyph, clFuchsia, True,
  275.             Image.Orientation = goVertical);
  276.           Image.Interval := AniCursor.DefaultRate;
  277.           Image.TransparentColor := clFuchsia;
  278.           Designer.Modified;
  279.         finally
  280.           AniCursor.Free;
  281.         end;
  282.       end;
  283.     end;
  284.   finally
  285.     Dialog.Free;
  286.     SetCurrentDir(CurDir);
  287.   end;
  288. end;
  289.  
  290. procedure TAnimatedEditor.ExecuteVerb(Index: Integer);
  291. begin
  292.   if (Index = GetVerbCount - 1) then
  293.     LoadAniFile(TAnimatedImage(Component))
  294.   else if (Index = GetVerbCount - 2) then
  295.     EditImage(TAnimatedImage(Component))
  296.   else inherited ExecuteVerb(Index);
  297. end;
  298.  
  299. function TAnimatedEditor.GetVerb(Index: Integer): string;
  300. begin
  301.   if (Index = GetVerbCount - 1) then Result := LoadStr(srLoadAniCursor)
  302.   else if (Index = GetVerbCount - 2) then Result := LoadStr(srEditPicture)
  303.   else Result := inherited GetVerb(Index);
  304. end;
  305.  
  306. function TAnimatedEditor.GetVerbCount: Integer;
  307. begin
  308.   Result := inherited GetVerbCount + 2;
  309. end;
  310.  
  311. {$IFDEF DCS}
  312. {$IFDEF WIN32}
  313.  
  314. type
  315.   TRxImageListEditor = class(TComponentEditor)
  316.   private
  317.     procedure SaveAsBitmap(ImageList: TImageList);
  318.   public
  319.     procedure ExecuteVerb(Index: Integer); override;
  320.     function GetVerb(Index: Integer): string; override;
  321.     function GetVerbCount: Integer; override;
  322.   end;
  323.  
  324. procedure TRxImageListEditor.SaveAsBitmap(ImageList: TImageList);
  325. var
  326.   Bitmap: TBitmap;
  327.   SaveDlg: TOpenDialog;
  328.   I: Integer;
  329. begin
  330.   if ImageList.Count > 0 then begin
  331. {$IFDEF RX_D3}
  332.     SaveDlg := TSavePictureDialog.Create(Application);
  333. {$ELSE}
  334.     SaveDlg := TSaveDialog.Create(Application);
  335. {$ENDIF}
  336.     with SaveDlg do
  337.     try
  338.       Options := [ofHideReadOnly, ofOverwritePrompt];
  339.       DefaultExt := GraphicExtension(TBitmap);
  340.       Filter := GraphicFilter(TBitmap);
  341.       if Execute then begin
  342.         Bitmap := TBitmap.Create;
  343.         try
  344.           with Bitmap do begin
  345.             Width := ImageList.Width * ImageList.Count;
  346.             Height := ImageList.Height;
  347.             if ImageList.BkColor <> clNone then
  348.               Canvas.Brush.Color := ImageList.BkColor
  349.             else Canvas.Brush.Color := clWindow;
  350.             Canvas.FillRect(Bounds(0, 0, Width, Height));
  351.             for I := 0 to ImageList.Count - 1 do
  352.               ImageList.Draw(Canvas, ImageList.Width * I, 0, I);
  353. {$IFDEF RX_D3}
  354.             HandleType := bmDIB;
  355.             if PixelFormat in [pf15bit, pf16bit] then try
  356.               PixelFormat := pf24bit;
  357.             except {} end;
  358. {$ENDIF}
  359.           end;
  360.           Bitmap.SaveToFile(FileName);
  361.         finally
  362.           Bitmap.Free;
  363.         end;
  364.       end;
  365.     finally
  366.       Free;
  367.     end;
  368.   end
  369.   else Beep;
  370. end;
  371.  
  372. procedure TRxImageListEditor.ExecuteVerb(Index: Integer);
  373. begin
  374.   if Designer <> nil then
  375.     case Index of
  376.       0: if EditImageList(Component as TImageList) then Designer.Modified;
  377.       1: SaveAsBitmap(TImageList(Component));
  378.     end;
  379. end;
  380.  
  381. function TRxImageListEditor.GetVerb(Index: Integer): string;
  382. begin
  383.   case Index of
  384. {$IFDEF RX_D3}
  385.     0: Result := SImageListEditor;
  386. {$ELSE}
  387.     0: Result := LoadStr(SImageEditor);
  388. {$ENDIF}
  389.     1: Result := LoadStr(srSaveImageList);
  390.     else Result := '';
  391.   end;
  392. end;
  393.  
  394. function TRxImageListEditor.GetVerbCount: Integer;
  395. begin
  396.   Result := 2;
  397. end;
  398.  
  399. {$ENDIF WIN32}
  400. {$ENDIF DCS}
  401.  
  402. { TWeekDayProperty }
  403.  
  404. type
  405.   TWeekDayProperty = class(TEnumProperty)
  406.     function GetAttributes: TPropertyAttributes; override;
  407.   end;
  408.  
  409. function TWeekDayProperty.GetAttributes: TPropertyAttributes;
  410. begin
  411.   Result := [paMultiSelect, paValueList];
  412. end;
  413.  
  414. {$IFDEF RX_D3}
  415. resourcestring
  416.   srSamples = 'Samples';
  417. {$ENDIF}
  418.  
  419. procedure Register;
  420. const
  421. {$IFDEF RX_D3}
  422.   BaseClass: TClass = TPersistent;
  423. {$ELSE}
  424.   BaseClass: TClass = TComponent;
  425. {$ENDIF}
  426. begin
  427.   RegisterComponents(LoadStr(srRXControls), [TComboEdit, TFilenameEdit,
  428.     TDirectoryEdit, TDateEdit, TRxCalcEdit, TCurrencyEdit, TTextListBox,
  429.     TRxCheckListBox, TFontComboBox, TColorComboBox, TRxSplitter, TRxSlider,
  430.     TRxLabel, {$IFDEF WIN32} TRxRichEdit, {$ENDIF}
  431.     TRxClock, TAnimatedImage, TRxDrawGrid, TRxSpeedButton,
  432.     {$IFDEF USE_RX_GIF} TRxGIFAnimator, {$ENDIF} TRxSpinButton, TRxSpinEdit,
  433.     TRxSwitch, TRxDice]);
  434. {$IFDEF CBUILDER}
  435.  {$IFNDEF RX_V110} { C++Builder 1.0 }
  436.   RegisterComponents(ResStr(srAdditional), [TScroller]);
  437.  {$ELSE}
  438.   RegisterComponents(ResStr(srSamples), [TScroller]);
  439.  {$ENDIF}
  440. {$ELSE}
  441.   RegisterComponents(ResStr(srSamples), [TScroller]);
  442. {$ENDIF}
  443.  
  444. {$IFDEF RX_D3}
  445.   RegisterNonActiveX([TCustomComboEdit, TCustomDateEdit, TCustomNumEdit,
  446.     TFileDirEdit, TRxCustomListBox, TRxRichEdit], axrComponentOnly);
  447.   RegisterNonActiveX([TScroller], axrComponentOnly);
  448. {$ENDIF RX_D3}
  449.  
  450.   RegisterPropertyEditor(TypeInfo(TDayOfWeekName), nil, '', TWeekDayProperty);
  451. {$IFDEF RX_D3}
  452.   RegisterPropertyEditor(TypeInfo(string), TCustomNumEdit, 'Text', nil);
  453. {$ELSE}
  454.   RegisterPropertyEditor(TypeInfo(string), TCustomNumEdit, 'Text', TStringProperty);
  455. {$ENDIF}
  456.   RegisterPropertyEditor(TypeInfo(string), TFileDirEdit, 'Text', TStringProperty);
  457.   RegisterPropertyEditor(TypeInfo(string), TCustomDateEdit, 'Text', TStringProperty);
  458.   RegisterPropertyEditor(TypeInfo(string), TFileNameEdit, 'Filter', TFilterProperty);
  459.   RegisterPropertyEditor(TypeInfo(string), TFileNameEdit, 'FileName', TFilenameProperty);
  460.   RegisterPropertyEditor(TypeInfo(string), TDirectoryEdit, 'Text', TDirnameProperty);
  461.   RegisterPropertyEditor(TypeInfo(string), BaseClass, 'FolderName', TDirnameProperty);
  462.   RegisterPropertyEditor(TypeInfo(string), BaseClass, 'DirectoryName', TDirnameProperty);
  463.   RegisterPropertyEditor(TypeInfo(string), BaseClass, 'Hint', THintProperty);
  464.   RegisterPropertyEditor(TypeInfo(string), TMenuItem, 'Hint', TStringProperty);
  465.   RegisterPropertyEditor(TypeInfo(string), TCustomComboEdit, 'ButtonHint', THintProperty);
  466.   RegisterPropertyEditor(TypeInfo(TStrings), TRxCheckListBox, 'Items', TCheckItemsProperty);
  467.   RegisterPropertyEditor(TypeInfo(TControl), BaseClass, 'Gauge', TProgressControlProperty);
  468.   RegisterPropertyEditor(TypeInfo(TControl), BaseClass, 'ProgressBar', TProgressControlProperty);
  469. {$IFDEF RX_D3}
  470.   RegisterPropertyEditor(TypeInfo(Boolean), TFontComboBox, 'TrueTypeOnly', nil);
  471.   RegisterPropertyEditor(TypeInfo(TCursor), TRxSplitter, 'Cursor', nil);
  472. {$ELSE}
  473.   RegisterPropertyEditor(TypeInfo(TDateTime), TPersistent, '', TDateProperty);
  474.   RegisterPropertyEditor(TypeInfo(TModalResult), TPersistent, '', TRxModalResultProperty);
  475. {$ENDIF}
  476.  
  477.   RegisterPropertyEditor(TypeInfo(TCaption), TLabel, 'Caption', THintProperty);
  478.   RegisterPropertyEditor(TypeInfo(TCaption), TRxLabel, 'Caption', THintProperty);
  479.   RegisterPropertyEditor(TypeInfo(TCaption), TRxSpeedButton, 'Caption', THintProperty);
  480.  
  481.   RegisterPropertyEditor(TypeInfo(Integer), BaseClass, '', TRxIntegerProperty);
  482.   RegisterPropertyEditor(TypeInfo(ShortInt), BaseClass, '', TRxIntegerProperty);
  483.   RegisterPropertyEditor(TypeInfo(SmallInt), BaseClass, '', TRxIntegerProperty);
  484.   RegisterPropertyEditor(TypeInfo(Longint), BaseClass, '', TRxIntegerProperty);
  485.   RegisterPropertyEditor(TypeInfo(Word), BaseClass, '', TRxIntegerProperty);
  486.   RegisterPropertyEditor(TypeInfo(Byte), BaseClass, '', TRxIntegerProperty);
  487.   RegisterPropertyEditor(TypeInfo(Cardinal), BaseClass, '', TRxIntegerProperty);
  488.  
  489.   RegisterPropertyEditor(TypeInfo(Single), BaseClass, '', TRxFloatProperty);
  490.   RegisterPropertyEditor(TypeInfo(Double), BaseClass, '', TRxFloatProperty);
  491.   RegisterPropertyEditor(TypeInfo(Extended), BaseClass, '', TRxFloatProperty);
  492. {$IFDEF WIN32}
  493.   RegisterPropertyEditor(TypeInfo(Currency), BaseClass, '', TRxFloatProperty);
  494. {$ENDIF}
  495.  
  496.   RegisterComponentEditor(TPaintBox, TPaintBoxEditor);
  497.   RegisterComponentEditor(TAnimatedImage, TAnimatedEditor);
  498. {$IFDEF WIN32}
  499. {$IFDEF DCS}
  500.   RegisterComponentEditor(TCustomImageList, TRxImageListEditor);
  501.   RegisterComponentEditor(TImageList, TRxImageListEditor);
  502. {$ENDIF}
  503. {$ENDIF}
  504.   RegisterRxColors;
  505. end;
  506.  
  507. end.