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 |
|
---|