nyuuzyou/wikis huggingface dataset:
Передача параметров ADO запросу

=== Передача параметров ADO запросу ===
CONECT_STR = 'Provider=Microsoft.Jet.OLEDB.4.0;Password=" " ;User ID=Admin;' + {Data Source=D:\ExBd\ТЕРМО\Bd0.mdb;}
'Data Source=%s; Mode=Read|Write|Share Deny None;Extended Properties=" " ;' +
'Locale Identifier=1049;Persist Security Info=True;Jet OLEDB:System database=" " ;' +
'Jet OLEDB:Registry Path=" " ;Jet OLEDB:Database Password=" " ;Jet OLEDB:Engine Type=4;' +
'Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;' +
'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=" " ;' +
'Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;' +
'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
function TdmR3.GetCountForPeriod(LastDate: TDateTime; IsPlan: boolean): Integer;
var qu: TADOQuery;
 S: string;
begin
 qu := TADOQuery.Create(nil);
 try
 S := FormatDateTime('dd.mm.yy', LastDate);
 qu.ConnectionString := WideString(Format(CONECT_STR, [db_file]));
 qu.SQL.Text := 'SELECT count(*) FROM DecadaVal AS d WHERE d.LastDate=:LastDate AND IsPlan=:IsPlan';
 qu.Parameters[0].Value := LastDate;
 qu.Parameters[1].Value := IsPlan;
 qu.Open;
 Result := qu.Fields[0].AsInteger;
 finally
 qu.Free;
 end;
end;
; Примечание Vit: я привёл этот код так как он был на сайте и его правильность целиком на совести автора. Однако приведенный код полон неточностей и могут быть проблемы при его выполнении. Давайте разберём что здесь не так и как сделать его работающим:
function TdmR3.GetCountForPeriod(LastDate: TDateTime; IsPlan: boolean): Integer;
var
 qu: TADOQuery;
 S: string;
begin
 qu := TADOQuery.Create(nil);
 try
 //S := FormatDateTime('dd.mm.yy', LastDate); нам не нужна эта строка
 qu.ConnectionString := Format(CONECT_STR, [db_file]); // Delphi автоматически приводит тип String в WideString
 qu.SQL.Text := 'SELECT count(*) FROM DecadaVal AS d WHERE d.LastDate=:LastDate AND IsPlan=:IsPlan';
 // Дельфи вовсе не автоматом распознает параметры, мы должны заставить его правильно провести парсинг параметров, для чего и служит следующая строка:
 qu.Parameters.ParseSQL(qu.SQL.Text, true); // если кверя создана в дизайне и текст SQL присвоен в дизайне то эта строка не понадобится
 // я предпочитаю обращаться к параметрам по имени, это избавит от многочисленных и сложных в отладке ошибок
 qu.Parameters.ParamByName('LastDate').Value := LastDate;
 qu.Parameters.ParamByName('IsPlan').Value := IsPlan;
 qu.Open;
 Result := qu.Fields[0].AsInteger;
 finally
 qu.Free;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02663
Передача текста любому окну, где стоит фокус

=== Передача текста любому окну, где стоит фокус ===
procedure TForm1.Timer1Timer(Sender: TObject);
var
 pgui: TGUIThreadinfo;
begin
 pgui.cbSize := SizeOf(TGUIThreadinfo);
 GetGUIThreadInfo(GetWindowThreadProcessId(GetForegroundWindow), pgui);
 SendMessage(pgui.hwndFocus, WM_SETTEXT, Length(Edit1.Text), Integer(@Edit1.Text[1]));
end;
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02124
Перейти на строку в RichEdit

=== Перейти на строку в RichEdit ===
with Richedit1 do
begin
 SelStart := Perform(EM_LINEINDEX, LineNumber, 0);
 Perform(EM_SCROLLCARET, 0, 0 );
end;
{
The EM_LINEINDEX message returns the character index of the first character
on a given line, assigning that to selstart moves the caret to that position.
The control will only automatically scroll the caret into view if it has
the focus, thus the EM_SCROLLCARET.
}
Source: http://delphiworld.narod.ru/
ID: 01019
Переключение раскладки клавиатуры для приложения

