source: trunk/Packages/CoolDocking/UCDWindowList.pas

Last change on this file was 73, checked in by chronos, 12 years ago
  • Modified: Packages are now stored as uncomporessed and are linked with relative path to project.
File size: 5.2 KB
Line 
1unit UCDWindowList;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
9 ComCtrls, StdCtrls, Menus, UCDLayout;
10
11type
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
48procedure Register;
49
50implementation
51
52resourcestring
53 SStateFloating = 'Floating';
54 SStateDocked = 'Docked';
55 SStateVisible = 'Visible';
56 SStateHidden = 'Hidden';
57
58procedure Register;
59begin
60 RegisterComponents('CoolDocking', [TCDWindowList]);
61end;
62
63{ TCDWindowList }
64
65function TCDWindowList.Execute: Boolean;
66begin
67 Form := TCDWindowListForm.Create(Self);
68 Form.ShowModal;
69 Form.Free;
70 Result := True;
71end;
72
73constructor TCDWindowList.Create(AOwner: TComponent);
74begin
75 inherited Create(AOwner);
76end;
77
78procedure TCDWindowList.SetLayoutList(const AValue: TCDLayoutList);
79begin
80 if FLayoutList = AValue then Exit;
81 FLayoutList := AValue;
82end;
83
84{ TCDWindowListForm }
85
86procedure TCDWindowListForm.ButtonFocusClick(Sender: TObject);
87begin
88 if Assigned(ListView1.Selected) then
89 TForm(ListView1.Selected.Data).Show;
90 Close;
91end;
92
93procedure TCDWindowListForm.ButtonHideClick(Sender: TObject);
94begin
95 if Assigned(ListView1.Selected) then
96 TForm(ListView1.Selected.Data).Close;
97 LoadList;
98end;
99
100procedure TCDWindowListForm.ButtonShowClick(Sender: TObject);
101begin
102 if Assigned(ListView1.Selected) then
103 TForm(ListView1.Selected.Data).Show;
104 LoadList;
105end;
106
107procedure TCDWindowListForm.FormShow(Sender: TObject);
108begin
109 LoadList;
110end;
111
112procedure TCDWindowListForm.ListView1DblClick(Sender: TObject);
113begin
114 ButtonFocusClick(Self);
115end;
116
117procedure TCDWindowListForm.ListView1KeyPress(Sender: TObject; var Key: char);
118begin
119 if Key = #13 then ButtonFocusClick(Self);
120end;
121
122procedure TCDWindowListForm.ListView1SelectItem(Sender: TObject;
123 Item: TListItem; Selected: Boolean);
124begin
125 ButtonFocus.Enabled := Selected;
126 ButtonHide.Enabled := Selected;
127 ButtonShow.Enabled := Selected;
128end;
129
130procedure TCDWindowListForm.LoadList;
131var
132 I: Integer;
133 NewItem: TListItem;
134 Form: TForm;
135 DockState: string;
136 IconBitmap: TBitmap;
137 Mask: TBitmap;
138begin
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;
181end;
182
183procedure TCDWindowListForm.LoadToMenuItem(MenuItem: TMenuItem);
184var
185 NewMenuItem: TMenuItem;
186 I: Integer;
187 Form: TForm;
188begin
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;
200end;
201
202initialization
203 {$I UCDWindowList.lrs}
204
205end.
206
Note: See TracBrowser for help on using the repository browser.