delphi7开发，窗体显示问题- 问答悬赏

如何不接收本站短信和邮件提醒？
本站火柴有什么用？
发布问题流程

我也要发问题

加关注

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

√ 问题已解决

发布者 薛定谔的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 条记录转到：

您的任务被发布者审核为不合格

原因

详细说明

Delphi盒子-问答悬赏

常见问题更多

关注我们

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

任务详情

查看原图>>任务附件

Delphi盒子-问答悬赏

常见问题 更多

关注我们

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

任务详情

查看原图>>任务附件

常见问题更多