=== Переключение раскладки клавиатуры для приложения ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Переключение раскладки клавиатуры для приложения
Зависимости: Windows
Copyright: Dimka Maslov
Дата: 21 мая 2002 г.
********************************************** }
function ChangeLayout(LANG: Integer): Boolean;
var
 Layouts: array [0..16] of HKL;
 i, Count: Integer;
begin
 Result := False;
 Count := GetKeyboardLayoutList(High(Layouts)+1, Layouts)-1;
 for i := 0 to Count do
 if (LoWord(Layouts[i]) and $FF) = LANG then
 Result := ActivateKeyboardLayout(Layouts[i], 0) <> 0;
end; 
Пример использования:
ChangeLayout(LANG_RUSSIAN);
ChangeLayout(LANG_ENGLISH); 
Author: Dimka Maslov
Source: kladovka.net.ru
ID: 01531
Переключение состояния бита с единицы на ноль и наоборот

=== Переключение состояния бита с единицы на ноль и наоборот ===
Переключение состояния бита с единицы на ноль и наоборот
function BitToggle(const val: LongInt; const TheBit: Byte): LongInt;
begin
 Result := val xor (1 shl TheeBit);
end;
Source: Взято из http://forum.sources.ru
ID: 00230
----
procedure ToggleBit(SetWord, BitNum: Word);
begin
 SetWord := SetWord xor BitNum; { Переключаем бит }
end;
Source: http://delphiworld.narod.ru
ID: 00817
Перекрытие виртуальных методов

=== Перекрытие виртуальных методов ===
Кто-нибудь знает, в чем разница между перекрытием (OVERRIDING) виртуального метода и заменой (REPLACING) его? Я немного запутался.
Допустим у вас есть класс:
TMyObject = class(TObject) 
и его наследник:
TOverrideObject = class(TMyObject) 
К примеру, TMyObject имеет метод Wiggle:
procedure Wiggle; virtual; 
а TOverrideObject перекрывает Wiggle:
procedure Wiggle; override; 
и, естественно, вы реализовали оба метода.
Теперь вы создаете TList, содержащий целую кучу MyObjects и OverrideObjects в свойстве TList.Items[n]. Свойство Items является указателем, поэтому для вызова метода Wiggle вам достаточно вызвать необходимый элемент списка. Например так:
if TObject(Items[1]) is TMyObject then 
 TMyObject(Items[1]).Wiggle
else 
 if TObject(Items[1]) is TOverrideObject then 
 TOverrideObject(Items[1]).Wiggle;
но возможности полиморфизма и директива override позволяют вам сделать так:
TMyObject(Items[1]).Wiggle; 
Ваше приложение посмотрит на экземпляр специфического объекта, ссылка на который содержится в Items[1] и скажет: "Да, это - TMyObject, но, точнее говоря, это TOverrideObject; но поскольку метод Wiggle является виртуальным методом и TOverrideObject переопределил метод Wiggle, я собираюсь выполнить метод TOverrideObject.Wiggle, а не метод TMyObject.Wiggle."
Теперь представьте себе, что при декларации метода вы пропустили директиву override, попробуйте это выполнить теперь:
TMyObject(Items[1]).Wiggle; 
Приложение и в этом случае должно "видеть" данный метод, даже если Items[1] - TOverrideObject; но у него отсутствует перекрытая версия метода Wiggle, поэтому приложение выполнит TMyObject.Wiggle, а не TOverrideObject.Wiggle (поведение, которое вы можете как хотеть, так и избегать).
Так, перекрытый метод функционально может отличаться от декларированного метода, содержащего директиву virtual (или dynamic) в базовом классе, и объявленный с директивой override в классе-наследнике. Для замены метода необходимо объявить его в классе-наследнике без директивы override. Перекрытые методы могут выполняться даже тогда, когда специфический экземпляр класса-предка является точной копией базового класса. "Замененные" методы могут выполняться только тогда, когда специфический экземпляр является "слепком" только этого класса.
Source: Валентина Озерова, Сборник Kuliba
ID: 00112
Переместить элемент в TListView

