1 files changed, 408 insertions, 0 deletions
diff --git a/apps/X11/VCL/TPageControl.cpp b/apps/X11/VCL/TPageControl.cpp
new file mode 100644
index 0000000..af0112c
--- /dev/null
+++ b/apps/X11/VCL/TPageControl.cpp
@@ -0,0 +1,408 @@
+#include <TPageControl.h>
+
+TPageControl::TPageControl(TComponent *AOwner) : TCustomTabControl(AOwner) {
+}
+
+TPageControl::~TPageControl() {
+}
+
+/*
+{ TPageControl }
+
+constructor TPageControl.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := [csDoubleClicks, csOpaque];
+  FPages := TList.Create;
+end;
+
+destructor TPageControl.Destroy;
+var
+  I: Integer;
+begin
+  for I := 0 to FPages.Count - 1 do TTabSheet(FPages[I]).FPageControl := nil;
+  FPages.Free;
+  inherited Destroy;
+end;
+
+function TPageControl.CanShowTab(TabIndex: Integer): Boolean;
+begin
+  Result := TTabSheet(FPages[TabIndex]).Enabled;
+end;
+
+procedure TPageControl.Change;
+var
+  Form: TCustomForm;
+begin
+  UpdateActivePage;
+  if csDesigning in ComponentState then
+  begin
+    Form := GetParentForm(Self);
+    if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified;
+  end;
+  inherited Change;
+end;
+
+procedure TPageControl.ChangeActivePage(Page: TTabSheet);
+var
+  ParentForm: TCustomForm;
+begin
+  if FActivePage <> Page then
+  begin
+    ParentForm := GetParentForm(Self);
+    if (ParentForm <> nil) and (FActivePage <> nil) and
+      FActivePage.ContainsControl(ParentForm.ActiveControl) then
+    begin
+      ParentForm.ActiveControl := FActivePage;
+      if ParentForm.ActiveControl <> FActivePage then
+      begin
+        TabIndex := FActivePage.TabIndex;
+        Exit;
+      end;
+    end;
+    if Page <> nil then
+    begin
+      Page.BringToFront;
+      Page.Visible := True;
+      if (ParentForm <> nil) and (FActivePage <> nil) and
+        (ParentForm.ActiveControl = FActivePage) then
+        if Page.CanFocus then
+          ParentForm.ActiveControl := Page else
+          ParentForm.ActiveControl := Self;
+    end;
+    if FActivePage <> nil then FActivePage.Visible := False;
+    FActivePage := Page;
+    if (ParentForm <> nil) and (FActivePage <> nil) and
+      (ParentForm.ActiveControl = FActivePage) then
+      FActivePage.SelectFirst;
+  end;
+end;
+
+procedure TPageControl.DeleteTab(Page: TTabSheet; Index: Integer);
+var
+  UpdateIndex: Boolean;
+begin
+  UpdateIndex := Page = ActivePage;
+  Tabs.Delete(Index);
+  if UpdateIndex then
+  begin
+    if Index >= Tabs.Count then
+      Index := Tabs.Count - 1; 
+    TabIndex := Index;
+  end;
+  UpdateActivePage;
+end;
+
+procedure TPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
+begin
+  if FNewDockSheet <> nil then Client.Parent := FNewDockSheet;
+end;
+
+procedure TPageControl.DockOver(Source: TDragDockObject; X, Y: Integer;
+  State: TDragState; var Accept: Boolean);
+var
+  R: TRect;
+begin
+  GetWindowRect(Handle, R);
+  Source.DockRect := R;
+  DoDockOver(Source, X, Y, State, Accept);
+end;
+
+procedure TPageControl.DoRemoveDockClient(Client: TControl);
+begin
+  if (FUndockingPage <> nil) and not (csDestroying in ComponentState) then
+  begin
+    SelectNextPage(True);
+    FUndockingPage.Free;
+    FUndockingPage := nil;
+  end;
+end;
+
+function TPageControl.FindNextPage(CurPage: TTabSheet;
+  GoForward, CheckTabVisible: Boolean): TTabSheet;
+var
+  I, StartIndex: Integer;
+begin
+  if FPages.Count <> 0 then
+  begin
+    StartIndex := FPages.IndexOf(CurPage);
+    if StartIndex = -1 then
+      if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
+    I := StartIndex;
+    repeat
+      if GoForward then
+      begin
+        Inc(I);
+        if I = FPages.Count then I := 0;
+      end else
+      begin
+        if I = 0 then I := FPages.Count;
+        Dec(I);
+      end;
+      Result := FPages[I];
+      if not CheckTabVisible or Result.TabVisible then Exit;
+    until I = StartIndex;
+  end;
+  Result := nil;
+end;
+
+procedure TPageControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+  I: Integer;
+begin
+  for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I]));
+end;
+
+function TPageControl.GetImageIndex(TabIndex: Integer): Integer;
+begin
+  if Assigned(FOnGetImageIndex) then
+    Result := inherited GetImageIndex(TabIndex) else
+    Result := GetPage(TabIndex).ImageIndex;
+end;
+
+function TPageControl.GetPageFromDockClient(Client: TControl): TTabSheet;
+var
+  I: Integer;
+begin
+  Result := nil;
+  for I := 0 to PageCount - 1 do
+  begin
+    if (Client.Parent = Pages[I]) and (Client.HostDockSite = Self) then
+    begin
+      Result := Pages[I];
+      Exit;
+    end;
+  end;
+end;
+
+function TPageControl.GetPage(Index: Integer): TTabSheet;
+begin
+  Result := FPages[Index];
+end;
+
+function TPageControl.GetPageCount: Integer;
+begin
+  Result := FPages.Count;
+end;
+
+procedure TPageControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
+  MousePos: TPoint; var CanDock: Boolean);
+begin
+  CanDock := GetPageFromDockClient(Client) = nil;
+  inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
+end;
+
+procedure TPageControl.InsertPage(Page: TTabSheet);
+begin
+  FPages.Add(Page);
+  Page.FPageControl := Self;
+  Page.UpdateTabShowing;
+end;
+
+procedure TPageControl.InsertTab(Page: TTabSheet);
+begin
+  Tabs.InsertObject(Page.TabIndex, Page.Caption, Page);
+  UpdateActivePage;
+end;
+
+procedure TPageControl.MoveTab(CurIndex, NewIndex: Integer);
+begin
+  Tabs.Move(CurIndex, NewIndex);
+end;
+
+procedure TPageControl.RemovePage(Page: TTabSheet);
+var
+  NextSheet: TTabSheet;
+begin
+  NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState));
+  if NextSheet = Page then NextSheet := nil;
+  Page.SetTabShowing(False);
+  Page.FPageControl := nil;
+  FPages.Remove(Page);
+  SetActivePage(NextSheet);
+end;
+
+procedure TPageControl.SelectNextPage(GoForward: Boolean);
+var
+  Page: TTabSheet;
+begin
+  Page := FindNextPage(ActivePage, GoForward, True);
+  if (Page <> nil) and (Page <> ActivePage) and CanChange then
+  begin
+    TabIndex := Page.TabIndex;
+    Change;
+  end;
+end;
+
+procedure TPageControl.SetActivePage(Page: TTabSheet);
+begin
+  if (Page <> nil) and (Page.PageControl <> Self) then Exit;
+  ChangeActivePage(Page);
+  if Page = nil then
+    TabIndex := -1
+  else if Page = FActivePage then
+    TabIndex := Page.TabIndex;
+end;
+
+procedure TPageControl.SetChildOrder(Child: TComponent; Order: Integer);
+begin
+  TTabSheet(Child).PageIndex := Order;
+end;
+
+procedure TPageControl.ShowControl(AControl: TControl);
+begin
+  if (AControl is TTabSheet) and (TTabSheet(AControl).PageControl = Self) then
+    SetActivePage(TTabSheet(AControl));
+  inherited ShowControl(AControl);
+end;
+
+procedure TPageControl.UpdateTab(Page: TTabSheet);
+begin
+  Tabs[Page.TabIndex] := Page.Caption;
+end;
+
+procedure TPageControl.UpdateActivePage;
+begin
+  if TabIndex >= 0 then
+    SetActivePage(TTabSheet(Tabs.Objects[TabIndex]))
+  else
+    SetActivePage(nil);
+end;
+
+procedure TPageControl.CMDesignHitTest(var Message: TCMDesignHitTest);
+var
+  HitIndex: Integer;
+  HitTestInfo: TTCHitTestInfo;
+begin
+  HitTestInfo.pt := SmallPointToPoint(Message.Pos);
+  HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo));
+  if (HitIndex >= 0) and (HitIndex <> TabIndex) then Message.Result := 1;
+end;
+
+procedure TPageControl.CMDialogKey(var Message: TCMDialogKey);
+begin
+  if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
+    (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
+  begin
+    SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
+    Message.Result := 1;
+  end else
+    inherited;
+end;
+
+procedure TPageControl.CMDockClient(var Message: TCMDockClient);
+var
+  IsVisible: Boolean;
+  DockCtl: TControl;
+begin
+  Message.Result := 0;
+  FNewDockSheet := TTabSheet.Create(Self);
+  try
+    try
+      DockCtl := Message.DockSource.Control;
+      if DockCtl is TCustomForm then
+        FNewDockSheet.Caption := TCustomForm(DockCtl).Caption;
+      FNewDockSheet.PageControl := Self;
+      DockCtl.Dock(Self, Message.DockSource.DockRect);
+    except
+      FNewDockSheet.Free;
+      raise;
+    end;
+    IsVisible := DockCtl.Visible;
+    FNewDockSheet.TabVisible := IsVisible;
+    if IsVisible then ActivePage := FNewDockSheet;
+    DockCtl.Align := alClient;
+  finally
+    FNewDockSheet := nil;
+  end;
+end;
+
+procedure TPageControl.CMDockNotification(var Message: TCMDockNotification);
+var
+  I: Integer;
+  S: string;
+  Page: TTabSheet;
+begin
+  Page := GetPageFromDockClient(Message.Client);
+  if Page <> nil then
+    case Message.NotifyRec.ClientMsg of
+      WM_SETTEXT:
+        begin
+          S := PChar(Message.NotifyRec.MsgLParam);
+          { Search for first CR/LF and end string there }
+          for I := 1 to Length(S) do
+            if S[I] in [#13, #10] then
+            begin
+              SetLength(S, I - 1);
+              Break;
+            end;
+          Page.Caption := S;
+        end;
+      CM_VISIBLECHANGED:
+        with Page do
+        begin
+          Visible := Boolean(Message.NotifyRec.MsgWParam);
+          TabVisible := Boolean(Message.NotifyRec.MsgWParam);;
+        end;
+    end;
+  inherited;
+end;
+
+procedure TPageControl.CMUnDockClient(var Message: TCMUnDockClient);
+var
+  Page: TTabSheet;
+begin
+  Message.Result := 0;
+  Page := GetPageFromDockClient(Message.Client);
+  if Page <> nil then
+  begin
+    FUndockingPage := Page;
+    Message.Client.Align := alNone;
+  end;
+end;
+
+function TPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl;
+var
+  HitIndex: Integer;
+  HitTestInfo: TTCHitTestInfo;
+  Page: TTabSheet;
+begin
+  Result := nil;
+  if DockSite then
+  begin
+    HitTestInfo.pt := MousePos;
+    HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo));
+    if HitIndex >= 0 then
+    begin
+      Page := Pages[HitIndex];
+      if not Page.TabVisible then Page := FindNextPage(Page, True, True);
+      if (Page <> nil) and (Page.ControlCount > 0) then
+      begin
+        Result := Page.Controls[0];
+        if Result.HostDockSite <> Self then Result := nil;
+      end;
+    end;
+  end;
+end;
+
+procedure TPageControl.WMLButtonDown(var Message: TWMLButtonDown);
+var
+  DockCtl: TControl;
+begin
+  inherited;
+  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
+  if DockCtl <> nil then DockCtl.BeginDrag(False);
+end;
+
+procedure TPageControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+var
+  DockCtl: TControl;
+begin
+  inherited;
+  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
+  if DockCtl <> nil then DockCtl.ManualDock(nil, nil, alNone);
+end;
+
+*/
+
+