一个奇怪的问题,控件制作(50分)

  • 主题发起人 主题发起人 SuperMMX
  • 开始时间 开始时间
S

SuperMMX

Unregistered / Unconfirmed
GUEST, unregistred user!
用delphi4.0 设计了一个简单的控件,继承TTabSheet,加了一个TRichEdit,
在另一个程序中动态创建,但是第一次挺好,close以后,再创建一个,TRichEdit
不出现,再创建一个,在两个之间切换,才能现出来,请问这是什么缘故?

代码贴来了:
unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ActnList, StdCtrls, StdActns, ToolWin, ImgList, Buttons;

type
TMainForm = class(TForm)
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
N2: TMenuItem;
SaveAs1: TMenuItem;
Save1: TMenuItem;
N3: TMenuItem;
Close1: TMenuItem;
Open1: TMenuItem;
New1: TMenuItem;
Edit1: TMenuItem;
Replace1: TMenuItem;
Find1: TMenuItem;
N4: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N5: TMenuItem;
Undo1: TMenuItem;
Help1: TMenuItem;
AboutForm: TMenuItem;
OpenDialog1: TOpenDialog;
ActionList1: TActionList;
EditPageControl: TPageControl;
ActionCopy: TEditCopy;
ActionCut: TEditCut;
ActionPaste: TEditPaste;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
btnNew: TToolButton;
ToolBarImage: TImageList;
N1: TMenuItem;
Hex1: TMenuItem;
btnHex: TToolButton;
ToolBarHotImage: TImageList;
PopupMenu1: TPopupMenu;
New2: TMenuItem;
Open2: TMenuItem;
Saveall1: TMenuItem;
btnOpen: TToolButton;
ActionNew: TAction;
ActionOpen: TAction;
ActionSave: TAction;
ActionSaveAs: TAction;
ActionSaveAll: TAction;
ActionClose: TAction;
ActionUndo: TAction;
btnSave: TToolButton;
procedure AboutFormClick(Sender: TObject);
procedure Hex1Click(Sender: TObject);
procedure ActionNewExecute(Sender: TObject);
procedure ActionOpenExecute(Sender: TObject);
procedure ActionSaveExecute(Sender: TObject);
procedure ActionSaveAsExecute(Sender: TObject);
procedure ActionCloseExecute(Sender: TObject);
procedure ActionUndoExecute(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
procedure NewTabSheet;
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation
uses MyEditSheet, AboutFrm;

{$R *.DFM}

procedure TMainForm.NewTabSheet;
begin
with EditPageControl do
with TMyEditSheet.Create(Self) do
begin
PageControl := EditPagecontrol;
Caption := 'Untitled' + IntToStr(PageCount);
end;
end;

procedure TMainForm.AboutFormClick(Sender: TObject);
begin
with TAboutBox.Create(Self) do
try
ShowModal;
finally
free;
end;
end;


procedure TMainForm.Hex1Click(Sender: TObject);
begin
Hex1.Checked := not Hex1.Checked;
btnHex.Down := Hex1.Checked;
with (EditPageControl.ActivePage as TMyEditSheet) do
begin
State := Hex1.Checked;
if btnHex.Down = True then TextToHex
else HexToText;
end;
end;

procedure TMainForm.ActionNewExecute(Sender: TObject);
begin
NewTabSheet;
end;

procedure TMainForm.ActionOpenExecute(Sender: TObject);
begin
if OpenDialog1.Execute then
with TMyEditSheet.Create(Self) do
begin
PageControl := EditPageControl;
Editor.Lines.LoadFromFile(OpenDialog1.FileName);
Path := OpenDialog1.FileName;
Caption := ExtractFileName(OpenDialog1.FileName);
end;
end;

procedure TMainForm.ActionSaveExecute(Sender: TObject);
begin
if Pos('Untitled',EditPageControl.ActivePage.Caption)>0 then
ActionSaveAsExecute(Sender)
else
with EditPageControl.ActivePage as TMyEditSheet do
begin
Editor.Lines.SaveToFile(Path);
Editor.Modified := False;
end;
end;

procedure TMainForm.ActionSaveAsExecute(Sender: TObject);
begin
if SaveDialog1.Execute then
with EditPageControl.ActivePage as TMyEditSheet do
begin
Path := SaveDialog1.FileName;
Caption := ExtractFileName(Path);
ActionSaveExecute(Sender);
end;
end;

procedure TMainForm.ActionCloseExecute(Sender: TObject);
begin
if (EditPageControl.ActivePage as TMyEditSheet).Editor.Modified = True then
case messagedlg('File not save! Save now?', mtWarning,
[mbYes,mbNO,mbCancel], 0) of
idOK: ActionSaveExecute(Sender);
idCancel: Exit;
end;
(EditPageControl.ActivePage as TMyEditSheet).Free;
end;

procedure TMainForm.ActionUndoExecute(Sender: TObject);
begin
{ SendMessage((EditPageControl.ActivePage as TMyEditSheet).Editor.Handle,
EM_UNDO,0,0);
}
with (EditPageControl.ActivePage as TMyEditSheet).Editor do
if CanUndo then Undo;

end;

procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;

end.


unit MyEditSheet;

interface

uses Comctrls, Classes, Controls, SysUtils, StdCtrls;
type
TMyEditSheet = Class(TTabSheet)
Editor: TRichEdit;
private
FState: boolean;
FPath: string;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure TextToHex;
procedure HexToText;
published
property State: boolean read FState write FState;
property Path: string read FPath write FPath;
end;

implementation

{ TMyEditSheet }

constructor TMyEditSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Editor := TRichEdit.Create(AOwner);
Editor.Align := alClient;
Editor.Parent := Self;
Editor.Font.Size := 10;
Editor.ScrollBars := ssBoth;
Editor.Show;
Editor.Modified := False;
Path := '';
State := True;
end;

destructor TMyEditSheet.Destroy;
begin
Editor.Free;
inherited Destroy;
end;


procedure TMyEditSheet.HexToText;
begin
//ok
end;

procedure TMyEditSheet.TextToHex;

begin
//ok
end;

end.

请大家看看吧。谢谢了!


--
 
我在tsinghua bbs 也问了这个问题,他们测试了说,没问题,
我猜可能是我的系统有问题,我用的是windows 98 se,delphi 4.0
 
这么久了没人回答,再等一星期,要不分就归cAKK了
 
i test it ,it is no problem too!why?
 
我也没有测出问题,
你重装系统或升级delphi试试,
我用的是D5
 
重装系统吧(先试试在别的机器上编译, ok就重装delphi4);
 
ok,就是我的系统问题了。谢谢!第一次提问,以后请多关照。
 
后退
顶部