File: custompage.inc

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (283 lines) | stat: -rw-r--r-- 8,366 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
{%MainUnit ../comctrls.pp}

{
 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{------------------------------------------------------------------------------
  TCustomPage Constructor
 ------------------------------------------------------------------------------}
constructor TCustomPage.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);

  FImageIndex := -1;
  FCompStyle := csPage;
  FTabVisible := True;
  ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds, csNoDesignVisible, csNoFocus];

  // height and width depends on parent, align to client rect
  Align := alClient;
  Caption := '';
  Visible := False;
end;

{------------------------------------------------------------------------------
  method TCustomPage SetImageIndex
  Params: const AValue: integer
  Result: none

  Set the image index of the image shown in the tabs.
 ------------------------------------------------------------------------------}
procedure TCustomPage.SetImageIndex(const AValue: TImageIndex);
begin
  if FImageIndex = AValue then Exit;
  FImageIndex := AValue;
  if not HandleAllocated or (csLoading in ComponentState) then Exit;
  TWSCustomPageClass(WidgetSetClass).UpdateProperties(Self);
end;

function TCustomPage.GetTabVisible: Boolean;
begin
  Result := FTabVisible;
end;

procedure TCustomPage.SetTabVisible(const AValue: Boolean);
begin
  if AValue = FTabVisible then Exit;
  FTabVisible := AValue;
 
  if csDesigning in ComponentState then
    Exit;

  if Assigned(Parent) and Parent.HandleAllocated then
  begin
    if FTabVisible then
    begin
      // check if there was no visible tab
      if TCustomTabControl(Parent).PageIndex = -1 then
        TCustomTabControl(Parent).PageIndex:=PageIndex;
    end
    else
      // Check if the page is active and set a new pageindex
      TCustomTabControl(Parent).PageRemoved(PageIndex);
    TCustomTabControl(Parent).AddRemovePageHandle(Self);
    TCustomTabControl(Parent).DoSendPageIndex;
  end;
end;

class procedure TCustomPage.WSRegisterClass;
begin
  inherited WSRegisterClass;
  RegisterCustomPage;
end;

{------------------------------------------------------------------------------
  TCustomPage WMPaint
  Params: a TLMPaint message
 ------------------------------------------------------------------------------}
procedure TCustomPage.WMPaint(var Msg: TLMPaint);
var
    Notebook: TCustomTabControl;
begin
  if Parent is TCustomTabControl then
  begin
    NoteBook := TCustomTabControl(Parent);
    if (NoteBook.PageIndex >= 0) and (NoteBook.Page[NoteBook.PageIndex] = Self) then
      inherited WMPaint(Msg);
  end
  else
    inherited WMPaint(Msg);
end;

{------------------------------------------------------------------------------
  procedure TCustomPage.SetParent(AParent: TWinControl);

  Set parent wincontrol.
 ------------------------------------------------------------------------------}
procedure TCustomPage.SetParent(AParent: TWinControl);
var
  OldParent: TWinControl;
  ParentNotebook: TCustomTabControl;
  i: integer;
begin
  if (AParent = Parent) or (pfInserting in FFlags) then Exit;
  CheckNewParent(AParent);
  OldParent := Parent;
  if (OldParent <> AParent) and (OldParent is TCustomTabControl) and
    (not (pfRemoving in FFlags)) then
  begin
    // remove from old pagelist
    ParentNotebook := TCustomTabControl(OldParent);
    i := PageIndex;
    if i >= 0 then
      ParentNotebook.RemovePage(i);
  end;

  inherited SetParent(AParent);

  if (OldParent <> AParent) and (Parent is TCustomTabControl) then
  begin
    // add to new pagelist
    ParentNotebook := TCustomTabControl(Parent);
    i := ParentNotebook.IndexOf(Self);
    if i < 0 then
      ParentNotebook.InsertPage(Self, ParentNotebook.PageCount);
  end;
end;

{------------------------------------------------------------------------------
  procedure TCustomPage.CMHitTest(var Message: TLMNCHITTEST);
 ------------------------------------------------------------------------------}