=== Переместить элемент в TListView ===
// Move item 1 after item 4 
function MoveListViewItem(listView: TListView; ItemFrom, ItemTo: Word): Boolean;
var
 Source, Target: TListItem;
begin
 Result := False;
 listview.Items.BeginUpdate;
 try
 Source := listview.Items[ItemFrom];
 Target := listview.Items.Insert(ItemTo);
 Target.Assign(Source);
 Source.Free;
 Result := True;
 finally
 listview.Items.EndUpdate;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Listview1.ViewStyle := vsReport;
 if MoveListViewItem(Listview1, 1, 4) then
 ShowMessage('Moved!');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01138
Переместиться в конец файла

=== Переместиться в конец файла ===
{ прыгаем в конец (eof) }
procedure GotoEof(f: file);
begin
 { перемещаемся в начало }
 Seek(f, 0);
 { перемещаемся вперед на "x" количество байт, в нашем случае это размер файла! }
 Seek(f, FileSize(f));
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03132
Category:Файловая система
Перемещать объект на сложном фоне

Написать графический редактор, как Paint Brush, в Delphi очень просто. Но встает одна проблема. Чтобы нарисовать линию, пользователь нажимает мышью на поле, двигает ее, и отпускает кнопку. Во время движения мыши линия все время перерисовывается. Причем фон, после того, как линия переместилась, должен восстановиться. Для этого можно использовать логическую операцию XOR. Важное свойство этой операции заключается в том, что при любых A и B, A XOR B XOR B = A. Это означает, что если воспользоваться этой операцией для рисования линии, то при повторном ее рисовании на этом месте этим же цветом она сотрется, оставив за собой прежний фон.
procedure TForm1.XORLine;
begin
 Form1.Canvas.MoveTo(xo, yo);
 Form1.Canvas.LineTo(lx, ly);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.Color := clWhite;
 Form1.Canvas.Pen.Color := clRed;
 Form1.Canvas.Pen.Width := 3;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 Form1.Tag := 1;
 xo := X;
 yo := Y;
 lx := X;
 ly := Y;
 Form1.Canvas.Pen.Mode := pmNotXor;
 XORLine;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 if ssLeft in Shift then
 begin
 XORLine;
 lx := X;
 ly := Y;
 XORLine;
 end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 Form1.Canvas.Pen.Mode := pmCopy;
 Form1.Canvas.MoveTo(xo, yo);
 Form1.Canvas.LineTo(X, Y);
end;
Author: Даниил Карапетян (delphi4all@narod.ru)
Author: Алексей Денисов (aleksey@sch103.krasnoyarsk.su)
ID: 03629
ID: 03726
ID: 03812
Category:Графика
Перемещение из DbGrid

=== Перемещение из DbGrid ===
Кто-нибудь пробовал перемещать что-либо из DbGrid методом перетащи и брось (drag and drop)? Вы сами можете создать потомка TDBGrid (или TDBCustomGrid) и добавить необходимую функциональность для достижения цели.
Скопируйте код из данного "Совета", сохраните его с именем DBGrid.pas и установите компонент в палитру. У Вас появится новый компонент EDBGrid с двумя новыми событиями: OnMouseDown и OnMouseUp. Я не считаю эту информацию конфиденциальной: это ошибка разработчиков Delphi! На самом деле эти два события должны быть частью компонента DBGrid.
unit Dbgrid;
interface
uses
 DBGrids, Controls, Classes;
type
 TEDBGrid = class(TDBGrid)
 private
 FOnMouseDown: TMouseEvent;
 FOnMouseUp: TMouseEvent;
 protected
 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 published
 property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
 property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Data Controls', [TEDBGrid]);
end;
procedure TEDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
 X, Y: Integer);
begin
 if Assigned(FOnMouseDown) then
 FOnMouseDown(Self, Button, Shift, X, Y);
 inherited MouseDown(Button, Shift, X, Y);
end;
procedure TEDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 Y: Integer);
begin
 if Assigned(FOnMouseUp) then
 FOnMouseUp(Self, Button, Shift, X, Y);
 inherited MouseUp(Button, Shift, X, Y);
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03073
Category:Базы данных
Category:DBGrid
Перемещение иконок между несколькими TImageLists

