Áèáëèîòåêà ïðîãðàììèðîâàíèå, ïðîãðàììèðîâàíèå, ÿçûêè ïðîãðàììèðîâàíèÿ, êíèãè ïðîãðàììèðîâàíèå Íà ñàéòå ïðåäñòàâëåíà èíôîðìàöèÿ ïðî ïðîãðàììèðîâàíèå â Èíòåðíåòå è ðàáîòó  

Ïåðåäà÷à òåêñòà â 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

Òîëüêî çäåñü 1000 ïîñåòèòåëåé íà Âàø ñàéò âñåãî çà 3 ó.å.!

- Íóæíî áðîñèòü íà êîìïîíåíò 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

Èíòåðíåò êàçèíî     Îíëàéí èãðû     Óâåëè÷åíèå ÷ëåíà     Êóïèòü DVD


Ãëàâíàÿ ñòðàíèöà | ãðàôè÷åñêîå ïðîãðàììèðîâàíèå | ÿçûê ïðîãðàììèðîâàíèÿ ñè | îôôøîðíîå ïðîãðàììèðîâàíèå | ïðîëîã ïðîãðàììèðîâàíèå | ïðîãðàììèðîâàíèå dos | ïðîãðàììèðîâàíèå ìîáèëüíûõ | ïðîãðàììèðîâàíèå ìèíè àòñ | âûïóêëîå ïðîãðàììèðîâàíèå | ïðîãðàììèðîâàíèå ìèêðîñõåì | ïðîãðàììèðîâàíèå ms | áèáëèîòåêà ïðîãðàììèðîâàíèå | ïðîãðàììèðîâàíèå 3d | ïðîãðàììèðîâàíèå j2me | ïðîãðàììèðîâàíèå ïîä windows | êîäû ïðîãðàììèðîâàíèÿ | ïðîãðàììèðîâàíèå ñòàòüè | asp ïðîãðàììèðîâàíèå | âåá ïðîãðàììèðîâàíèå | lotus ïðîãðàììèðîâàíèå | îïèñàíèÿ ÿçûêîâ ïðîãðàììèðîâàíèÿ | ïðèìåðû çàäà÷ ïðîãðàììèðîâàíèå | ïðîãðàììèðîâàíèå symbian | ïðîãðàììèðîâàíèå ëèòåðàòóðà | ââåäåíèå ïðîãðàììèðîâàíèå | ñðàâíåíèå ÿçûêîâ ïðîãðàììèðîâàíèÿ | Ññûëêè

Âñå ïðî âåá ïðîãðàììèðîâàíèå