home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / ICOLEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  10KB  |  407 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi VCL Extensions (RX)                      }
  4. {                                                       }
  5. {       Copyright (c) 1997 Master-Bank                  }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit IcoLEdit;
  10.  
  11. {$I RX.INC}
  12.  
  13. interface
  14.  
  15. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  16.   Messages, Classes, Graphics, Forms, Controls, Dialogs, Buttons, IcoList,
  17.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, StdCtrls, ExtCtrls, Placemnt, {$IFDEF RX_D3} ExtDlgs, {$ELSE}
  18.   ImagPrvw, {$ENDIF} Menus, SpeedBar;
  19.  
  20. type
  21.  
  22. { TIconListDialog }
  23.  
  24.   TIconListDialog = class(TForm)
  25.     OK: TButton;
  26.     Cancel: TButton;
  27.     Holder: TPanel;
  28.     Slot0: TPanel;
  29.     Slot1: TPanel;
  30.     Slot2: TPanel;
  31.     Slot3: TPanel;
  32.     Slot4: TPanel;
  33.     Image0: TImage;
  34.     Image1: TImage;
  35.     Image2: TImage;
  36.     Image3: TImage;
  37.     Image4: TImage;
  38.     Bevel1: TBevel;
  39.     Label1: TLabel;
  40.     CntLabel: TLabel;
  41.     Label3: TLabel;
  42.     IdxLabel: TLabel;
  43.     SpeedBar: TSpeedBar;
  44.     Load: TSpeedItem;
  45.     LoadAni: TSpeedItem;
  46.     Delete: TSpeedItem;
  47.     Clear: TSpeedItem;
  48.     Copy: TSpeedItem;
  49.     Paste: TSpeedItem;
  50.     ScrollBar: TScrollBar;
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure FormDestroy(Sender: TObject);
  53.     procedure LoadClick(Sender: TObject);
  54.     procedure ClearClick(Sender: TObject);
  55.     procedure CopyClick(Sender: TObject);
  56.     procedure PasteClick(Sender: TObject);
  57.     procedure UpdateClipboard(Sender: TObject);
  58.     procedure ScrollBarChange(Sender: TObject);
  59.     procedure DeleteClick(Sender: TObject);
  60.     procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
  61.       Shift: TShiftState; X, Y: Integer);
  62.     procedure LoadAniClick(Sender: TObject);
  63.   private
  64.     Icons: TIconList;
  65.     FTopIndex, FSelected: Integer;
  66. {$IFDEF RX_D3}
  67.     FileDialog: TOpenPictureDialog;
  68. {$ELSE}
  69.     FileDialog: TOpenDialog;
  70. {$ENDIF}
  71.     procedure SetSelectedIndex(Index: Integer; Force: Boolean);
  72.     procedure ListChanged(Sender: TObject);
  73.     function GetSelectedIcon: TIcon;
  74.     procedure CheckButtons;
  75.     procedure ValidateImage;
  76.     procedure CheckEnablePaste;
  77.     procedure LoadAniFile;
  78.     procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
  79.   public
  80.     Modified: Boolean;
  81.   end;
  82.  
  83. { TIconListProperty }
  84.  
  85.   TIconListProperty = class(TClassProperty)
  86.   public
  87.     procedure Edit; override;
  88.     function GetAttributes: TPropertyAttributes; override;
  89.     function GetValue: string; override;
  90.     procedure SetValue(const Value: string); override;
  91.   end;
  92.  
  93. procedure EditIconList(IconList: TIconList);
  94.  
  95. implementation
  96.  
  97. uses TypInfo, SysUtils, Clipbrd, Consts, ClipIcon, VCLUtils, AppUtils,
  98.   RxConst, RxLConst, MaxMin, AniFile;
  99.  
  100. {$B-}
  101. {$IFDEF WIN32}
  102.  {$D-}
  103. {$ENDIF}
  104.  
  105. {$R *.DFM}
  106.  
  107. const
  108.   sSlot = 'Slot%d';
  109.   sImage = 'Image%d';
  110.  
  111. procedure EditIconList(IconList: TIconList);
  112. begin
  113.   with TIconListDialog.Create(Application) do
  114.   try
  115.     Icons.Assign(IconList);
  116.     Modified := False;
  117.     if (ShowModal = mrOk) and Modified then
  118.       IconList.Assign(Icons);
  119.   finally
  120.     Free;
  121.   end;
  122. end;
  123.  
  124. { TIconListProperty }
  125.  
  126. procedure TIconListProperty.Edit;
  127. var
  128.   Editor: TIconListDialog;
  129.   Comp: TPersistent;
  130.   CurDir: string;
  131.   Res: Integer;
  132. begin
  133.   Editor := TIconListDialog.Create(nil);
  134.   try
  135.     Comp := GetComponent(0);
  136.     if Comp is TComponent then
  137.       Editor.Caption := TComponent(Comp).Name + '.' + GetName;
  138.     Editor.Icons.Assign(TIconList(Pointer(GetOrdValue)));
  139.     Editor.Modified := False;
  140.     CurDir := GetCurrentDir;
  141.     try
  142.       Res := Editor.ShowModal;
  143.     finally
  144.       SetCurrentDir(CurDir);
  145.     end;
  146.     if (Res = mrOk) and Editor.Modified then begin
  147.       TIconList(Pointer(GetOrdValue)).Assign(Editor.Icons);
  148.       Designer.Modified;
  149.     end;
  150.   finally
  151.     Editor.Free;
  152.   end;
  153. end;
  154.  
  155. function TIconListProperty.GetAttributes: TPropertyAttributes;
  156. begin
  157.   Result := [paDialog];
  158. end;
  159.  
  160. function TIconListProperty.GetValue: string;
  161. var
  162.   List: TIconList;
  163. begin
  164.   List := TIconList(Pointer(GetOrdValue));
  165.   if (List = nil) or (List.Count = 0) then
  166.     Result := ResStr(srNone)
  167.   else Result := '(' + List.ClassName + ')';
  168. end;
  169.  
  170. procedure TIconListProperty.SetValue(const Value: string);
  171. begin
  172.   if Value = '' then SetOrdValue(0);
  173. end;
  174.  
  175. { TIconListDialog }
  176.  
  177. procedure TIconListDialog.LoadAniFile;
  178. var
  179.   Dialog: TOpenDialog;
  180.   AniCursor: TAnimatedCursorImage;
  181. begin
  182.   Dialog := TOpenDialog.Create(Application);
  183.   try
  184.     with Dialog do begin
  185.       Options := [ofHideReadOnly, ofFileMustExist];
  186.       DefaultExt := 'ani';
  187.       Filter := LoadStr(srAniCurFilter);
  188.       if Execute then begin
  189.         AniCursor := TAnimatedCursorImage.Create;
  190.         try
  191.           AniCursor.LoadFromFile(FileName);
  192.           Icons.Assign(AniCursor);
  193.         finally
  194.           AniCursor.Free;
  195.         end;
  196.       end;
  197.     end;
  198.   finally
  199.     Dialog.Free;
  200.   end;
  201. end;
  202.  
  203. function TIconListDialog.GetSelectedIcon: TIcon;
  204. begin
  205.   Result := nil;
  206.   if (Icons.Count > 0) and (FSelected < Icons.Count) then
  207.     Result := Icons[FSelected];
  208. end;
  209.  
  210. procedure TIconListDialog.CheckEnablePaste;
  211. begin
  212.   Paste.Enabled := Clipboard.HasFormat(CF_ICON);
  213. end;
  214.  
  215. procedure TIconListDialog.SetSelectedIndex(Index: Integer; Force: Boolean);
  216. begin
  217.   if Force or (Index <> FSelected) then begin
  218.     Index := Min(Icons.Count, Max(Index, 0));
  219.     while (FTopIndex < Index - 4) do Inc(FTopIndex);
  220.     if Index < FTopIndex then FTopIndex := Index;
  221.     FSelected := Index;
  222.     if FSelected <> ScrollBar.Position then ScrollBar.Position := FSelected;
  223.     ValidateImage;
  224.   end;
  225. end;
  226.  
  227. procedure TIconListDialog.ListChanged(Sender: TObject);
  228. begin
  229.   ScrollBar.Max := Icons.Count;
  230.   SetSelectedIndex(FSelected, True);
  231.   Modified := True;
  232. end;
  233.  
  234. procedure TIconListDialog.CheckButtons;
  235. var
  236.   Enable: Boolean;
  237. begin
  238.   Enable := (Icons.Count > 0) and (FSelected < Icons.Count) and
  239.     (FSelected >= 0);
  240.   Clear.Enabled := Icons.Count > 0;
  241.   Delete.Enabled := Enable;
  242.   Copy.Enabled := Enable;
  243.   CheckEnablePaste;
  244. end;
  245.  
  246. procedure TIconListDialog.ValidateImage;
  247. var
  248.   Enable: Boolean;
  249.   I: Integer;
  250.   Image, Slot: TComponent;
  251. begin
  252.   for I := 0 to 4 do begin
  253.     Image := FindComponent(Format(sImage, [I]));
  254.     Slot := FindComponent(Format(sSlot, [I]));
  255.     if Image <> nil then
  256.       with TImage(Image).Picture do begin
  257.         if FTopIndex + I < Icons.Count then Assign(Icons[FTopIndex + I])
  258.         else Assign(nil);
  259. {$IFDEF RX_D3}
  260.         TImage(Image).Transparent := True;
  261. {$ENDIF}
  262.       end;
  263.     if Slot <> nil then TPanel(Slot).ParentColor := True;
  264.   end;
  265.   Slot := FindComponent(Format(sSlot, [FSelected - FTopIndex]));
  266.   if Slot <> nil then TPanel(Slot).Color := clActiveCaption;
  267.   CntLabel.Caption := IntToStr(Icons.Count);
  268.   Enable := (Icons.Count > 0) and (FSelected <= Icons.Count) and
  269.     (FSelected >= 0);
  270.   if Enable then IdxLabel.Caption := IntToStr(FSelected)
  271.   else IdxLabel.Caption := '';
  272.   CheckButtons;
  273. end;
  274.  
  275. procedure TIconListDialog.FormCreate(Sender: TObject);
  276. {$IFDEF RX_D3}
  277. var
  278.   I: Integer;
  279.   Image: TComponent;
  280. {$ENDIF}
  281. begin
  282. {$IFDEF RX_D3}
  283.   FileDialog := TOpenPictureDialog.Create(Self);
  284.   for I := 0 to 4 do begin
  285.     Image := FindComponent(Format(sImage, [I]));
  286.     if Image <> nil then TImage(Image).Transparent := True;
  287.   end;
  288. {$ELSE}
  289.   FileDialog := TOpenDialog.Create(Self);
  290. {$ENDIF}
  291.   with FileDialog do begin
  292.     Title := LoadStr(srLoadIcon);
  293.     Options := [ofHideReadOnly, ofFileMustExist];
  294.     DefaultExt := GraphicExtension(TIcon);
  295.     Filter := GraphicFilter(TIcon);
  296.   end;
  297.   Icons := TIconList.Create;
  298.   Icons.OnChange := ListChanged;
  299.   FTopIndex := 0;
  300.   FSelected := 0;
  301.   Clear.Enabled := False;
  302.   Copy.Enabled := False;
  303.   Delete.Enabled := False;
  304.   CheckEnablePaste;
  305. end;
  306.  
  307. procedure TIconListDialog.FormDestroy(Sender: TObject);
  308. begin
  309.   Icons.OnChange := nil;
  310.   Icons.Free;
  311. end;
  312.  
  313. procedure TIconListDialog.UpdateClipboard(Sender: TObject);
  314. begin
  315.   CheckEnablePaste;
  316. end;
  317.  
  318. procedure TIconListDialog.LoadClick(Sender: TObject);
  319. var
  320.   Ico: TIcon;
  321.   I: Integer;
  322. {$IFNDEF RX_D3}
  323.   FileName: string;
  324. {$ENDIF}
  325. begin
  326. {$IFNDEF RX_D3}
  327.   FileName := '';
  328.   if SelectImage(FileName, GraphicExtension(TIcon), GraphicFilter(TIcon)) then
  329.   begin
  330.     FileDialog.Filename := FileName;
  331. {$ELSE}
  332.   if FileDialog.Execute then begin
  333. {$ENDIF}
  334.     Ico := TIcon.Create;
  335.     try
  336.       Ico.LoadFromFile(FileDialog.Filename);
  337.       I := Min(FSelected + 1, Icons.Count);
  338.       Icons.Insert(I, Ico);
  339.       SetSelectedIndex(I, True);
  340.     finally
  341.       Ico.Free;
  342.     end;
  343.   end;
  344. end;
  345.  
  346. procedure TIconListDialog.CopyClick(Sender: TObject);
  347. begin
  348.   CopyIconToClipboard(GetSelectedIcon, clBtnFace);
  349.   CheckEnablePaste;
  350. end;
  351.  
  352. procedure TIconListDialog.PasteClick(Sender: TObject);
  353. var
  354.   Ico: TIcon;
  355. begin
  356.   if Clipboard.HasFormat(CF_ICON) then begin
  357.     Ico := CreateIconFromClipboard;
  358.     try
  359.       Icons[FSelected] := Ico;
  360.     finally
  361.       Ico.Free;
  362.     end;
  363.   end;
  364. end;
  365.  
  366. procedure TIconListDialog.WMActivate(var Msg: TWMActivate);
  367. begin
  368.   if Msg.Active <> WA_INACTIVE then CheckEnablePaste;
  369.   inherited;
  370. end;
  371.  
  372. procedure TIconListDialog.ClearClick(Sender: TObject);
  373. begin
  374.   Icons.Clear;
  375. end;
  376.  
  377. procedure TIconListDialog.ScrollBarChange(Sender: TObject);
  378. begin
  379.   SetSelectedIndex(ScrollBar.Position, False);
  380. end;
  381.  
  382. procedure TIconListDialog.DeleteClick(Sender: TObject);
  383. begin
  384.   Icons.Delete(FSelected);
  385. end;
  386.  
  387. procedure TIconListDialog.ImageMouseDown(Sender: TObject;
  388.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  389. var
  390.   Index: Integer;
  391. begin
  392.   if Button = mbLeft then begin
  393.     for Index := 0 to 4 do begin
  394.       if TComponent(Sender).Name = Format(sImage, [Index]) then Break;
  395.       if TComponent(Sender).Name = Format(sSlot, [Index]) then Break;
  396.     end;
  397.     SetSelectedIndex(FTopIndex + Index, True);
  398.   end;
  399. end;
  400.  
  401. procedure TIconListDialog.LoadAniClick(Sender: TObject);
  402. begin
  403.   LoadAniFile;
  404. end;
  405.  
  406. end.
  407.