=== Перемещение иконок между несколькими TImageLists ===
procedure TForm1.Button1Click(Sender: TObject);
var
 ico: TIcon;
begin
 ico := TIcon.Create;
 try
 Imagelist1.GetIcon(0, ico); // Get first icon from Imagelist1 
 Imagelist2.AddIcon(ico); // Add the icon to Imagelist2 
 finally
 ico.Free;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01263
Перемещение контролов мышкой во время выполнения приложения?

=== Перемещение контролов мышкой во время выполнения приложения? ===
Для этого необходимо перехватить событие OnMouseDown, запомнив координаты x и y и захватить мышку. После этого можно будет отслеживать движение мышки при помощи события OnMouseMove, перемещая контрол пока срабатывает событие OnMouseUp. Затем надо поместить контрол на своё окончательное место и снять захват мышки.
Следующий пример показывает как мышкой двигать компонент TButton по форме.
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
 procedure Button1MouseUp(Sender: TObject; Button: 
 TMouseButton; Shift: TShiftState; X, Y: Integer);
 private
 { Private declarations }
 public
 { Public declarations }
 MouseDownSpot : TPoint;
 Capturing : bool;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1MouseDown(Sender: TObject;
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if ssCtrl in Shift then
 begin
 SetCapture(Button1.Handle);
 Capturing := true;
 MouseDownSpot.X := x;
 MouseDownSpot.Y := Y;
 end;
end;
procedure TForm1.Button1MouseMove(Sender: TObject;
 Shift: TShiftState; X, Y: Integer);
begin
 if Capturing then
 begin
 Button1.Left := Button1.Left - (MouseDownSpot.x - x);
 Button1.Top := Button1.Top - (MouseDownSpot.y - y);
 end;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Capturing then
 begin
 ReleaseCapture;
 Capturing := false;
 Button1.Left := Button1.Left - (MouseDownSpot.x - x);
 Button1.Top := Button1.Top - (MouseDownSpot.y - y);
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 01590
Перемещение на страницу TabSet по имени

=== Перемещение на страницу TabSet по имени ===
Разместите компоненты Tabset(TabSet1) и Edit (Edit1) на вашей форме. Измените свойство компонента Tabset Tabs для размещения в списке строк следующих четерых закладок: 
 Hello 
 World 
 Of 
 Delphi 
Создайте обработчик события onChange компонента Edit1 как показано ниже:
procedure TForm1.Edit1Change(Sender: TObject);
var
 I: Integer;
begin
 for I := 0 to TabSet1.Tabs.Count-1 do
 if Edit1.Text = TabSet1.Tabs[I] then
 TabSet1.TabIndex := I;
end;
Теперь при наборе любого из существующих имен в edit1 соответствующая закладка будет выведена на передний план. 
Source: http://delphiworld.narod.ru/
ID: 01182
Перемещение по таблице с помощью вертикальной полосы прокрутки

=== Перемещение по таблице с помощью вертикальной полосы прокрутки ===
Это небольшое исправление к исходному коду VCL, позволяющее поддерживать перемещение по таблице с помощью изменения позиции движка вертикальной полосы прокрутки.
(Примечание: это работает только с таблицами Paradox и BDE. Для использования этого кода с другими таблицами/движками вам необходимо заменить DBIGetSeqNo на функцию, надежно возвращающую текущую позицию записи вне зависимости от того, использует ли таблица индекс или нет.)
В DBGRID.PAS измените две следующих процедуры:
procedure TCustomDBGrid.UpdateScrollBar;
var
 Pos: Integer;
 mPos, mMax: longint;
begin
 if FDatalink.Active and HandleAllocated then
 with FDatalink.DataSet do
 begin
 UpdateCursorPos;
 if (DBIGetSeqNo(Handle, mPos) = DBIERR_NONE) then
 begin
 mMax := RecordCount;
 while mMax > 1000 do
 begin
 mMax := mMax div 10;
 mPos := mPos div 10;
 end;
 SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False);
 end
 else
 begin
 if BOF then
 mPos := 0
 else if EOF then
 mPos := 4
 else
 mPos := 2;
 SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
 end; (**)
 if GetScrollPos(Self.Handle, SB_VERT) <> mPos then
 SetScrollPos(Self.Handle, SB_VERT, mPos, True);
 end;
