КАПУСТА: почитай,обсуди,отдохни! |
Привет, Гость! Войдите или зарегистрируйтесь.
Вы здесь » КАПУСТА: почитай,обсуди,отдохни! » Сеть в DELPHI » Интернетовский чат
Все активные модераторы,которые помогают развивать форум тоже его владельцы, так что не напрягайся он и твой
Пасибо конечно 
Вот так можно вставить картинку в формате Bitmap в позицию курсора в TRichEdit:
unit re_bmp;
interface
uses Windows;
procedure InsertBitmapToRE(Wnd:HWND; Bmp:HBITMAP);
implementation
uses Activex, RichEdit;
const
IID_IDataObject: TGUID = (
D1:$0000010E;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleObject: TGUID = (
D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
REO_CP_SELECTION = ULONG(-1);
REO_IOB_SELECTION = ULONG(-1);
REO_GETOBJ_POLEOBJ = $00000001;
type
TReobject = record
cbStruct: DWORD;
cp: ULONG;
clsid: TCLSID;
poleobj: IOleObject;
pstg: IStorage;
polesite: IOleClientSite;
sizel: TSize;
dvAspect: Longint;
dwFlags: DWORD;
dwUser: DWORD;
end;
type
IRichEditOle = interface(IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out reobject: TReObject;
dwFlags: DWORD): HResult; stdcall;
function InsertObject(var reobject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID;
lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR;
lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD;
out dataobj: IDataObject): HResult; stdcall;
function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
hMetaPict: HGLOBAL): HResult; stdcall;
end;
TImageDataObject=class(TInterfacedObject,IDataObject)
private
FBmp:HBITMAP;
FMedium:TStgMedium;
FFormatEtc: TFormatEtc;
procedure SetBitmap(bmp:HBITMAP);
function GetOleObject(OleClientSite:IOleClientSite; Storage:IStorage):IOleObject;
destructor Destroy;override;
// IDataObject
function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall;
function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
function DAdvise(const formatetc: TFormatEtc; advf: Longint;
const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
function DUnadvise(dwConnection: Longint): HResult; stdcall;
function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
public
procedure InsertBitmap(wnd:HWND; Bitmap:HBITMAP);
end;
{ TImageDataObject }
function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: Integer;
const advSink: IAdviseSink; out dwConnection: Integer): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.DUnadvise(dwConnection: Integer): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.EnumFormatEtc(dwDirection: Integer; out enumFormatEtc: IEnumFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult;
begin
Result:=E_NOTIMPL;
end;
function TImageDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;
destructor TImageDataObject.Destroy;
begin
ReleaseStgMedium(FMedium);
end;
function TImageDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
begin
medium.tymed := TYMED_GDI;
medium.hBitmap := FMedium.hBitmap;
medium.unkForRelease := nil;
Result:=S_OK;
end;
function TImageDataObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
begin
FFormatEtc := formatetc;
FMedium := medium;
Result:= S_OK;
end;
procedure TImageDataObject.SetBitmap(bmp: HBITMAP);
var
stgm: TStgMedium;
fm:TFormatEtc;
begin
stgm.tymed := TYMED_GDI;
stgm.hBitmap := bmp;
stgm.UnkForRelease := nil;
fm.cfFormat := CF_BITMAP;
fm.ptd := nil;
fm.dwAspect := DVASPECT_CONTENT;
fm.lindex := -1;
fm.tymed := TYMED_GDI;
SetData(fm, stgm, FALSE);
end;
function TImageDataObject.GetOleObject(OleClientSite: IOleClientSite; Storage: IStorage):IOleObject;
begin
if (Fmedium.hBitmap=0) then Result:=nil else
OleCreateStaticFromData(self, IID_IOleObject, OLERENDER_FORMAT, @FFormatEtc, OleClientSite, Storage, Result);
end;
procedure TImageDataObject.InsertBitmap(wnd:HWND; Bitmap: HBITMAP);
var
OleClientSite:IOleClientSite;
RichEditOLE:IRichEditOLE;
Storage:IStorage;
LockBytes:ILockBytes;
OleObject:IOleObject;
reobject:TReobject;
clsid:TGUID;
begin
if (SendMessage(wnd, EM_GETOLEINTERFACE, 0, cardinal(@RichEditOle))=0) then exit;
FBmp:=CopyImage(Bitmap,IMAGE_BITMAP,0,0,0);
if FBmp=0 then exit;
try
SetBitmap(Fbmp);
RichEditOle.GetClientSite(OleClientSite);
if (OleClientSite=nil) then exit;
CreateILockBytesOnHGlobal(0, TRUE,LockBytes);
if (LockBytes = nil) then exit;
if (StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0,Storage)<> S_OK) then
begin
LockBytes._Release;
exit
end;
if (Storage = nil) then exit;
OleObject:=GetOleObject(OleClientSite, Storage);
if (OleObject = nil) then exit;
OleSetContainedObject(OleObject, TRUE);
ZeroMemory(@reobject, sizeof(TReobject));
reobject.cbStruct := sizeof(TReobject);
OleObject.GetUserClassID(clsid);
reobject.clsid := clsid;
reobject.cp := REO_CP_SELECTION;
reobject.dvaspect := DVASPECT_CONTENT;
reobject.poleobj := OleObject;
reobject.polesite := OleClientSite;
reobject.pstg := Storage;
RichEditOle.InsertObject(reobject);
finally
DeleteObject(FBmp)
end
end;
procedure InsertBitmapToRE(Wnd:HWND; bmp:HBITMAP);
begin
with TImageDataObject.Create do
try
InsertBitmap(Wnd,Bmp);
finally
Free
end
end;
end.Примеры использования:
uses re_bmp; procedure TForm1.Button1Click(Sender: TObject); begin InsertBitmapToRE(RichEdit1.Handle,Image1.Picture.Bitmap.Handle); end; ... procedure TForm1.Button2Click(Sender: TObject); var bmp:TBitmap; begin if (not OpenPictureDialog1.Execute) then exit; bmp:=TBitmap.Create; try bmp.LoadFromFile(OpenPictureDialog1.Filename); InsertBitmapToRE(RichEdit1.Handle,bmp.Handle); finally bmp.Free end end;
Таким же образом можно вставлять картинки не только в TRichEdit, но и в RxRichEdit, стандартный виндовый RichEdit, etc.
От меня: Т.е нужно первый текст впихнуть в модуль а в основной программе его использовать и при вставке использовать функцию, приведённую во втором коде.
Спасибо!!
Но вот видишь, я вот это сделал в чате и когда я нажимаю картинку со смайлом, то картинка идет в Edit1(TrichEdit), после этого поидее как во всех чатах нужно нажимать ИНТЕР, нажимаю и вот эта картинка должна идти в само окно переписки, КАК ЭТО СДЕЛАТЬ?? поподробнее!!!! и чтоб эта картинка передовалась другому пользователю, а то только у себя я её вижу!!!
Я как раз столкнулся с этой же проблемой, сейчас думаю как её решить, всё зависит от того: можно ли определьть на какой позиции в тексте стоит картинка, и какая именно, если да, то решается в два счёта, если нет, то придётся думать, как протестирую напишу.
Ну как там продвижение в работе??
Пока не было времени... Ты скажи в свойстве Memo1.Text как нибудь можно увидеть картинку, которая вставлена?
Насчет этого я не знаю!! А че ты не воспользуешься RichEdit???
А по передачи файлов по интернету у тебя есть какая нибудь инфа??
Я вот нашел предачу данных через сокеты, ну че то он не передает
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
Reciving: boolean;
DataSize: integer;
Data: TMemoryStream;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Image1Click(Sender: TObject);
begin
// Это процедура для открытия сокета на ПРИЁМ (RECEIVING).
// Button1.Click is this procedure as well.
ClientSocket1.Active:= true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Открытие ОТПРАВЛЯЮЩЕГО (SENDING) сокета.
ServerSocket1.Active:= true;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Посылаем команду для начала передачи файла.
Socket.SendText('send');
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s, sl: string;
begin
s:= Socket.ReceiveText;
// Если мы не в режиме приёма:
if not Reciving then
begin
// Теперь нам необходимо получить длину потока данных.
SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(s), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Удаляем информацию о размере из данных.
Delete(s, 1, Length(sl));
Reciving:= true;
end;
// Сохраняем данные в файл, до тех пор, пока не получим все данные.
try
Data.Write(s[1], length(s));
if Data.Size = DataSize then
begin
Data.Position:= 0;
Image2.Picture.Bitmap.LoadFromStream(Data);
Data.Free;
Reciving:= false;
Socket.Close;
end;
except
Data.Free;
end;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ms: TMemoryStream;
begin
// Клиент получает команду на передачу файла.
if Socket.ReceiveText = 'send' then
begin
ms:= TMemoryStream.Create;
try
// Получаем данные на передачу.
Image1.Picture.Bitmap.SaveToStream(ms);
ms.Position:= 0;
// Добавляем длину данных, чтобы клиент знал, сколько данных будет передано
// Добавляем #0 , чтобы можно было определить, где заканчивается информация о размере.
Socket.SendText(IntToStr(ms.Size) + #0);
// Посылаем его.
Socket.SendStream(ms);
except
// Итак, осталось освободить поток, если что-то не так.
ms.Free;
end;
end;
end;
end.
Насчет этого я не знаю!! А че ты не воспользуешься RichEdit???
Ну это не суть важно Memo, или RichEdit, главное, чтобы в сойстве было видно картинку.
А разве предыдущий код не работает, который ты мне давно ещё дал?
Я пробовал, работал, давольно удобно там всё сделано. Но в крайнем случае можно и самому написать, тут же всё просто! Отправляющий файл открываешь, и буферами, по килобайту передаёш, принимаюший тут же принимает и пишет в файл, всё ничего сверхестественного нет. Позже посмотрю твой код, и отпишусь.
Посмотрел твой код, у меня всё работает, только там кнопка не нужна не знаю зачем она введена, видимо из проги выдрано, или тестили прогу. Низнаю смотри у себя. А ты host:=localhost; port:=<любой, но одинаковый у сервера и у клиента> выставил?
Но всё равно код даже в работающем варианте не представляет ценности. Он передаёт одним большим буфером. Вроде передачу с прогресс баром ввести нельзя. Да и оперативу может перегрузить. Да и если файл большой, а передаёт через инет, то придётся прогу держать включеную дня два-три, это не для всех удобно. Я говорю нужно сделать самому с пережачей буфера размером 1Кб. С возможностью докачки. Позже подумаю над этим.
На счёт отображения смайлов в RichEdit:
Посмотрел, при вставке картинки в RichEdit, в его свойстве Text, весь текст отображается нормально, картинка же отображается почему то кодом пробела, в этом то и проблема, если бы код был уникален, тогда можно было бы однозначно определить что это смайл такой-то, но этого сделать нельзя, как нельзя сделать такую вещь:
RichEdit1.Text:=RichEdit1.Text+'qwerty';, при вставленой картинке, тогда картинка превратится в пробел. Выход из этого есть и как ни странно я его описывал на первой странице этой темы. Нужно просто весь текст держать в переменной, и при его изменении очищать RichEdit, и заново програмно забивать туда уже с картинкой, а RichEdit1.Text:=RichEdit1.Text+'qwerty' можно обойти, и получить тот же результат, вобщем вот код:
procedure TForm1.Memo1Change(Sender: TObject); var i:integer; begin RichEdit1.Clear; for i:=1 to length(Memo1.Text) do if copy(Memo1.Text,i,2)=':)' then InsertBitmapToRE(RichEdit1.Handle,Image1.Picture.Bitmap.Handle); else RichEdit1.Perform(WM_CHAR, ord(Memo1.Text[i]),0); end;
Вобщем на форму ставиш Memo1, RichEdit1, Image1. В Image1 грузиш смайл, пишешь в Memo1, и там уже можно использовать сочетание ": )", и в RichEdit1, отобразится смайл вместо символов!
В коде есть недочёт, за место ": )" заменяется только":", ну думаю разберёшся.
А как передать собеседнику, это нет проблем: на стороне другого клиента точно так же "конвентировать" текст.
Вы здесь » КАПУСТА: почитай,обсуди,отдохни! » Сеть в DELPHI » Интернетовский чат