| Áèáëèîòåêà ïðîãðàììèðîâàíèå, ïðîãðàììèðîâàíèå, ÿçûêè ïðîãðàììèðîâàíèÿ, êíèãè ïðîãðàììèðîâàíèå | Íà ñàéòå ïðåäñòàâëåíà èíôîðìàöèÿ ïðî ïðîãðàììèðîâàíèå â Èíòåðíåòå è ðàáîòó |
|
Ïåðåäà÷à òåêñòà â Word Äèíàìè÷åñêàÿ Ãåíåðàöèÿ Êîìïîíåíòîâ, Äèíàìè÷åñêàÿ Ãåíåðàöèÿ Êîìïîíåíòîâ ìàòåìàòè÷åñêèå ôóíêöèè â Delphi, ãàóññîâñêèå êîýôôèöèåíòû ðàáîòà ñ ìàññèâîì "Æèðíîñòü" òåêñòà Îáúÿâëåíèå âñåì êòî çíàêîì ñ ICS Windows Clasic è WinXp [ñòèëü] Rave Reports, Delphi7 Excel, Êàê çàñòàâèòü Excel ñîçäàòü íîâûé ôàéë? Ïîëóïðîçðà÷íàÿ ôîðìà, Ôîðìà, ÷åðåç êîòîðóþ âèäåí ñòîë? Çàãðóçêà ðåãèîíà èç ôàéëà., Êàê çàãðóçèòü ðåãèîí îêíà èç ôàéëà? Èçìåíåíèå øðèôòà â ðàçíûõ ÎÑ-àõ,  ìîåé ïðîãðàììå ìåíÿåòñÿ øðèôò Êòî êàêèì ÿçûêîì ïîëüçóåòñÿ?, Ïîñìîòðèì ÷òî ïàñêàëèñòû ñåé÷àñ ëþáÿò Ïîìîãèòå ðàçîáðàòüñÿ ñ Quickrep(âûäàåò îøèáêó) Àáñîëþòíûé èëè îòíîñèòåëüíûé ïóòü? Õîðîøèé ñòèëü ïðîãðàììèðîâàíèÿ â Borland Delphi ×òî áûñòðåå? a[0..399,0..399] èëè a[0..400*400-1]?, íå ñîâñåì äåëôè Êàê âñòàâèòü êíîïêó â çàãîëîâîê ÷óæîãî îêíà? Äåðåâüÿ, ×òî ýòî òàêîå? ïîñìîòðèòå êîä ListView, Ðèñóíîê òóäû! Åùå âîïðîñ ïî ñëîæíûì êîìïîíåíòàì Íå ìîãó óñòàíîâèòü Package êàê ðàáîòàòü ñ radiobutton, êàê ðàáîòàòü ñ radiobutton Word Âûáîðêà èç ÁÄ => ListBox, Delphi 6 class var Ïîäïèñêà, Êàê ïðåêðàòèòü ïîäïèñêó? Êàê Âû îòíîñèòåñü ê êóðÿùèì äåâóøêàì? OLE Ñåðâåð, Âîçâðàò ïàðàìåòðà Word&Delphi Ñîçäàíèå ñëîæíîãî êîìïîíåíòà â Delphi Íèæíèå è âåðõíèå èíäåêñû â textout <<Êàê ñîçäàòü äåðåâî ïàïîê>> Àëãîðèòì Àðõèìåäà äëÿ ÷èñëà Ïè... Áèáëèîòåêà Gear32pd.dll, Èñïîëüçîâàíèå Âûâîä íà ýêðàí, Delphi 6 IdHTTP.Get è Post, îáúÿñíèòå ðàçíèöó... Îøèáêà! Îøèáêà! Îøèáêà!, A call to an OS function failed. Ãëþêè FastReport-a Ïðîáëåìà ñ âû÷èñëåíèåì ÷èñëà Ïè... !!!Ñðî÷íî!!!, Ïåðåäà÷à èìåíè ýë-òà, êîò. ïîä ôîêóñîì. Full Screen íà Äåëüôè, Êàê ñäåëàòü Full Screen ôîðìû? ×òî äåëàåò OnClose? âûçîâ ôóíêöèè â DLL Íàðèñîâàòü òåêñò íà êàíâå ïîä óãëîì Êîíâåðòèðîâàíèå DBF Êàê ñðàâíèòü òåêñò è ïîëó÷èòü îäèíàêîâûå ñëîâà Êàê ìíå â DELPHI5 çàñòàâèòü îòêðûâàòü EXE ôàéëû?, Îòêðûòèå EXE ôàéëîâ â DELPHI5 ? Ñðî÷íûé âîïðîñ ïî ñòðîêàì/ìàññèâàì, â DOS'e Ïîìîãèòå íàéòè êíèãó â Èíòåðíåòå, Ïîèñê èíôîðìàöèè Àëüòåðíàòèâíûå Áàçû Äàííûõ, Ìîé ôîðìàò ÁÄ è ìîäóëü[Delphi]äëÿ íåãî Âîïðîñ ïðî êîïèðîâàííèå, êàê ? Ïðî ñîêåòû è IE Word StringGrid & LoadFromFile, êàê îñóùåñòâèòü òàêîå COM StringGrid, êàê â êàæäîé ñòðîêå â êîëîíêå ¹2 óáðàòü Ïåðåõîä èç pascal â ñ++ Ðàçìåð ñòåêà, Íåïîíÿòêà Printscreen äâîéíûå ùåë÷êè â TTreeView Drag and Drop <<Ñåðèéíûé íîìåð âèíòà?>> Áîëüøàÿ ñòðóêòóðà ÷åðåç ñîêåòû êàê ÷åðåç àïè óáèòü ôàéë, êàê ÷åðåç àïè óáèòü ôàéë <<Ñàìûì, ñàìûì ...>> Ïåðåñå÷åíèå îòðåçêà è îêðóæíîñòè <<×òåíèå exe ïî ñåñèÿì>> ß÷åéêà â StringGrid, êàê çàêðàñèòü? |
Ïëàòíûå õîñòèíãè Ðàñêðóòêà ñàéòà Êíèãè ïî ïðîãðàììèðîâàíèþ Drag and Drop
- Íóæíî áðîñèòü íà êîìïîíåíò ListVew Ôàéëû è ïîëó÷èòü èõ ïóòè. Êàê ? - íàäî ðåàëèçîâàòü èíòåðôåéñ IDropTarget è çàðåãèòü åãî ñ ïîìîùüþ RegisterDragDrop, çàòåì ïîëó÷àòü èìåíà ôàéëîâ ïðè Drop. ß îáû÷íî äåëàþ òàê:Êîä unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ActiveX, StdCtrls, ShellAPI;type TForm1 = class(TForm, IDropTarget) procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function IDropTarget.DragOver = DragOver2; function DragOver2(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; end;var Form1: TForm1;implementation{$R *.dfm}{ TForm1 }function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var f: FORMATETC;begin ZeroMemory(@f, SizeOf(f)); f.cfFormat := CF_HDROP; f.lindex := -1; f.tymed := TYMED_HGLOBAL; if dataObj.QueryGetData(f) = S_OK then begin dwEffect := DROPEFFECT_COPY; Result := S_OK; end else Result := E_ABORT;end;function TForm1.DragLeave: HResult;begin Result := S_OK;end;function TForm1.DragOver2(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;begin dwEffect := DROPEFFECT_COPY; Result := S_OK;end;function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var f: FORMATETC; m: STGMEDIUM; i, cnt: Integer; fn: array[1..MAX_PATH] of Char;begin ZeroMemory(@f, SizeOf(f)); f.cfFormat := CF_HDROP; f.lindex := -1; f.tymed := TYMED_HGLOBAL; if dataObj.GetData(f, m) = S_OK then begin cnt := DragQueryFile(m.hGlobal, $FFFFFFFF, nil, 0); for i := 0 to cnt - 1 do begin DragQueryFile(m.hGlobal, i, @fn, MAX_PATH); ShowMessage(PChar(@fn)); end; if m.unkForRelease <> nil then IUnknown(m.unkForRelease)._Release; end; Result := S_OK;end;procedure TForm1.FormCreate(Sender: TObject);begin RegisterDragDrop(Handle, Self as IDropTarget);end;initialization OleInitialize(nil);finalization OleUninitialize;end.highlightSyntax('delphiM1YTFi','delphi'); - Âîò ñ ýòèì òðàáë:procedure TForm1.FormCreate(Sender: TObject);begin RegisterDragDrop(Handle, Self as IDropTarget);end;[Error] Operator not applicable to this operand type - RAdmin, ñòðÿííî... êàêàÿ ó òåáÿ âåðñèÿ äåëüôåé? - Áûâàåò òàêîå, ÷òî êàêîé-íèáóäü êëàññ/èíòåðôåéñ ïðîïèñàí â íåñêîëüêèõ þíèòàõ... Òîãäà òàêîå ìîãóò íàïèñàòü. Áûëî ó ìåíÿ ýòà æå ïðîáëåìà ñ IPersistFile (ïðîïèñàí â ActiveX è Ole2). - Ó ìåíÿ 5 à ó òåáÿ êàê ÿ âèæó ëèáî 6 ëèáî 7 - À ýòî ìîæåò áûòü èç-çà unit'a variants ? *(ÿ åãî âûêèíóë, èáî â D5 òàêèõ íåìà) - äà, ó ìÿ 6 è 7 è òàì è òàì ðàáîòàåò. Variants ñêîðåå âñåãî ñäåñü íè ïðè ÷åì. - Îïÿòü ÿ - ïîñìîòðè: IDropTarget åñòü è â ìîäóëå ActiveX è â Ole2... Òåáå íàäî þçàòü òîò ÷òî èç ActiveX.Ïîïðîáóé íà âñÿêèé ñëó÷àé òàê:Êîä RegisterDragDrop(Handle, Self as ActiveX.IDropTarget);highlightSyntax('delphiU0MmMz','delphi');Ó ìåíÿ, ïðàâäà, D7, ïîýòîìó ìîæåò òóò åðóíäó ãîâîðþ... Èçâèíÿþñü çà íàçîéëèâîñòü... - Âñ¸ ïîíÿòíî äëÿ D5 íàäî òàê RegisterDragDrop(Handle, Self) è âñ¸. - Ýòî êî âñåì âåðñèÿì ïîäõîäèò, à òîò äëèííûé ñïîñîá ïåðåõâàòûâàåò íå òîêà ôàéëû íî è âñ¸ ÷òî ïîïàëî... - Íåìíîãî íåäîäåëàíî, íî âñ¸æå ðàáîòàåòÊîä {##########################################################}{# #}{# Component: TMJOLE (ver. 1.0.1) #}{# Copyright: MJ Soft 2002 (Russia) FreeWare #}{# #}{# Êîìïîíåíò: TMJOLE (âåðñèÿ 1.0.1) #}{# Íàïèñàíî: MJ Soft 2002 (Ðîññèÿ, ã.Óôà) #}{# Ðàñïðîñòðàíåíèå: Áåñïëàòíî #}{# #}{# http://pascal.dax.ru/delphi/components/ #}{# e-mail: mj@pascal.dax.ru (mj@nekto.ru) #}{# #}{##########################################################}unit MJOLE;interfaceuses Windows, Messages, SysUtils, Classes, Controls, Graphics, ActiveX;type TOleDragObject = class; TDragType = (dtCopy, dtMove, dtLink, dtNone); TDragEvent = procedure(Sender: TObject; State: TDragState; Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; var DragType: TDragType) of object; TDropEvent = procedure(Sender: TObject; Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; var DragType: TDragType) of object; TDragContent = (edcText, edcBitmap, edcMetafile, edcFileList, edcOther); TMJOLE = class(TComponent, IUnknown, IDropTarget) private FDragOwner: TWinControl; FDragOwnerHandle: THandle; FActive: Boolean; FNActive: Boolean; FOnDrag: TDragEvent; FOnDrop: TDropEvent; FDragObj: TOleDragObject; procedure SetDragOwner(const Value: TWinControl); function GetAboutStr: String; function GetCopyrightStr: String; procedure SetActive(const Value: Boolean); procedure Run; procedure Stop; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property About: String read GetAboutStr; property Copyright: String read GetCopyrightStr; property DragOwner: TWinControl read FDragOwner write SetDragOwner; property Active: Boolean read FActive write SetActive; property OnDrag: TDragEvent read FOnDrag write FOnDrag; property OnDrop: TDropEvent read FOnDrop write FOnDrop; function DragEnter(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; end; TOleDragObject = class(TDragObject) private DataObj: IDataObject; FDataFormats: TStringList; FKeys: Longint; protected function GetText: String; function GetDragContent: TDragContent; function GetFileList: String; function GetBitmap: TBitmap; function GetStream(Format: Integer): TMemoryStream; function GethGlobal(Format: Integer): THandle; public constructor Create; virtual; destructor Destroy; override; function HasDataFormat(Format: Integer): Boolean; function DataObject: IDataObject; function AsText(Format: String): String; overload; function AsText(Format: Word): String; overload; property Keys: Longint read FKeys; property DataFormats: TStringList read FDataFormats; property Text: String read GetText; property FileList: String read GetFileList; property Bitmap: TBitmap read GetBitmap; property Stream[Format: Integer]: TMemoryStream read GetStream; property hGlobal[Format: Integer]: THandle read GethGlobal; property Content: TDragContent read GetDragContent; end;procedure Register;implementationtype PDropFiles = ^TDropFiles; TDropFiles = record pfiles: DWORD; pt: TPOINT; fNC: BOOL; fWide: BOOL; end;procedure Register;begin RegisterComponents('MJ', [TMJOLE]);end;function GetFormatName(AFormat: Integer): String;const FormatNames: array[1..16] of String = ('TEXT', 'BITMAP', 'METAFILEPICT', 'SYLK', 'DIF', 'TIFF', 'OEMTEXT', 'DIB', 'PALETTE', 'PENDATA', 'RIFF', 'WAVE', 'UNICODETEXT', 'ENHMETAFILE', 'HDROP', 'LOCALE');begin if (AFormat>=1) and (AFormat<=16) then Result := FormatNames[AFormat] else begin SetLength(Result, 128); SetLength(Result, GetClipboardFormatName(AFormat, PChar(Result), 128)); end;end;{ TMJOLE }constructor TMJOLE.Create(AOwner: TComponent);begin inherited; FActive := False; FNActive := False; if AOwner is TWinControl then FDragOwner := TWinControl(AOwner);end;destructor TMJOLE.Destroy;begin if FActive then Stop; inherited;end;function TMJOLE.GetAboutStr: String;begin Result := 'Component TMJOLE';end;function TMJOLE.GetCopyrightStr: String;begin Result := '2002 MJ Soft';end;function TMJOLE.DragEnter(const DataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var FormatEtc: IEnumFormatEtc; Fmt: TFormatEtc; Shift: TShiftState; DragEffect: TDragType;begin FDragObj := TOleDragObject.Create; FDragObj.DataObj := DataObj; FDragObj.FDataFormats.Clear; if DataObj.EnumFormatEtc(DATADIR_GET, FormatEtc)=S_OK then while FormatEtc.Next(1, Fmt, nil) = S_OK do FDragObj.FDataFormats.AddObject(GetFormatName(Fmt.cfFormat), TObject(Fmt.cfFormat)); FDragObj.FKeys := grfKeyState; Shift := []; if (MK_LBUTTON and grfKeyState<>0) then Shift := [ssLeft]; if (MK_RBUTTON and grfKeyState<>0) then Shift := Shift + [ssRight]; if (MK_MBUTTON and grfKeyState<>0) then Shift := Shift + [ssMiddle]; if (MK_CONTROL and grfKeyState<>0) then Shift := Shift + [ssCtrl]; if (MK_SHIFT and grfKeyState <> 0) then Shift := Shift + [ssShift]; if ($20 and grfKeyState<>0) then Shift := Shift+[ssAlt]; DragEffect := dtNone; pt := FDragOwner.ScreenToClient(pt); if Assigned(FOnDrag) then FOnDrag(Self, dsDragEnter, FDragObj, Shift, pt.X, pt.Y, DragEffect); case DragEffect of dtCopy: dwEffect := DROPEFFECT_COPY; dtMove: dwEffect := DROPEFFECT_MOVE; dtLink: dwEffect := DROPEFFECT_LINK; dtNone: dwEffect := DROPEFFECT_NONE; end; Result := S_OK;end;function TMJOLE.DragLeave: HResult;var DragEffect: TDragType;begin DragEffect := dtNone; if Assigned(FOnDrag) then FOnDrag(Self, dsDragLeave, FDragObj, [], -1, -1, DragEffect); if Assigned(FDragObj) then begin FdragObj.Free; FdragObj := nil; end; Result := S_OK;end;function TMJOLE.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var Shift: TShiftState; DragEffect: TDragType;begin Shift := []; if (MK_LBUTTON and grfKeyState<>0) then Shift := [ssLeft]; if (MK_RBUTTON and grfKeyState<>0) then Shift := Shift + [ssRight]; if (MK_MBUTTON and grfKeyState<>0) then Shift := Shift + [ssMiddle]; if (MK_CONTROL and grfKeyState<>0) then Shift := Shift + [ssCtrl]; if (MK_SHIFT and grfKeyState<>0) then Shift := Shift + [ssShift]; if ($20 and grfKeyState<>0) then Shift := Shift + [ssAlt]; DragEffect := dtNone; pt := FDragOwner.ScreenToClient(pt); if Assigned(FOnDrag) then FOnDrag(Self, dsDragMove, FDragObj, Shift, pt.X, pt.Y, DragEffect); case DragEffect of dtCopy: dwEffect := DROPEFFECT_COPY; dtMove: dwEffect := DROPEFFECT_MOVE; dtLink: dwEffect := DROPEFFECT_LINK; else dwEffect := DROPEFFECT_NONE; end; Result := S_OK;end;function TMJOLE.Drop(const DataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var Shift: TShiftState; DragEffect: TDragType;begin Shift := []; if (MK_LBUTTON and grfKeyState<>0) then Shift := [ssLeft]; if (MK_RBUTTON and grfKeyState<>0) then Shift := Shift + [ssRight]; if (MK_MBUTTON and grfKeyState<>0) then Shift := Shift + [ssMiddle]; if (MK_CONTROL and grfKeyState<>0) then Shift := Shift + [ssCtrl]; if (MK_SHIFT and grfKeyState<>0) then Shift := Shift + [ssShift]; if ($20 and grfKeyState<>0) then Shift := Shift + [ssAlt]; DragEffect := dtNone; pt := FDragOwner.ScreenToClient(pt); if Assigned(FOnDrop) then FOnDrop(Self, FDragObj, Shift, pt.X, pt.Y, DragEffect); case DragEffect of dtCopy: dwEffect := DROPEFFECT_COPY; dtMove: dwEffect := DROPEFFECT_MOVE; dtLink: dwEffect := DROPEFFECT_LINK; dtNone: dwEffect := DROPEFFECT_NONE; end; if Assigned(FDragObj) then begin FDragObj.Free; FDragObj := nil; end; Result := S_OK;end;procedure TMJOLE.SetActive(const Value: Boolean);begin if (FActive=Value) then Exit; if (FDragOwner=nil) and (Value=True) then begin FNActive := True; Exit; end; FNActive := False; FActive := Value; if not(csDesigning in ComponentState) then if Value then Run else Stop;end;procedure TMJOLE.SetDragOwner(const Value: TWinControl);var RActive: Boolean;begin if FDragOwner=Value then Exit; RActive := FActive; Active := False; FDragOwner := Value; if RActive or FNActive then Active := True; if Value<>nil then Value.FreeNotification(Self)end;procedure TMJOLE.Notification(AComponent: TComponent; Operation: TOperation);begin inherited; if (Operation=opRemove) and (AComponent=FDragOwner) then DragOwner := nil;end;procedure TMJOLE.Run;var HRes: HResult; Obj: IDropTarget;begin FDragOwnerHandle := FDragOwner.Handle; if not GetInterface(IUnknown, Obj) then raise Exception.Create('GetInterface failed'); HRes := RegisterDragDrop(FDragOwnerHandle, Obj as IDropTarget); case HRes of S_OK, DRAGDROP_E_ALREADYREGISTERED:; DRAGDROP_E_INVALIDHWND: raise Exception.Create('RegisterDragDrop âåðíóëà îøèáêó, íåâåðíûé äåñêðèïòîð îêíà'); E_OUTOFMEMORY: raise Exception.Create('RegisterDragDrop âåðíóëà îøèáêó, ñèñòåìà íå âûäåëèëà ïàìÿòü'); E_INVALIDARG: raise Exception.Create('RegisterDragDrop âåðíóëà îøèáêó, íåâåíûå àðãóìåíòà'); CO_E_NOTINITIALIZED: raise Exception.Create('RegisterDragDrop âåðíóëà îøèáêó, coInitialize had not been called'); else raise Exception.Create('RegisterDragDrop âåðíóëà îøèáêó, íåèçâåñòíàÿ îøèáêà ñ êîäîì ' + IntToStr(HRes and $7FFFFFFF)); end;end;procedure TMJOLE.Stop;begin RevokeDragDrop(FDragOwnerHandle);end;{ TOleDragObject }function TOleDragObject.AsText(Format: String): String;var Fmt: TFormatEtc; EFE: IEnumFORMATETC; FMTCount: Longint; MDM: TStgMedium; PCh: PChar;begin Result := ''; FillChar(FMT, SizeOf(FMT), 0); DataObj.EnumFormatEtc(DATADIR_GET, EFE); EFE.Reset; repeat FMTCount := 0; EFE.Next(1, FMT, @FMTCount); until (GetFormatName(FMT.cfFormat)=Format) or (FMTCount=0); if GetFormatName(FMT.cfFormat)<>Format then Exit; FMT.tymed := TYMED_HGLOBAL; FMT.lindex := -1; if DataObj.GetData(FMT, MDM)=S_OK then try if MDM.tymed=TYMED_HGLOBAL then begin PCh := GlobalLock(MDM.hGlobal); Result := StrPas(PCh); GlobalUnlock(MDM.hGlobal); end; finally if Assigned(MDM.unkForRelease) then Iunknown(MDM.unkForRelease)._Release; end;end;function TOleDragObject.AsText(Format: Word): String;var Fmt: TFormatEtc; EFE: IEnumFORMATETC; FMTCount: Longint; MDM: TStgMedium; PCh: PChar;begin Result := ''; FillChar(FMT, SizeOf(FMT), 0); DataObj.EnumFormatEtc(DATADIR_GET, EFE); EFE.Reset; repeat FMTCount := 0; EFE.Next(1, FMT, @FMTCount); until (FMT.cfFormat=Format) or (FMTCount=0); if FMT.cfFormat<>Format then Exit; FMT.tymed := TYMED_HGLOBAL; FMT.lindex := -1; if DataObj.GetData(FMT, MDM)=S_OK then try if MDM.tymed=TYMED_HGLOBAL then begin PCh := GlobalLock(MDM.hGlobal); Result := StrPas(PCh); GlobalUnlock(MDM.hGlobal); end; finally if Assigned(MDM.unkForRelease) then Iunknown(MDM.unkForRelease)._Release; end;end;constructor TOleDragObject.Create;begin inherited; FDataFormats := TStringList.Create;end;function TOleDragObject.DataObject: IDataObject;begin Result := DataObj;end;destructor TOleDragObject.Destroy;begin FDataFormats.Free; inherited;end;function TOleDragObject.GetBitmap: TBitmap;var mdm: TStgMedium; fmt: TFormatEtc; Pict: TBitmap; Data: THandle; Palette: HPALETTE; EnumFormatEtc: IEnumFormatEtc;begin Result := nil; if not (Assigned(DataObj) and HasDataFormat(CF_BITMAP)) then Exit; if DataObj.EnumFormatEtc(DATADIR_GET, EnumFormatEtc)<>S_OK then Exit; Pict := TBitmap.Create; EnumFormatEtc.Reset; while EnumFormatEtc.Next(1, fmt, nil)=S_OK do begin if fmt.cfFormat=CF_BITMAP then begin try if (DataObj.GetData(fmt, mdm)<>S_OK) or (mdm.tymed<>TYMED_GDI) then begin Pict.Free; Exit; end; Data := mdm.hBitmap; finally if Assigned(mdm.unkForRelease) then Iunknown(mdm.unkForRelease)._Release; end; if mdm.tymed<>TYMED_GDI then begin Pict.Free; Exit; end; EnumFormatEtc.Reset; Palette := 0; FillChar(fmt, SizeOf(fmt), 0); try Pict.LoadFromClipboardFormat(CF_BITMAP, Data, Palette); Result := Pict; except end; Exit; end; end; Pict.Free;end;function TOleDragObject.GetDragContent: TDragContent;begin if HasDataFormat(CF_ENHMETAFILE) then Result := edcMetaFile else if HasDataFormat(CF_METAFILEPICT) then Result := edcMetaFile else if HasDataFormat(CF_BITMAP) then Result := edcBitmap else if HasDataFormat(CF_HDROP) then Result := edcFileList else if HasDataFormat(CF_TEXT) then Result := edcText else Result := edcOther;end;function TOleDragObject.GetFileList: String;var mdm: TStgMedium; pz: pchar; pdf: PDropFiles; fmt: TFormatEtc; s: string;begin Result := ''; if (not Assigned(DataObj)) or (not HasDataFormat(CF_HDROP)) then Exit; FillChar(fmt, SizeOf(fmt), 0); fmt.cfFormat := CF_HDROP; fmt.tymed := TYMED_HGLOBAL; fmt.lindex := -1; if DataObj.GetData(fmt, mdm)<>S_OK then Exit; try if mdm.tymed=TYMED_HGLOBAL then begin pdf := GlobalLock(mdm.hGlobal); pz := PChar(pdf); Inc(pz, pdf^.pfiles); if not (pdf.fWide) then while (pz[0]<>#0) do begin Result := Result+String(pz)+#13#10; Inc(pz, 1+StrLen(pz)); end else while (pz[0] <> #0) do begin s := WideCharToString(PWideChar(pz)); Result := Result+s+#13#10; Inc(pz, Length(s)*2+2); end; GlobalUnlock(mdm.HGlobal); end; finally if Assigned(mdm.unkForRelease) then IUnknown(mdm.unkForRelease)._Release; end;end;function TOleDragObject.GethGlobal(Format: Integer): THandle;var mdm: TStgMedium; fmt: TFormatEtc;begin Result := THandle(-1); if (not Assigned(DataObj)) or (not HasDataFormat(Format)) then Exit; FillChar(fmt, SizeOf(fmt), 0); fmt.cfFormat := Format; fmt.tymed := TYMED_HGLOBAL; fmt.lindex := -1; if DataObj.GetData(fmt, mdm)<>S_OK then Exit; if mdm.tymed=TYMED_HGLOBAL then Result := mdm.hGlobal; if Assigned(mdm.unkForRelease) then IUnknown(mdm.unkForRelease)._Release;end;function TOleDragObject.GetStream(Format: Integer): TMemoryStream;var mdm: TStgMedium; pdf: Pointer; sdf: DWORD; fmt: TFormatEtc; S: TMemoryStream;begin Result := nil; if (not Assigned(DataObj)) or (not HasDataFormat(Format)) then Exit; FillChar(fmt, SizeOf(fmt), 0); fmt.cfFormat := Format; fmt.tymed := TYMED_HGLOBAL; fmt.lindex := -1; if DataObj.GetData(fmt, mdm)<>S_OK then Exit; try if mdm.tymed=TYMED_HGLOBAL then begin pdf := GlobalLock(mdm.hGlobal); sdf := GlobalSize(mdm.hGlobal); try S := TMemoryStream.Create; try S.Size := sdf; Move(pdf^, S.Memory^, sdf); Result := S; except S.Free; end; finally GlobalUnlock(mdm.HGlobal); end; end; finally if Assigned(mdm.unkForRelease) then IUnknown(mdm.unkForRelease)._Release; end;end;function TOleDragObject.GetText: String;var FMT: TFormatEtc; EFE: IEnumFORMATETC; FMTCount: Longint; MDM: TStgMedium; PCh: PChar;begin Result := ''; FillChar(FMT, SizeOf(FMT), 0); DataObj.EnumFormatEtc(DATADIR_GET, EFE); EFE.Reset; repeat FMTCount := 0; EFE.Next(1, FMT, @FMTCount); until (FMT.cfFormat=CF_TEXT) or (FMTCount=0); if FMT.cfFormat<>CF_TEXT then Exit; FMT.tymed := TYMED_HGLOBAL; FMT.lindex := -1; if DataObj.GetData(FMT, MDM)=S_OK then try if (FMT.cfFormat=CF_TEXT) and (MDM.tymed=TYMED_HGLOBAL) then begin PCh := GlobalLock(MDM.hGlobal); Result := StrPas(PCh); GlobalUnlock(MDM.hGlobal); end; finally if Assigned(MDM.unkForRelease) then Iunknown(MDM.unkForRelease)._Release; end;end;function TOleDragObject.HasDataFormat(Format: Integer): Boolean;var FMT: TFormatEtc; EFE: IEnumFORMATETC; FMTCount: Longint;begin if not Assigned(DataObj) then begin Result := False; Exit; end; FillChar(FMT, SizeOf(FMT), 0); DataObj.EnumFormatEtc(DATADIR_GET, EFE); EFE.Reset; repeat FMTCount := 0; if EFE.Next(1, FMT, @FMTCount)<>S_OK then Break; until (FMT.cfFormat=Format) or (FMTCount=0); Result := (FMT.cfFormat=Format);end;initialization OleInitialize(nil);finalization OleUninitialize;end.highlightSyntax('delphiNlMDk1','delphi'); Ýòî ñîîáùåíèå îòðåäàêòèðîâàë pascal - 9.8.2003, 17:04 |