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