end;
procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
var
 mMin, mMax: integer;
 RecCount, RecNo, NewRecNo: longint;
begin
 if not AcquireFocus then
 Exit;
 if FDatalink.Active then
 with Message, FDataLink.DataSet, FDatalink do
 case ScrollCode of
 SB_LINEUP: MoveBy(-ActiveRecord - 1);
 SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
 SB_PAGEUP: MoveBy(-VisibleRowCount);
 SB_PAGEDOWN: MoveBy(VisibleRowCount);
 SB_THUMBPOSITION:
 if (DBIGetSeqNo(Handle, RecNo) = DBIERR_NONE) then
 begin
 GetScrollRange(self.Handle, SB_VERT, mMin, mMax);
 NewRecNo := Pos * (FDataLink.DataSet.RecordCount div mMax);
 MoveBy(NewRecNo - RecNo);
 end
 else
 case Pos of
 0: First;
 1: MoveBy(-VisibleRowCount);
 2: Exit;
 3: MoveBy(VisibleRowCount);
 4: Last;
 end;
 SB_BOTTOM: Last;
 SB_TOP: First;
 end;
end;
Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount > MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!
P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.
Source: Взято с http://delphiworld.narod.ru
ID: 03068
Category:Базы данных
Category:DBGrid
Переслать данные в другую программу методом Drag-and-Drop

=== Переслать данные в другую программу методом Drag-and-Drop ===
// Autor: Hagen Reddmann
uses
 ShellAPI;
// Creates a hDrop Object 
// erzeugt ein hDrop Object 
function MakeDrop(const FileNames: array of string): THandle;
var
 I, Size: Integer;
 Data: PDragInfoA;
 P: PChar;
begin
 // Calculate memory size needed 
 // berechne notwendig Speichergro?e 
 Size := SizeOf(TDragInfoA) + 1;
 for I := 0 to High(FileNames) do
 Inc(Size, Length(FileNames[I]) + 1);
 // allocate the memory 
 // alloziere den speicher 
 Result := GlobalAlloc(GHND or GMEM_SHARE, Size);
 if Result <> 0 then
 begin
 Data := GlobalLock(Result);
 if Data <> nil then
 try
 // fill up with data 
 // fulle daten 
 Data.uSize := SizeOf(TDragInfoA);
 P := PChar(@Data.grfKeyState) + 4;
 Data.lpFileList := P;
 // filenames at the at of the header (separated with #0) 
 // am ende des headers nun die filenamen getrennt mit #0 
 for I := 0 to High(FileNames) do
 begin
 Size := Length(FileNames[I]);
 Move(Pointer(FileNames[I])^, P^, Size);
 Inc(P, Size + 1);
 end;
 finally
 GlobalUnlock(Result);
 end;
 GlobalFree(Result);
 Result := 0;
 end;
 end;
// search for a edit control with classname 'TEditControl' 
// suche ein child fenster mit klassennamen 'TEditControl' 
function MyEnum(Wnd: hWnd; Res: PInteger): Bool; stdcall;
var
 N: string;
begin
 SetLength(N, MAX_PATH);
 SetLength(N, GetClassName(Wnd, Pointer(N), Length(N)));
 Result := AnsiCompareText('TEditControl', N) <> 0;
 if not Result then Res^ := Wnd;
end;
// Example: Open msdos.sys in Delphi's Editor window 
// Beispiel: msdos.sys im Delphi Editor offnen 
procedure TForm1.Button1Click(Sender: TObject);
var
 Wnd: HWnd;
 Drop: hDrop;
