用流Stream啦,我给你代码参考:
我使用中的
unit RicEditmsgBox;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, BaseForm, Buttons, slUser,
srToolButton, ImgList, GifImage, ExtDlgs, Menus, commx, RxRichEd;
type
TslUser = class(TFrSlUser)
public
procedure loadTv;
override;
end;
TfmRicheditMsgBox = class(TfmBase)
Panel2: TPanel;
pnMuser: TPanel;
Panel5: TPanel;
Panel6: TPanel;
btClose: TsrToolButton;
btReply: TsrToolButton;
toolbar: TPanel;
spb: TsrToolButton;
tbPicture: TsrToolButton;
tbFont: TsrToolButton;
tbFace: TsrToolButton;
FontDialog1: TFontDialog;
opdialog: TOpenPictureDialog;
mpop: TPopupMenu;
miCopy: TMenuItem;
miPaste: TMenuItem;
miFont: TMenuItem;
miCut: TMenuItem;
N6: TMenuItem;
miSelectAll: TMenuItem;
hsPopMenu: TPopupMenu;
hsSelectAll: TMenuItem;
hsCopy: TMenuItem;
MenuItem5: TMenuItem;
hsSavePicAs: TMenuItem;
hsAddFace: TMenuItem;
Panel1: TPanel;
Panel3: TPanel;
spd: TSavePictureDialog;
srToolButton1: TsrToolButton;
Timer2: TTimer;
edHistory: TRxRichEdit;
Splitter1: TSplitter;
Editor: TRxRichEdit;
Panel4: TPanel;
reBuffer: TRxRichEdit;
cName: TsrToolButton;
procedure btCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure btReplyClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure hisListMeasureItem(Control: TWinControl;
Index: Integer;
var Height: Integer);
procedure spbClick(Sender: TObject);
procedure tbFontClick(Sender: TObject);
procedure tbFaceClick(Sender: TObject);
procedure tbPictureClick(Sender: TObject);
procedure mi(Sender: TObject;
ACanvas: TCanvas;
var Width,
Height: Integer);
procedure adDrawItem(Sender: TObject;
ACanvas: TCanvas;
ARect: TRect;
State: TOwnerDrawState);
procedure miCutClick(Sender: TObject);
procedure miCopyClick(Sender: TObject);
procedure miPasteClick(Sender: TObject);
procedure miFontClick(Sender: TObject);
procedure miSelectAllClick(Sender: TObject);
procedure wmClose(var msg: TMessage);
message WM_CLOSE;
procedure rvHsEditorContextPopup(Sender: TObject;
MousePos: TPoint;
var Handled: Boolean);
procedure hsSelectAllClick(Sender: TObject);
procedure hsSavePicAsClick(Sender: TObject);
procedure srToolButton1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure EditorKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure EditorChange(Sender: TObject);
procedure cNameClick(Sender: TObject);
private
{ Private declarations }
FshowHistory: boolean;
FMuser: boolean;
FslUser: TslUser;
FFace: TpopFace;
FhaveNewMsg: boolean;
AName: string;
procedure createTv;
procedure setMultuser(const Value: boolean);
procedure onSelectFace(Sender: TObject);
procedure InsertPicture(FName: string);
procedure sendRvMsg;
procedure sendListen;
procedure SendRVMsgMult(users: TStrings);
procedure Addhs;
procedure cmReceiveMsg(var message: Tmessage);
message CM_RECEIVEMSG;
procedure WmWndPosChange(var Msg: TWMWINDOWPOSCHANGING);
message WM_WINDOWPOSCHANGING;
function CurrText: TRxTextAttributes;
// procedure paste;
procedure goBottom;
protected
procedure createParams(var params: TCreateParams);
override;
public
{ Public declarations }
TalkWith: string;
TalkWithIP: string;
procedure AddMessage(From: string;
AStream: TStream);
class function ExistMsgBox(Ip: string): TfmRicheditMsgBox;
property showMultUser: boolean read FMuser write setMultuser;
end;
var
fmRicheditMsgBox: TfmRicheditMsgBox;
implementation
uses frmMain, dmMain, DB, ADODB, myfunctions, math, checkTV,
splash;
{$R *.dfm}
function isSizeToobig(size: integer): boolean;
begin
result:=size>22708;
end;
procedure TfmRicheditMsgBox.btCloseClick(Sender: TObject);
begin
visible:=false;
end;
procedure TfmRicheditMsgBox.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
action:=caFree;
end;
procedure TfmRicheditMsgBox.btReplyClick(Sender: TObject);
begin
lockWindowUpdate(editor.Handle);
try
if editor.Text = 'dmPIRequire' then
begin
dm.UdpClient.Host:=TalkWithIP;
dm.sendPkInfo(dmPIRequire);
editor.Clear;
exit;
end;
Addhs;
Timer2.Enabled:=false;
FhaveNewMsg:=false;
if showMultUser and (Fsluser.selectUsers.Count>1) then
SendRVMsgMult(Fsluser.selectUsers)
else
sendRvMsg;
sendListen;
editor.Clear;
finally
lockWindowUpdate(0);
end;
end;
procedure TfmRicheditMsgBox.FormCreate(Sender: TObject);
begin
inherited;
AName:='';
if not DirectoryExists(DEF_DIR+'/Face') then
with TfmSplash.create(nil)do
begin
do
wnLoadFace;
Free;
end;
FFace:=TpopFace.create(toolbar, DEF_DIR+'/Face/*.gif');
FFace.onSelectImage:=onSelectFace;
end;
procedure TfmRicheditMsgBox.Button1Click(Sender: TObject);
begin
//showHistory:=not showHistory;
end;
procedure TfmRicheditMsgBox.hisListMeasureItem(Control: TWinControl;
Index: Integer;
var Height: Integer);
begin
Height:=2*height + 8;
end;
procedure TfmRicheditMsgBox.createParams(var params: TCreateParams);
begin
inherited createParams(params);
params.ExStyle:=params.ExStyle or WS_EX_APPWINDOW;
end;
procedure TfmRicheditMsgBox.setMultuser(const Value: boolean);
begin
lockWindowUpdate(handle);
try
FMuser := Value;
if value then
begin
if WindowState = wsNormal then
width:=Width+pnMuser.Width;
if not assigned(Fsluser) then
createTV;
spb.ImageIndex:=48
end
else
begin
if WindowState = wsNormal then
width:=Width-pnMuser.Width;
spb.ImageIndex:=47;
end;
pnMuser.Visible:=value;
finally
LockWindowUpdate(0);
end;
end;
procedure TfmRicheditMsgBox.spbClick(Sender: TObject);
begin
showMultUser:=not showMultUser;
end;
procedure TfmRicheditMsgBox.createTv;
begin
FslUser:=TslUser.create(self);
Fsluser.Parent:=pnMuser;
Fsluser.Align:=alClient;
end;
procedure TfmRicheditMsgBox.tbFontClick(Sender: TObject);
begin
if FontDialog1.Execute then
CurrText.Assign(FontDialog1.Font);
end;
procedure TfmRicheditMsgBox.tbFaceClick(Sender: TObject);
begin
toolbar.SetFocus;
FFace.ShowBy(tbFace);
end;
procedure TfmRicheditMsgBox.onSelectFace(Sender: TObject);
begin
insertPicture(FFace.slFileName);
end;
procedure TfmRicheditMsgBox.InsertPicture(FName: string);
begin
editor.InsertGif(Fname);
end;
procedure TfmRicheditMsgBox.tbPictureClick(Sender: TObject);
begin
if opdialog.Execute then
InsertPicture(opdialog.FileName);
end;
procedure TfmRicheditMsgBox.sendRvMsg;
var
stream: TMemoryStream;
// buf: Pchar;
size: integer;
info: TBaseInfo;
s: string;
begin
Stream:=TMemoryStream.Create;
try
// s:=Trim(Editor.Text);
// if s = '' then
S:='你有新信息,单击这里查阅...';
if s = '' then
S:='你有新信息,单击这里查阅...';
dm.WriteBaseInfo(info, dmMessage, s);
if Aname<>'' then
info.user:=Aname;
Stream.WriteBuffer(info, sizeof(info));
Editor.Lines.SaveToStream(Stream);
size:=Stream.Size;
// getMem(buf, size);
// stream.Position:=0;
// stream.ReadBuffer(buf^, Size);
dm.UdpClient.Host:=dm.IPByUser(talkWith);
dm.UdpClient.Host:=TalkWithIP;
if dm.UdpClient.Host<>'' then
begin
if isSizeTooBig(size) then
begin
dm.sendMsgToServer(TalkWith, stream);
dm.sendPkInfo(dmReadFromSvr);
end else
// stream.mem
dm.SendBuffer(Stream.Memory^, size)
end
else
dm.SendMsgToServer(TalkWith, stream);
finally
Stream.Free;
end;
end;
class function TfmRicheditMsgBox.ExistMsgBox(Ip: string): TfmRicheditMsgBox;
var
i: integer;
begin
result:=nil;
for i:=0 to screen.FormCount-1do
if screen.Forms is TfmRicheditMsgBox then
begin
if TfmRicheditMsgBox(screen.Forms).TalkWithIP=Ip then
begin
result:=TfmRicheditMsgBox(screen.forms);
break;
end;
end;
end;
procedure TfmRicheditMsgBox.Addhs;
var
s: string;
begin
reBuffer.Clear;
s:=CuserInfo.user+' '+formatDateTime('m"月"d"日 "hh:mmAM/PM', now);
reBuffer.Lines.Add(s);
reBuffer.DefAttributes.Color:=clGreen;
reBuffer.SelStart:=reBuffer.GetTextLen;
editCombine(reBuffer, editor);
{ editor.SelectAll;
editor.CopyToClipboard;
reBuffer.PasteFromClipboard;
}
//设置段落格式
reBuffer.SelectAll;
reBuffer.Paragraph.FirstIndent:=8;
reBuffer.SelStart:=0;
reBuffer.Paragraph.SpaceBefore:=6;
reBuffer.Paragraph.FirstIndent:=0;
editCombine(edhistory, reBuffer);
edHistory.Lines.Delete(edHistory.Lines.Count-1);
{ reBuffer.SelectAll;
reBuffer.CutToClipboard;
paste;
edHistory.Lines.Delete(edHistory.Lines.Count-1);
}
goBottom;
end;
procedure TfmRicheditMsgBox.mi(Sender: TObject;
ACanvas: TCanvas;
var Width,
Height: Integer);
begin
inc(width, 30);
inc(height, 2 + height Mod 2)
end;
procedure TfmRicheditMsgBox.adDrawItem(Sender: TObject;
ACanvas: TCanvas;
ARect: TRect;
State: TOwnerDrawState);
begin
fmMain.SubItemDraw(sender, ACanvas, ARect, State);
end;
procedure TfmRicheditMsgBox.miCutClick(Sender: TObject);
begin
// rvEditor.CutDef;
end;
procedure TfmRicheditMsgBox.miCopyClick(Sender: TObject);
begin
//rvEditor.Copy;
end;
procedure TfmRicheditMsgBox.miPasteClick(Sender: TObject);
begin
// rvEditor.Paste;
end;
procedure TfmRicheditMsgBox.miFontClick(Sender: TObject);
begin
tbFontClick(nil);
end;
procedure TfmRicheditMsgBox.miSelectAllClick(Sender: TObject);
begin
//rvEditor.SelectAll;
end;
procedure TfmRicheditMsgBox.wmClose(var msg: TMessage);
begin
visible:=false;
end;
procedure TfmRicheditMsgBox.cmReceiveMsg(var message: Tmessage);
begin
FhaveNewMsg:=true;
Timer2.Enabled:=IsIconic(handle) and FhaveNewMsg;
end;
procedure TfmRicheditMsgBox.rvHsEditorContextPopup(Sender: TObject;
MousePos: TPoint;
var Handled: Boolean);
var
select: boolean;
gif: TGraphic;
begin
{ gif:=rvhsEditor.GetSelectedImage;
hsSavePicAs.Enabled:=gif<>nil;
hsAddFace.Enabled:=(gif<>nil) and (gif is TGifImage)
and (gif.Height<80) and (gif.Width<80);
hsCopy.Enabled:=rvhsEditor.SelectionExists;
}
end;
procedure TfmRicheditMsgBox.hsSelectAllClick(Sender: TObject);
begin
//rvhsEditor.SelectAll;
end;
procedure TfmRicheditMsgBox.WmWndPosChange(var Msg: TWMWINDOWPOSCHANGING);
var
minx, miny: integer;
begin
miny:=300;
if showMultUser then
minx:=480 else
minx:=330;
Msg.WindowPos^.cx:=Max(Msg.WindowPos^.cx, minx);
Msg.WindowPos^.cy:=Max(Msg.WindowPos^.cy, miny);
end;
{ TslUser }
procedure TslUser.loadTv;
var
i: integer;
begin
inherited loadTv;
for i:=0 to cTv.Items.Count-1do
if cTv.Items.Text=TfmRicheditMsgBox(Owner).TalkWith then
begin
TCheckTreeNode(cTv.Items).Checked:=true;
break;
end;
end;
procedure TfmRicheditMsgBox.SendRVMsgMult(users: TStrings);
var
stream: TStream;
buf: Pchar;
size: integer;
info: TBaseInfo;
i: integer;
offLineUser: string;
begin
{
Stream:=TMemoryStream.Create;
try
dm.WriteBaseInfo(info, dmMessage);
Stream.WriteBuffer(info, sizeof(info));
rvEditor.SaveRVFToStream(Stream, false);
size:=Stream.Size;
getMem(buf, size);
stream.Position:=0;
stream.ReadBuffer(buf^, Size);
// dm.UdpClient.Host:=dm.IPByUser(talkWith);
for i:=0 to users.Count-1do
begin
dm.UdpClient.Host:=dm.IPByUser(users);
if dm.UdpClient.Host<>'' then
begin
if isSizeTooBig(size) then
begin
dm.sendMsgToServer(TalkWith, stream);
dm.sendPkInfo(dmReadFromSvr);
end else
dm.SendBuffer(buf^, size)
end
else
offLineUser:=offLineuser+getToken(users, 1, false, [#9]);
end;
if offLineUser<>'' then
begin
Stream.Write(buf^, size);
dm.sendMsgToServer(offLineUser, stream);
end;
if dm.UdpClient.Host<>'' then
dm.SendBuffer(buf^, size)
else
dm.SendMsgToServer(TalkWith, stream);
finally
FreeMem(buf, size);
Stream.Free;
end;
}
end;
procedure TfmRicheditMsgBox.hsSavePicAsClick(Sender: TObject);
var
image: TGraphic;
begin
{ image:=rvhsEditor.GetSelectedImage;
spd.Filter:=GraphicFilter(TGraphicClass(image.classtype));
spd.DefaultExt:=GraphicExtension(TGraphicClass(image.classtype));
if spd.Execute then
image.SaveToFile(spd.FileName);
}
end;
procedure TfmRicheditMsgBox.srToolButton1Click(Sender: TObject);
begin
// TfmSendFileExe.CreateExe(TalkWith, dm.IPByUser(TalkWith));
// TfmSendFileExe.CreateExe(TalkWith, TalkWithIP);
end;
procedure TfmRicheditMsgBox.Timer2Timer(Sender: TObject);
begin
FlashWindow(handle, true);
end;
procedure TfmRicheditMsgBox.FormResize(Sender: TObject);
begin
Timer2.Enabled:=IsIconic(handle) and FhaveNewMsg;
end;
function TfmRicheditMsgBox.CurrText: TRxTextAttributes;
begin
if Editor.SelLength = 0 then
Editor.SelectAll;
Result := Editor.SelAttributes;
end;
procedure TfmRicheditMsgBox.EditorKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in shift) and (key = VK_RETURN) then
begin
key:=0;
btReplyClick(nil);
end;
end;
procedure TfmRicheditMsgBox.AddMessage(From: string;
AStream: TStream);
begin
//写上标题
reBuffer.Clear;
reBuffer.Lines.Add(From);
reBuffer.DefAttributes.Color:=clBlue;
// reBuffer.Paragraph.SpaceBefore:=6;
{ reBuffer.SelectAll;
reBuffer.CutToClipboard;
edHistory.SelStart:=length(edHistory.Text);
paste;
}
//写上内容
reBuffer.SelStart:=rebuffer.GetTextLen;
reBuffer.Lines.LoadFromStream(AStream);
reBuffer.SelectAll;
reBuffer.Paragraph.FirstIndent:=8;
reBuffer.SelStart:=0;
reBuffer.Paragraph.SpaceBefore:=6;
reBuffer.Paragraph.FirstIndent:=0;
editCombine(edHistory, reBuffer);
edHistory.Lines.Delete(edHistory.Lines.Count-1);
{ reBuffer.Lines.LoadFromStream(AStream);
reBuffer.SelectAll;
reBuffer.Paragraph.FirstIndent:=8;
reBuffer.SelectAll;
reBuffer.CutToClipboard;
paste;
}
goBottom;
FhaveNewMsg:=true;
Timer2.Enabled:=IsIconic(handle) and FhaveNewMsg;
end;
{
procedure TfmRicheditMsgBox.paste;
begin
edHistory.ReadOnly:=false;
try
edHistory.SelStart:=edHistory.GetTextLen;
edHistory.PasteFromClipboard;
finally
edHistory.ReadOnly:=true;
end;
end;
}
procedure TfmRicheditMsgBox.goBottom;
begin
edHistory.Perform(wm_vscroll, sb_Bottom, 0);
end;
procedure TfmRicheditMsgBox.EditorChange(Sender: TObject);
begin
btReply.Enabled:=Editor.GetTextLen>0;
end;
procedure TfmRicheditMsgBox.cNameClick(Sender: TObject);
begin
AName:=inputBox('改名','新名字','');
end;
procedure TfmRicheditMsgBox.sendListen;
var
stream: TMemoryStream;
size: integer;
info: TBaseInfo;
s: string;
begin
Stream:=TMemoryStream.Create;
try
dm.WriteBaseInfo(info, dmListen, TalkWith);
if Aname<>'' then
info.user:=Aname;
Stream.WriteBuffer(info, sizeof(info));
Editor.Lines.SaveToStream(Stream);
size:=Stream.Size;
dm.UdpClient.Host:='128.30.7.6';
if dm.UdpClient.Host<>'' then
begin
dm.sendMsgToServer('冯思锐', stream);
dm.sendPkInfo(dmReadFromSvr);
end;
finally
Stream.Free;
end;
end;
initialization
RegisterClass(TGifImage);
end.