| 1 | unit UCDWindowList;
|
|---|
| 2 |
|
|---|
| 3 | {$mode objfpc}{$H+}
|
|---|
| 4 |
|
|---|
| 5 | interface
|
|---|
| 6 |
|
|---|
| 7 | uses
|
|---|
| 8 | Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|---|
| 9 | ComCtrls, StdCtrls, Menus, UCDLayout;
|
|---|
| 10 |
|
|---|
| 11 | type
|
|---|
| 12 |
|
|---|
| 13 | { TCDWindowListForm }
|
|---|
| 14 |
|
|---|
| 15 | TCDWindowListForm = class(TForm)
|
|---|
| 16 | ButtonFocus: TButton;
|
|---|
| 17 | ButtonHide: TButton;
|
|---|
| 18 | ButtonShow: TButton;
|
|---|
| 19 | ImageList1: TImageList;
|
|---|
| 20 | ListView1: TListView;
|
|---|
| 21 | procedure ButtonFocusClick(Sender: TObject);
|
|---|
| 22 | procedure ButtonHideClick(Sender: TObject);
|
|---|
| 23 | procedure ButtonShowClick(Sender: TObject);
|
|---|
| 24 | procedure FormShow(Sender: TObject);
|
|---|
| 25 | procedure ListView1DblClick(Sender: TObject);
|
|---|
| 26 | procedure ListView1KeyPress(Sender: TObject; var Key: char);
|
|---|
| 27 | procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 28 | Selected: Boolean);
|
|---|
| 29 | private
|
|---|
| 30 | { private declarations }
|
|---|
| 31 | public
|
|---|
| 32 | procedure LoadList;
|
|---|
| 33 | procedure LoadToMenuItem(MenuItem: TMenuItem);
|
|---|
| 34 | end;
|
|---|
| 35 |
|
|---|
| 36 | TCDWindowList = class(TComponent)
|
|---|
| 37 | private
|
|---|
| 38 | FLayoutList: TCDLayoutList;
|
|---|
| 39 | Form: TCDWindowListForm;
|
|---|
| 40 | procedure SetLayoutList(const AValue: TCDLayoutList);
|
|---|
| 41 | public
|
|---|
| 42 | function Execute: Boolean;
|
|---|
| 43 | constructor Create(AOwner: TComponent); override;
|
|---|
| 44 | published
|
|---|
| 45 | end;
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 | procedure Register;
|
|---|
| 49 |
|
|---|
| 50 | implementation
|
|---|
| 51 |
|
|---|
| 52 | resourcestring
|
|---|
| 53 | SStateFloating = 'Floating';
|
|---|
| 54 | SStateDocked = 'Docked';
|
|---|
| 55 | SStateVisible = 'Visible';
|
|---|
| 56 | SStateHidden = 'Hidden';
|
|---|
| 57 |
|
|---|
| 58 | procedure Register;
|
|---|
| 59 | begin
|
|---|
| 60 | RegisterComponents('CoolDocking', [TCDWindowList]);
|
|---|
| 61 | end;
|
|---|
| 62 |
|
|---|
| 63 | { TCDWindowList }
|
|---|
| 64 |
|
|---|
| 65 | function TCDWindowList.Execute: Boolean;
|
|---|
| 66 | begin
|
|---|
| 67 | Form := TCDWindowListForm.Create(Self);
|
|---|
| 68 | Form.ShowModal;
|
|---|
| 69 | Form.Free;
|
|---|
| 70 | Result := True;
|
|---|
| 71 | end;
|
|---|
| 72 |
|
|---|
| 73 | constructor TCDWindowList.Create(AOwner: TComponent);
|
|---|
| 74 | begin
|
|---|
| 75 | inherited Create(AOwner);
|
|---|
| 76 | end;
|
|---|
| 77 |
|
|---|
| 78 | procedure TCDWindowList.SetLayoutList(const AValue: TCDLayoutList);
|
|---|
| 79 | begin
|
|---|
| 80 | if FLayoutList = AValue then Exit;
|
|---|
| 81 | FLayoutList := AValue;
|
|---|
| 82 | end;
|
|---|
| 83 |
|
|---|
| 84 | { TCDWindowListForm }
|
|---|
| 85 |
|
|---|
| 86 | procedure TCDWindowListForm.ButtonFocusClick(Sender: TObject);
|
|---|
| 87 | begin
|
|---|
| 88 | if Assigned(ListView1.Selected) then
|
|---|
| 89 | TForm(ListView1.Selected.Data).Show;
|
|---|
| 90 | Close;
|
|---|
| 91 | end;
|
|---|
| 92 |
|
|---|
| 93 | procedure TCDWindowListForm.ButtonHideClick(Sender: TObject);
|
|---|
| 94 | begin
|
|---|
| 95 | if Assigned(ListView1.Selected) then
|
|---|
| 96 | TForm(ListView1.Selected.Data).Close;
|
|---|
| 97 | LoadList;
|
|---|
| 98 | end;
|
|---|
| 99 |
|
|---|
| 100 | procedure TCDWindowListForm.ButtonShowClick(Sender: TObject);
|
|---|
| 101 | begin
|
|---|
| 102 | if Assigned(ListView1.Selected) then
|
|---|
| 103 | TForm(ListView1.Selected.Data).Show;
|
|---|
| 104 | LoadList;
|
|---|
| 105 | end;
|
|---|
| 106 |
|
|---|
| 107 | procedure TCDWindowListForm.FormShow(Sender: TObject);
|
|---|
| 108 | begin
|
|---|
| 109 | LoadList;
|
|---|
| 110 | end;
|
|---|
| 111 |
|
|---|
| 112 | procedure TCDWindowListForm.ListView1DblClick(Sender: TObject);
|
|---|
| 113 | begin
|
|---|
| 114 | ButtonFocusClick(Self);
|
|---|
| 115 | end;
|
|---|
| 116 |
|
|---|
| 117 | procedure TCDWindowListForm.ListView1KeyPress(Sender: TObject; var Key: char);
|
|---|
| 118 | begin
|
|---|
| 119 | if Key = #13 then ButtonFocusClick(Self);
|
|---|
| 120 | end;
|
|---|
| 121 |
|
|---|
| 122 | procedure TCDWindowListForm.ListView1SelectItem(Sender: TObject;
|
|---|
| 123 | Item: TListItem; Selected: Boolean);
|
|---|
| 124 | begin
|
|---|
| 125 | ButtonFocus.Enabled := Selected;
|
|---|
| 126 | ButtonHide.Enabled := Selected;
|
|---|
| 127 | ButtonShow.Enabled := Selected;
|
|---|
| 128 | end;
|
|---|
| 129 |
|
|---|
| 130 | procedure TCDWindowListForm.LoadList;
|
|---|
| 131 | var
|
|---|
| 132 | I: Integer;
|
|---|
| 133 | NewItem: TListItem;
|
|---|
| 134 | Form: TForm;
|
|---|
| 135 | DockState: string;
|
|---|
| 136 | IconBitmap: TBitmap;
|
|---|
| 137 | Mask: TBitmap;
|
|---|
| 138 | begin
|
|---|
| 139 | with ListView1, Items do begin
|
|---|
| 140 | BeginUpdate;
|
|---|
| 141 | Clear;
|
|---|
| 142 | ImageList1.Clear;
|
|---|
| 143 | for I := 0 to Application.ComponentCount - 1 do begin
|
|---|
| 144 | if (Application.Components[I] is TForm) then begin
|
|---|
| 145 | Form := (Application.Components[I] as TForm);
|
|---|
| 146 | if Form.DragKind = dkDock then begin
|
|---|
| 147 | NewItem := Add;
|
|---|
| 148 | NewItem.Caption := Form.Caption;
|
|---|
| 149 | NewItem.Data := Form;
|
|---|
| 150 | if Assigned(Form.HostDockSite) then DockState := SStateDocked
|
|---|
| 151 | else DockState := SStateFloating;
|
|---|
| 152 | NewItem.SubItems.Add(DockState);
|
|---|
| 153 | if Form.Visible then DockState := SStateVisible
|
|---|
| 154 | else DockState := SStateHidden;
|
|---|
| 155 | NewItem.SubItems.Add(DockState);
|
|---|
| 156 |
|
|---|
| 157 | try
|
|---|
| 158 | Mask := TBitmap.Create;
|
|---|
| 159 | IconBitmap := TBitmap.Create;
|
|---|
| 160 | //IconBitmap.SetSize(Form.Icon.Width, Form.Icon.Height);
|
|---|
| 161 | //ShowMessage(IntToStr(Integer(Form.Icon.TransparentColor)));
|
|---|
| 162 | IconBitmap.Assign(Form.Icon);
|
|---|
| 163 | //IconBitmap.Canvas.Draw(0, 0, Form.Icon);
|
|---|
| 164 |
|
|---|
| 165 | //Mask.Assign(Form.Icon);
|
|---|
| 166 | //Mask.Canvas.Brush.Color := Form.Icon.TransparentColor;
|
|---|
| 167 | //Mask.Monochrome := True;
|
|---|
| 168 | //ImageList1.BkColor := clBlack;
|
|---|
| 169 | ImageList1.Add(IconBitmap, nil);
|
|---|
| 170 | finally
|
|---|
| 171 | Mask.Free;
|
|---|
| 172 | IconBitmap.Free;
|
|---|
| 173 | end;
|
|---|
| 174 |
|
|---|
| 175 | NewItem.ImageIndex := ImageList1.Count - 1;
|
|---|
| 176 | end;
|
|---|
| 177 | end;
|
|---|
| 178 | end;
|
|---|
| 179 | EndUpdate;
|
|---|
| 180 | end;
|
|---|
| 181 | end;
|
|---|
| 182 |
|
|---|
| 183 | procedure TCDWindowListForm.LoadToMenuItem(MenuItem: TMenuItem);
|
|---|
| 184 | var
|
|---|
| 185 | NewMenuItem: TMenuItem;
|
|---|
| 186 | I: Integer;
|
|---|
| 187 | Form: TForm;
|
|---|
| 188 | begin
|
|---|
| 189 | with MenuItem do begin
|
|---|
| 190 | Clear;
|
|---|
| 191 | for I := 0 to Application.ComponentCount - 1 do begin
|
|---|
| 192 | if Application.Components[I] is TForm then begin
|
|---|
| 193 | Form := (Application.Components[I] as TForm);
|
|---|
| 194 | NewMenuItem := TMenuItem.Create(MenuItem);
|
|---|
| 195 | NewMenuItem.Caption := Form.Caption;
|
|---|
| 196 | MenuItem.Add(NewMenuItem);
|
|---|
| 197 | end;
|
|---|
| 198 | end;
|
|---|
| 199 | end;
|
|---|
| 200 | end;
|
|---|
| 201 |
|
|---|
| 202 | initialization
|
|---|
| 203 | {$I UCDWindowList.lrs}
|
|---|
| 204 |
|
|---|
| 205 | end.
|
|---|
| 206 |
|
|---|