begin
 // search for Delphi's Editor 
 // suche Delphis Editor Fenster 
 EnumChildWindows(FindWindow('TEditWindow', nil), @MyEnum, Integer(@Wnd));
 if IsWindow(Wnd) then
 begin
 // Delphi's Editor found. Open msdos.sys 
 // Delphis editor gefunden, also offne msdos.sys 
 Drop := MakeDrop(['c:\msdos.sys']);
 if Drop <> 0 then PostMessage(Wnd, wm_DropFiles, Drop, 0);
 // Free the memory? 
 // Speicher wieder freigeben? 
 GlobalFree(Drop);
 end;
end;
Language: en
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00718
Category:VCL
Category:DragAndDrop
Category:Файлы
Перестроить вкладки TPageControl с помощью Drag and Drop

=== Перестроить вкладки TPageControl с помощью Drag and Drop ===
// In the PageControl's OnMouseDown event handler: 
procedure TForm1.PageControl1MouseDown(Sender: TObject; 
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
 PageControl1.BeginDrag(False); 
end; 
// In the PageControl's OnDragDrop event handler: 
procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); 
const 
 TCM_GETITEMRECT = $130A; 
var 
 i: Integer; 
 r: TRect; 
begin 
 if not (Sender is TPageControl) then Exit; 
 with PageControl1 do 
 begin 
 for i := 0 to PageCount - 1 do 
 begin 
 Perform(TCM_GETITEMRECT, i, lParam(@r)); 
 if PtInRect(r, Point(X, Y)) then 
 begin 
 if i <> ActivePage.PageIndex then 
 ActivePage.PageIndex := i; 
 Exit; 
 end; 
 end; 
 end; 
end; 
// In the PageControl's OnDragOver event handler: 
procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, 
 Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
 if Sender is TPageControl then 
 Accept := True; 
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00367
Category:VCL
Category:DragAndDrop
Category:TPageControl
Перетаскиваем колонки и строки в StringGrid мышью

=== Перетаскиваем колонки и строки в StringGrid мышью ===
{ 
 The user can move rows and columns of a StringGrid with the mouse. 
 Can it also be done by code? 
 In the help for TCustomGrid you can see the methods MoveColumn and MoveRow, 
 but they are hidden in TStringGrid. 
 We can make them accessible again by subclassing TStringGrid and 
 declaring these methods as public: 
} 
type 
 TStringGridHack = class(TStringGrid) 
 public 
 procedure MoveColumn(FromIndex, ToIndex: Longint); 
 procedure MoveRow(FromIndex, ToIndex: Longint); 
 end; 
{ 
 The implementation of these methods simply consists of invoking the 
 corresponding method of the ancestor: 
} 
procedure TStringGridHack.MoveColumn(FromIndex, ToIndex: Integer); 
begin 
 inherited; 
end; 
procedure TStringGridHack.MoveRow(FromIndex, ToIndex: Integer); 
begin 
 inherited; 
end; 
// Example, Beispiel: 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 TStringGridHack(StringGrid1).MoveColumn(1, 3); 
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01065
Перетаскивание файлов в приложение

Иногда очень полезно избавить пользователя от лишних операций при открытии файла. Он должен нажать на кнопку " Открыть" , затем найти интересующий каталог, выбрать файл. Проще перетащить мышкой файл сразу в окно приложения.
Рассмотрим пример перетаскивания Drag & Drop в окно произвольного текстового файла, который сразу же открывается в компоненте Memo1. Для начала в разделе Uses необходимо подключить модуль ShellAPI. В private области окна нужно вставить следующую строку:
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; //получение сообщений о переносе файла в окно приложения
Процедура обработки этого сообщения будет выглядеть следующим образом:
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
 CFileName: array[0..MAX_PATH] of Char; // переменная, хранящая имя файла
begin
 try
 if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH)> 0 then
 begin
 // получение пути файла
 Form1.Caption := CFileName; // имя файла в заголовок окна
 Memo1.Lines.LoadFromFile(CFileName); // открываем файл
 Msg.Result := 0;
 end;
 finally
 DragFinish(Msg.Drop); // отпустить файл
 end;
end;
Для того, чтобы форма знала, что может принимать такие файлы, необходимо в процедуре создания окна указать:
procedure TForm1.FormCreate(Sender: TObject);
begin
 DragAcceptFiles(Handle, True);
end;
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03186
Category:Файловая система
Category:DragAndDrop