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