procedure TCustomPage.CMHitTest(var Message: TLMNCHITTEST);
begin
  if (Parent is TCustomTabControl) and
     (TCustomTabControl(Parent).ActivePageComponent <> Self) then
    Message.Result := 0 // no hit
  else
    inherited CMHitTest(Message);
  {DebugLn('TCustomPage.CMHitTest A ',Name,' ',(Parent<>nil),' ',
    (Parent is TCustomTabControl),' ',
    (TCustomTabControl(Parent).ActivePageComponent<>Self),
    ' Message.Result=',Message.Result);}
end;

procedure TCustomPage.CMVisibleChanged(var Message: TLMessage);
begin
  inherited CMVisibleChanged(Message);
  if Visible then
    DoShow
  else
    DoHide;
end;

{------------------------------------------------------------------------------
  function TCustomPage.PageIndex: integer;

  Returns the index of the page in the notebook.
 ------------------------------------------------------------------------------}
function TCustomPage.GetPageIndex: integer;
begin
  if Parent is TCustomTabControl then
    Result := TCustomTabControl(Parent).IndexOf(Self)
  else
    Result := -1;
end;

procedure TCustomPage.SetPageIndex(AValue: Integer);
begin
  if Parent is TCustomTabControl then
    TCustomTabControl(Parent).MoveTab(Self,AValue);
  //DebugLn('TCustomPage.SetPageIndex Old=',dbgs(PageIndex),' New=',dbgs(AValue));
end;

function TCustomPage.DialogChar(var Message: TLMKey): boolean;
begin
  Result := False;
  if (not (csDesigning in ComponentState)) and IsAccel(Message.CharCode, Caption) and TabVisible then
  begin
    Result := True;
    if Parent is TCustomTabControl then
      TCustomTabControl(Parent).PageIndex := PageIndex;
  end
  else
    Result := inherited DialogChar(Message);
end;

procedure TCustomPage.DoHide;
begin
  if Assigned(FOnHide) then
    FOnHide(Self);
end;

procedure TCustomPage.DoShow;
begin
  if Assigned(FOnShow) then
    FOnShow(Self);
end;

procedure TCustomPage.DestroyHandle;
begin
  inherited DestroyHandle;
  Exclude(FFlags,pfAdded);
end;

procedure TCustomPage.RealSetText(const AValue: TCaption);
begin
  if (Parent <> nil) and Parent.HandleAllocated and (not (csLoading in ComponentState)) then
  begin
    WSSetText(AValue);
    InvalidatePreferredSize;
    inherited RealSetText(AValue);
    AdjustSize;
  end
  else inherited RealSetText(AValue);
end;

function TCustomPage.IsControlVisible: Boolean;
begin
  // when autosizing, need this to return True so that the sizes of non-active
  // pages will be considered in parent's GetPreferredSize()
  if AutoSizingAll then
    Exit(True);
  Result := inherited IsControlVisible;
  if Result and (Parent is TCustomTabControl) then
    Result := PageIndex = TCustomTabControl(Parent).PageIndex;
end;

function TCustomPage.HandleObjectShouldBeVisible: boolean;
begin
  Result := inherited HandleObjectShouldBeVisible;
  if Result and (Parent is TCustomTabControl) then
    Result := PageIndex = TCustomTabControl(Parent).PageIndex;
end;

function TCustomPage.VisibleIndex: integer;
// returns the visible index, as if TabVisible=true
var
  notebook: TCustomTabControl;
  i: Integer;
begin
(* Removed PageList dependency.
  Added missing result value.
*)
  if Parent is TCustomTabControl then
  begin
    Result := 0;
    //List := TCustomTabControl(Parent).PageList;
    notebook := TCustomTabControl(Parent);
    i := 0;
    repeat
      if i = notebook.PageCount then exit(-1);
      if notebook.Page[i] = Self then exit;
      if (csDesigning in ComponentState) or notebook.Page[i].TabVisible
      then inc(Result);
      inc(i);
    until False;
  end;
// else
  Result := -1;
end;

procedure TCustomPage.CheckNewParent(AParent: TWinControl);
begin
  if (AParent<>nil) and (not (AParent is TCustomTabControl)) then
    raise EInvalidOperation.CreateFmt(rsASCannotHaveAsParent, [ClassName,
      AParent.ClassName]);
  inherited CheckNewParent(AParent);
end;

{------------------------------------------------------------------------------
  function TCustomPage.CanTab: boolean;
 ------------------------------------------------------------------------------}
function TCustomPage.CanTab: boolean;
begin
  Result := False;
end;

// included by comctrls.pp