最新问答 更多

关注我们

关注我们

了解我们的产品和服务,有任何疑问、意见或合作需求,可关注本微博与我们在线沟通。

盒子问答悬赏微博

[单人中标] delphi7开发,窗体显示问题

分享任务:
√ 问题已解决
20
发布者 薛定谔的Delphi
浏览量
回答数 2

任务详情

怎样把多个窗体好像PageControl一样分页显示,就好像图片的这种

查看原图>>任务附件

  • 死海:  如果不采用第三方控件的话,可以使用pagecontrol控制处理

      回答于:2016-9-28 17:48:17      #1楼 奖励火柴:0
    用户头像
  • 爷爷:  这个我有还真有,我自己写的,可任意复制。 你把你不用的代码引用删除了就可。
    
    delphi 10.1 版本的。也可以改成delphi 7的。送给你把。
    ChildForm是子窗体,ChildFormDisplay是显示的窗体,ChildFormDisplay里有个PageControl的属性,你改成DevExpress的就可以吧。
    100%没问题。
    unit X.ChildForm;
    // for y&f 2009-06-30
    interface
    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StrUtils, RTTI, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, X.AppEditions;
    type
    { TxForm }
    TxChildFormClass = class of TxChildForm;
    TxDosMoveOptions = set of (moEnter, moUpDn);
    ///
    /// 窗体穿透事件, 当不同窗体互相调用bpl, 时, 可以传入参数进行互相调用
    ///
    TxShowQueryEvent = procedure(Sender: TObject; var CanShow: Boolean) of object;
    TxChildForm = class(TForm)
    private
    { Private declarations }
    FAsChild: Boolean;
    FTempParent: TWinControl;
    FEditionType: TxAppEditionType;
    FDosMove: boolean;
    FDosMoveOptions: TxDosMoveOptions;
    FOnShowQuery: TxShowQueryEvent;
    FLastWasEdit: Boolean;
    FIsTabGrid: Boolean;
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure DowMoveKeyDown(var Key: Word; Shift: TShiftState);
    procedure DowMoveKeyPress(var Key: char);
    public
    { Public declarations }
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; AParent: TWinControl); reintroduce; overload;
    ///
    /// 如果有窗体调用包, 窗体打开状态也会调用此过程.
    ///
    function ShowQuery: Boolean; virtual;
    public
    ///
    /// 显示对话框
    ///
    class function ShowModalEx(): Integer; overload;
    ///
    /// 显示对话框
    ///
    ///
    ///
    /// 回调函数,当模式对话框关闭前,调用此函数.
    ///
    /// demo1:
    /// var
    /// Callback: TProc;
    /// begin
    /// callback := procedure(ADlg: TzxForm; mr: TModalResult)
    /// begin
    /// showmessage('dialog close callback proc');
    /// end;
    ///
    /// Tdlg.ShowModalEx(callback);
    /// end;
    ///
    /// =======================================================================
    ///
    /// demo2:
    /// begin
    /// Tdlg.ShowModalEx(
    /// procedure(ADlg: TzxForm; mr: TModalResult)
    /// begin
    /// showmessage('dialog close callback proc');
    /// end);
    /// end;
    ///
    ///
    class function ShowModalEx(ACallback: TProc): Integer; overload;
    ///
    /// 显示对话框
    ///
    class function ExecuteEx(): Boolean; overload;
    ///
    /// 显示对话框
    ///
    ///
    /// 回调函数,当模式对话框关闭前,调用此函数.
    ///
    class function ExecuteEx(ACallback: TProc): Boolean; overload;
    published
    ///
    /// 当前模块可应用的最低版本类别,
    ///
    property EditionType: TxAppEditionType read FEditionType write FEditionType;
    property DosMove: boolean read FDosMove write FDosMove default false;
    property DosMoveOptions: TxDosMoveOptions read FDosMoveOptions write FDosMoveOptions;
    /// 窗体互调事件
    /// 窗体互调过程, 默认是在打开bpl是执行,
    /// 如果有窗体调用包, 窗体打开状态也会调用此过程.
    ///
    property OnShowQuery: TxShowQueryEvent read FOnShowQuery write FOnShowQuery;
    published
    //这几个属性, 很重要
    property IsControl;
    property OnActivate;
    property OnDeactivate;
    property OnHide;
    end;
    implementation
    { TxChildForm }
    constructor TxChildForm.Create(AOwner: TComponent);
    begin
    //***begin 这段不可以更改**************************
    FAsChild := False; //这句必须在inherited的前
    FDosMoveOptions := [moEnter, moUpDn];
    inherited Create(AOwner); //这句必须使用inherited.
    end;
    constructor TxChildForm.Create(AOwner: TComponent; AParent: TWinControl);
    begin
    //***begin 这段不可以更改**************************
    FAsChild := True; //这个必须在inherited的前
    FTempParent := AParent; //这个必须在inherited前
    FDosMoveOptions := [moEnter, moUpDn];
    inherited Create(AOwner); //这个必须使用inherited
    end;
    procedure TxChildForm.Loaded;
    begin
    inherited;
    if FAsChild then
    begin
    Align := alClient;
    BorderStyle := bsNone;
    BorderIcons := [];
    Parent := FTempParent;
    Position := poDefault;
    //BoundsRect:=FTempParent.BoundsRect;
    BoundsRect := FTempParent.ClientRect;
    end;
    end;
    procedure TxChildForm.CreateParams(var Params: TCreateParams);
    begin
    inherited CreateParams(Params);
    if FAsChild then
    Params.Style := Params.Style or WS_CHILD;
    end;
    procedure TxChildForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    const
    sc_DragMove = $F012;
    begin
    inherited;
    ReleaseCapture;
    Perform(wm_SysCommand, sc_DragMove, 0);
    end;
    class function TxChildForm.ShowModalEx(): Integer;
    begin
    Result := ShowModalEx(nil);
    end;
    class function TxChildForm.ShowModalEx(ACallback: TProc): Integer;
    var
    LContext: TRttiContext;
    LClass: TRttiInstanceType;
    LForm: TxChildForm;
    begin
    LContext := TRttiContext.Create;
    try
    LClass := LContext.FindType(Self.QualifiedClassName) as TRttiInstanceType;
    if LClass <> nil then
    begin
    LForm := LClass.MetaclassType.Create as TxChildForm;
    LForm.Create(Application.MainForm);
    try
    Result := LForm.ShowModal;
    //回调函数
    if Assigned(ACallback) then
    ACallback(LForm, Result);
    finally
    LForm.Destroy;
    LForm := nil;
    end;
    end;
    finally
    LContext.Free;
    end;
    end;
    class function TxChildForm.ExecuteEx(): Boolean;
    begin
    Result := ExecuteEx(nil);
    end;
    class function TxChildForm.ExecuteEx(ACallback: TProc): Boolean;
    begin
    Result := (ShowModalEx(ACallback) = mrOK);
    end;
    procedure TxChildForm.KeyDown(var Key: Word; Shift: TShiftState);
    begin
    inherited;
    DowMoveKeyDown(Key, Shift);
    end;
    procedure TxChildForm.KeyPress(var Key: Char);
    begin
    inherited;
    DowMoveKeyPress(Key);
    end;
    procedure TxChildForm.KeyUp(var Key: Word; Shift: TShiftState);
    begin
    inherited;
    end;
    function TxChildForm.ShowQuery: Boolean;
    begin
    Result := True;
    if Assigned(FOnShowQuery) then
    FOnShowQuery(Self, Result);
    end;
    procedure TxChildForm.DowMoveKeyDown(var Key: Word; Shift: TShiftState);
    begin
    if FDosMove then
    begin
    // true if last active control is TCustomEdit and above
    FLastWasEdit := Self.ActiveControl is TCustomEdit;
    if (FDosMoveOptions <> []) then
    begin
    if Self.ActiveControl is TCustomGrid then
    begin
    if (Key = VK_RETURN) then
    begin
    Key := VK_TAB;
    FIsTabGrid := True;
    end;
    end
    else if Self.ActiveControl is TCustomMemo then //2006-02-25 Add by Qwang for TCustomMemo
    begin
    with (Self.ActiveControl as TCustomMemo) do
    if (Key = VK_UP) and (moUpDn in FDosMoveOptions) and (SelStart <
    Length(Lines.Strings[0])) then //光标在第一列时按VK_UP键
    Self.Perform(WM_NEXTDLGCTL, 1, 0)
    else if (Key = VK_DOWN) and (moUpDn in FDosMoveOptions) and (SelStart
    > (Length(Text) - Length(Lines.Strings[Lines.Count - 1]))) then //光标在最后一列时按VK_DOWN键
    Self.Perform(WM_NEXTDLGCTL, 0, 0);
    end
    else
    begin
    // Handle the specials keys
    if ((Key = VK_DOWN) and (moUpDn in FDosMoveOptions)) or ((Key =
    VK_RETURN) and (moEnter in FDosMoveOptions)) then
    Self.Perform(WM_NEXTDLGCTL, 0, 0)
    else if (Key = VK_UP) and (moUpDn in FDosMoveOptions) then
    Self.Perform(WM_NEXTDLGCTL, 1, 0);
    end;
    end; // if Options<>[] ...
    end; // if FActive ...
    end;
    procedure TxChildForm.DowMoveKeyPress(var Key: char);
    begin
    // Handle 'Enter' key that makes Edits beep
    if FDosMove then
    begin
    if FIsTabGrid then
    begin
    FIsTabGrid := False;
    Key := #0;
    end;
    end; // if FActive ...
    end;
    end.
    unit X.ChildFormDisplay;
    // create for y&f 2009-06-30
    interface
    uses
    Windows, Classes, Forms, SysUtils, Messages, Controls, ExtCtrls, ComCtrls,
    Generics.Collections, Dialogs, X.ChildForm;
    type
    TxChildFormDisplayChangeEvent = procedure(Sender: TObject; NewForm: TxChildForm; var Cancel: Boolean) of object;
    { TxChildFormDisplay }
    TxChildFormDisplay = class(TPanel)
    private
    FList: TList;
    FActiveFormIndex: Integer;
    FOnChange: TNotifyEvent;
    FOnChanging: TxChildFormDisplayChangeEvent;
    FTabControl: TTabControl;
    procedure SetActiveForm(aValue: TxChildForm);
    procedure SetActiveFormIndex(aValue: Integer);
    function GetFormCount: Integer;
    function GetActiveForm: TxChildForm;
    function GetForms(Index: Integer): TxChildForm;
    function GetFormIndex(Index: TxChildForm): Integer;
    procedure SetTabControl(const Value: TTabControl);
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFocus;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    protected
    //
    procedure Resize; override;
    //TabControl新的OnChange事件
    procedure TabControlChange(Sender: TObject);
    public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    //加载窗体
    function AddForm(aValue: TxChildForm; aDisplay: Boolean; aCaption: string = ''): Integer;
    function AddFormClass(aValue: TxChildFormClass; aDisplay: Boolean; aCaption: string = ''): Integer;
    function FindNextForm(CurForm: TxChildForm; GoForward: Boolean): TxChildForm;
    procedure HideForm(aValue: TxChildForm);
    procedure MoveForm(aValue: TxChildForm; NewIndex: Integer);
    procedure RemoveForm(aValue: TxChildForm; FreeForm: Boolean);
    procedure RemoveFormsAll(FreeForm: boolean);
    procedure ActiveNextForm(GoForward: Boolean);
    function ActiveFormByName(aValue: string): Boolean;
    public
    property ActiveFormIndex: Integer read FActiveFormIndex write SetActiveFormIndex;
    property ActiveForm: TxChildForm read GetActiveForm write SetActiveForm;
    property FormCount: Integer read GetFormCount;
    property Forms[index: Integer]: TxChildForm read GetForms;
    property FormIndex[index: TxChildForm]: Integer read GetFormIndex;
    published
    property TabControl: TTabControl read FTabControl write SetTabControl;
    property OnChanging: TxChildFormDisplayChangeEvent read FOnChanging write FOnChanging;
    // new introduced properties
    property Align;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BevelWidth;
    property Ctl3D;
    property Caption;
    property Font;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    end;
    implementation
    { TxChildFormDisplay }
    procedure TxChildFormDisplay.SetActiveForm(aValue: TxChildForm);
    var
    tmp: Integer;
    begin
    tmp := FList.IndexOf(aValue);
    if tmp <> -1 then
    SetActiveFormIndex(tmp);
    end;
    procedure TxChildFormDisplay.SetActiveFormIndex(aValue: Integer);
    var
    tmp: TxChildForm;
    cancel: Boolean;
    pf: TCustomForm;
    begin
    if aValue <> FActiveFormIndex then
    begin
    pf := GetParentForm(Self);
    // hide current page
    cancel := false;
    if Assigned(FOnChanging) then
    FOnChanging(self, Forms[aValue], cancel);
    if cancel then
    exit;
    if FActiveFormIndex <> -1 then
    begin
    if Assigned(pf) and Assigned(pf.Menu) and Assigned(TxChildForm(Forms[FActiveFormIndex]).Menu) then
    pf.Menu.Unmerge(TxChildForm(Forms[FActiveFormIndex]).Menu);
    HideForm(Forms[FActiveFormIndex]);
    end;
    FActiveFormIndex := aValue;
    if FActiveFormIndex = -1 then
    exit;
    // show new page
    tmp := Forms[FActiveFormIndex];
    if Assigned(pf) and Assigned(pf.Menu) and Assigned(TForm(tmp).Menu) then
    pf.Menu.Merge(TForm(tmp).Menu);
    if not tmp.HandleAllocated then
    tmp.HandleNeeded;
    try
    SetWindowLong(tmp.Handle, GWL_STYLE, WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
    SetWindowLong(tmp.Handle, GWL_EXSTYLE, 0);
    Windows.SetParent(tmp.Handle, Handle);
    // positionieren
    tmp.Align := alClient;
    tmp.BringToFront;
    finally
    tmp.Visible := True;
    tmp.SetFocus;
    if Assigned(TxChildForm(tmp).OnActivate) then
    TxChildForm(tmp).OnActivate(tmp); //JH, July 2001
    if Assigned(FOnChange) then
    FOnChange(self);
    end;
    if Assigned(FTabControl) then
    begin
    FTabControl.TabIndex := FActiveFormIndex;
    if Assigned(FTabControl.OnChange) then
    FTabControl.OnChange(FTabControl);
    end;
    end;
    end;
    procedure TxChildFormDisplay.SetTabControl(const Value: TTabControl);
    begin
    FTabControl := Value;
    if Assigned(FTabControl) then
    begin
    FTabControl.OnChange := Self.TabControlChange;
    end;
    end;
    function TxChildFormDisplay.GetFormCount: Integer;
    begin
    Result := FList.Count;
    end;
    function TxChildFormDisplay.GetForms(Index: Integer): TxChildForm;
    begin
    Result := nil;
    if Index < FList.Count then
    Result := TxChildForm(FList[index]);
    end;
    function TxChildFormDisplay.GetFormIndex(Index: TxChildForm): Integer;
    begin
    Result := FList.IndexOf(Index);
    end;
    function TxChildFormDisplay.GetActiveForm: TxChildForm;
    begin
    Result := nil;
    if (FActiveFormIndex <> -1) then
    Result := TxChildForm(FList[FActiveFormIndex]);
    end;
    procedure TxChildFormDisplay.WMSetFocus(var Message: TWMSetFocus);
    begin
    inherited;
    if TabStop and (ActiveForm <> nil) then
    if ActiveForm.ActiveControl <> nil then
    ActiveForm.SetFocus;
    end;
    procedure TxChildFormDisplay.CMDialogKey(var Message: TCMDialogKey);
    begin
    if (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
    begin
    ActiveNextForm(GetKeyState(VK_SHIFT) >= 0);
    Message.Result := 1;
    end
    else
    inherited;
    end;
    procedure TxChildFormDisplay.Resize;
    begin
    inherited Resize;
    if csDesigning in ComponentState then
    exit;
    if (FList.Count > 0) and Assigned(ActiveForm) then
    ReAlign;
    end;
    constructor TxChildFormDisplay.Create(aOwner: TComponent);
    begin
    inherited Create(aOwner);
    FList := TList.Create;
    FActiveFormIndex := -1;
    FTabControl := nil;
    end;
    destructor TxChildFormDisplay.Destroy;
    begin
    FList.Free;
    FActiveFormIndex := -1;
    inherited Destroy;
    end;
    function TxChildFormDisplay.AddForm(aValue: TxChildForm; aDisplay: Boolean; aCaption: string): Integer;
    begin
    Result := FList.Add(aValue);
    if Result <> -1 then
    begin
    if aCaption <> '' then
    aValue.Caption := aCaption;
    // prepare Form for use in TxChildFormDisplay
    aValue.Parent := Self;
    aValue.Visible := False;
    //TxChildForm(aValue).IsControl := True;
    if Assigned(FTabControl) then
    FTabControl.Tabs.Add(aValue.Caption);
    //边框等属性
    aValue.BorderStyle := bsNone;
    aValue.BorderIcons := [];
    aValue.Position := poDefault;
    aValue.TabStop := False;
    aValue.Align := alClient;
    if aDisplay then
    SetActiveFormIndex(Result);
    end;
    end;
    function TxChildFormDisplay.AddFormClass(aValue: TxChildFormClass; aDisplay: Boolean; aCaption: string): Integer;
    begin
    Result := AddForm(aValue.Create(self), aDisplay);
    end;
    function TxChildFormDisplay.FindNextForm(CurForm: TxChildForm; GoForward: Boolean): TxChildForm;
    var
    index: integer;
    begin
    Result := nil;
    Index := FList.IndexOf(CurForm);
    if (CurForm = nil) or (Index = -1) then
    exit;
    if GoForward then
    begin
    Inc(Index);
    while (Index < FList.Count) do
    if Assigned(FList[Index]) then
    begin
    Result := TxChildForm(FList[Index]);
    Exit;
    end
    else
    Inc(Index)
    end
    else
    begin
    Dec(Index);
    while (Index >= 0) do
    if Assigned(FList[Index]) then
    begin
    Result := TxChildForm(FList[Index]);
    Exit;
    end
    else
    Dec(index);
    end;
    end;
    procedure TxChildFormDisplay.HideForm(aValue: TxChildForm);
    var
    index: Integer;
    begin
    index := FList.IndexOf(aValue);
    if FActiveFormIndex <> index then
    exit;
    if Assigned(TxChildForm(aValue).OnDeactivate) then
    TxChildForm(aValue).OnDeactivate(aValue); //JH July 2001
    if Assigned(TxChildForm(aValue).OnHide) then
    TxChildForm(aValue).OnHide(aValue); //JH July 2001
    aValue.Align := alNone;
    aValue.Visible := False;
    FActiveFormIndex := -1;
    end;
    procedure TxChildFormDisplay.MoveForm(aValue: TxChildForm; NewIndex: Integer);
    var
    index, oldActiveIndex: Integer;
    begin
    index := FList.IndexOf(aValue);
    if index = -1 then
    exit;
    oldActiveIndex := FActiveFormIndex;
    if FActiveFormIndex <> -1 then
    HideForm(ActiveForm);
    FList.Move(index, NewIndex);
    if Assigned(FTabControl) then
    FTabControl.Tabs.Move(index, NewIndex);
    SetActiveFormIndex(oldActiveIndex);
    end;
    procedure TxChildFormDisplay.TabControlChange(Sender: TObject);
    begin
    if Assigned(FTabControl) then
    begin
    if FTabControl.TabIndex <> FActiveFormIndex then
    begin
    FTabControl.TabIndex := FActiveFormIndex;
    SetActiveFormIndex(FTabControl.TabIndex);
    end;
    end;
    end;
    procedure TxChildFormDisplay.RemoveForm(aValue: TxChildForm; FreeForm: Boolean);
    var
    index: Integer;
    begin
    index := FList.IndexOf(aValue);
    // 5.0, user report
    if index = -1 then
    exit;
    if FActiveFormIndex = index then
    HideForm(aValue);
    if Assigned(FTabControl) then
    FTabControl.Tabs.Delete(Index);
    FList.Remove(aValue);
    if index >= FList.Count then
    index := Pred(FList.Count);
    SetActiveFormIndex(index);
    if FreeForm then
    begin
    aValue.Free;
    aValue := nil;
    end;
    end;
    procedure TxChildFormDisplay.RemoveFormsAll(FreeForm: boolean);
    var
    i: Integer;
    begin
    for i := FList.Count - 1 downto 0 do
    RemoveForm(TxChildForm(FList.Items[i]), FreeForm);
    end;
    procedure TxChildFormDisplay.ActiveNextForm(GoForward: Boolean);
    begin
    SetActiveForm(FindNextForm(ActiveForm, GoForward));
    end;
    function TxChildFormDisplay.ActiveFormByName(aValue: string): Boolean;
    var
    i: Integer;
    begin
    Result := False;
    for i := 0 to Pred(FList.Count) do
    begin
    if TxChildForm(FList[i]).Caption = aValue then
    begin
    SetActiveFormIndex(i);
    Result := true;
    break;
    end
    end;
    end;
    end.

      回答于:2016-9-28 18:48:20      #2楼 奖励火柴:20
    用户头像
刷新 首页 上一页 下一页 末页 页次1/1页 共 2 条记录  转到:
x
您的任务被发布者审核为不合格

原因

详细说明

关于盒子问答
盒子问答为广大程序员提供一个迅速解决问题的好途径,帮助有编程疑惑的程序员轻松发问答。同时授业解惑的人,可以得到相应的收入。帮人解答并赚钱就来盒子问答。
联系我们
我们的服务支持邮件:webmaster@2ccc.com,支持qq:161945
如有建议或意见,可通过右侧“用户反馈”告诉我们
收藏本站
用户反馈