home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / rxdsgn.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  4KB  |  164 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1998 Master-Bank                }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxDsgn;
  10.  
  11. {$I RX.INC}
  12.  
  13. interface
  14.  
  15. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, {$ENDIF} Classes, SysUtils,
  16.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, Controls, Graphics, ExtCtrls, Menus, Forms;
  17.  
  18. type
  19. {$IFNDEF RX_D4}
  20.   IDesigner = TDesigner;
  21.   IFormDesigner = TFormDesigner;
  22. {$ENDIF}
  23.  
  24.  
  25. { TFilenameProperty }
  26.  
  27.   TFilenameProperty = class(TStringProperty)
  28.   protected
  29.     function GetFilter: string; virtual;
  30.   public
  31.     procedure Edit; override;
  32.     function GetAttributes: TPropertyAttributes; override;
  33.   end;
  34.  
  35. { TDirnameProperty }
  36.  
  37.   TDirnameProperty = class(TStringProperty)
  38.   public
  39.     procedure Edit; override;
  40.     function GetAttributes: TPropertyAttributes; override;
  41.   end;
  42.  
  43. { TProgressControlProperty }
  44.  
  45.   TProgressControlProperty = class(TComponentProperty)
  46.   private
  47.     FProc: TGetStrProc;
  48.     procedure CheckComponent(const AName: string);
  49.   public
  50.     procedure GetValues(Proc: TGetStrProc); override;
  51.   end;
  52.  
  53. { TRxDBStringProperty }
  54.  
  55.   TRxDBStringProperty = class(TStringProperty)
  56.   public
  57.     function GetAttributes: TPropertyAttributes; override;
  58.     procedure GetValueList(List: TStrings); virtual;
  59.     procedure GetValues(Proc: TGetStrProc); override;
  60.   end;
  61.  
  62. implementation
  63.  
  64. uses Consts, Dialogs, RxCConst, FileUtil, VclUtils, RxPrgrss;
  65.  
  66. { TFilenameProperty }
  67.  
  68. function TFilenameProperty.GetFilter: string;
  69. begin
  70.   Result := LoadStr(SDefaultFilter);
  71. end;
  72.  
  73. procedure TFilenameProperty.Edit;
  74. var
  75.   FileOpen: TOpenDialog;
  76. begin
  77.   FileOpen := TOpenDialog.Create(Application);
  78.   try
  79.     FileOpen.Filename := GetValue;
  80.     FileOpen.InitialDir := ExtractFilePath(FileOpen.Filename);
  81.     if (ExtractFileName(FileOpen.Filename) = '') or not
  82.       ValidFileName(ExtractFileName(FileOpen.Filename)) then
  83.       FileOpen.Filename := '';
  84.     FileOpen.Filter := GetFilter;
  85.     FileOpen.Options := FileOpen.Options + [ofHideReadOnly];
  86.     if FileOpen.Execute then SetValue(FileOpen.Filename);
  87.   finally
  88.     FileOpen.Free;
  89.   end;
  90. end;
  91.  
  92. function TFilenameProperty.GetAttributes: TPropertyAttributes;
  93. begin
  94.   Result := [paDialog {$IFDEF WIN32}, paRevertable {$ENDIF}];
  95. end;
  96.  
  97. { TDirnameProperty }
  98.  
  99. procedure TDirnameProperty.Edit;
  100. var
  101.   FolderName: string;
  102. begin
  103.   FolderName := GetValue;
  104.   if BrowseDirectory(FolderName, ResStr(SSelectDirCap), 0) then
  105.     SetValue(FolderName);
  106. end;
  107.  
  108. function TDirnameProperty.GetAttributes: TPropertyAttributes;
  109. begin
  110.   Result := [paDialog {$IFDEF WIN32}, paRevertable {$ENDIF}];
  111. end;
  112.  
  113. { TProgressControlProperty }
  114.  
  115. procedure TProgressControlProperty.CheckComponent(const AName: string);
  116. var
  117.   Component: TComponent;
  118. begin
  119. {$IFDEF WIN32}
  120.   Component := Designer.GetComponent(AName);
  121. {$ELSE}
  122.   Component := Designer.Form.FindComponent(AName);
  123. {$ENDIF}
  124.   if (Component <> nil) and (Component is TControl) and
  125.     SupportsProgressControl(TControl(Component)) and Assigned(FProc) then
  126.     FProc(AName);
  127. end;
  128.  
  129. procedure TProgressControlProperty.GetValues(Proc: TGetStrProc);
  130. begin
  131.   FProc := Proc;
  132.   try
  133.     inherited GetValues(CheckComponent);
  134.   finally
  135.     FProc := nil;
  136.   end;
  137. end;
  138.  
  139. { TRxDBStringProperty }
  140.  
  141. function TRxDBStringProperty.GetAttributes: TPropertyAttributes;
  142. begin
  143.   Result := [paValueList, paSortList, paMultiSelect];
  144. end;
  145.  
  146. procedure TRxDBStringProperty.GetValues(Proc: TGetStrProc);
  147. var
  148.   I: Integer;
  149.   Values: TStringList;
  150. begin
  151.   Values := TStringList.Create;
  152.   try
  153.     GetValueList(Values);
  154.     for I := 0 to Values.Count - 1 do Proc(Values[I]);
  155.   finally
  156.     Values.Free;
  157.   end;
  158. end;
  159.  
  160. procedure TRxDBStringProperty.GetValueList(List: TStrings);
  161. begin
  162. end;
  163.  
  164. end.