nyuuzyou/wikis huggingface dataset:
Таблица NetBIOS-имен удаленных компьютер

////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Unit Name : Unit1
// * Purpose : Демо получение информации NETBIOS именах компьютера
// (аналог nbtstat -a)
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, Nb30, StdCtrls;
type
 TNetbiosInfo = record
 AdapterStatus: TAdapterStatus;
 NameBuffer: Array [0..30] of TNameBuffer;
 end;
 TForm1 = class(TForm)
 Edit1: TEdit;
 Button1: TButton;
 Memo1: TMemo;
 procedure Button1Click(Sender: TObject);
 private
 procedure GetNetBiosNames(const Addr: String);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.GetNetBiosNames(const Addr: String);
var
 NCB: TNCB;
 Enum: TLanaEnum;
 NetbiosInfo: TNetbiosInfo;
 I, A: Integer;
 Ends: Byte;
begin
 FillChar(NCB, SizeOf(TNCB), #0);
 NCB.ncb_command := Char(NCBENUM);
 NCB.ncb_buffer := @Enum;
 NCB.ncb_length := SizeOf(TLanaEnum);
 if Netbios(@NCB) = Char(NRC_GOODRET) then
 for I := 0 to Integer(Enum.length) - 1 do
 begin
 FillChar(NCB, SizeOf(TNCB), #0);
 NCB.ncb_lana_num := Enum.lana[I];
 NCB.ncb_command := Char(NCBRESET);
 if Netbios(@NCB) = Char(NRC_GOODRET) then
 begin
 FillChar(NetbiosInfo, SizeOf(TNetbiosInfo), #0);
 NCB.ncb_command := Char(NCBASTAT);
 Move(Addr[1], NCB.ncb_callname[0], Length(Addr));
 NCB.ncb_buffer := @NetbiosInfo;
 NCB.ncb_length := SizeOf(TNetbiosInfo);
 if Netbios(@NCB) = Char(NRC_GOODRET) then
 for A := 0 to NetbiosInfo.AdapterStatus.name_count - 1 do
 begin
 Ends := Byte(NetbiosInfo.NameBuffer[A].name[NCBNAMSZ - 1]);
 NetbiosInfo.NameBuffer[A].name[NCBNAMSZ - 1] := #32;
 Memo1.Lines.Add(Format('%s <%s>',
 [String(NetbiosInfo.NameBuffer[A].name),
 IntToHex(Ends, 2)]));
 end;
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 GetNetBiosNames(Edit1.Text);
end;
end.
Author: Rouse_
Source: http://forum.sources.ru
ID: 03324
Category:Связь
Табуляция в графическом ListBox

=== Табуляция в графическом ListBox ===
Использование табуляции в ListBox'е когда компонент находится в стандартном режиме не составляет труда. Но что делать если надо использовать графическое отображение элементов списка? Ведь при этом надо самому писать обработчик отрисовки элементов с разбиением на колонки. Элементарное решение - использование API функции TabbedTextOut, однако результаты работы этой функции меня явно не удовлетворили. Пришлось-таки "выкручиваться"... Символ-разделитель можно использовать любой. Например, будем использовать символ "|", тогда обработчик OnDrawItem может выглядеть следующим образом:
procedure TBrowser.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 S, Ss: string;
 P: Integer; // Флаг символа-разделителя
begin
 ListBox1.Canvas.FillRect(Rect);
 // Отрисовка графики
 // ...
 S := ListBox1.Items.Strings[Index];
 P := Pos('|', S);
 if P = 0 then
 Ss := S
 else
 // Если нет табуляции, то пишем всю строку,
 // иначе отрезаем кусок до разделителя
 Ss := Copy(S, 1, P - 1);
 ListBox1.Canvas.TextOut(Rect.Left + 20, Rect.Top + 2, Ss);
 if P > 0 then
 ListBox1.Canvas.TextOut(ListBox1.TabWidth, Rect.Top + 2, Copy(S, P + 1,
 Length(S) - P + 2));
end;
Не забудьте перед запуском поставить нужное значение TabWidth.
Author: Virtualik
Source: Взято с http://delphiworld.narod.ru
ID: 00663
Таскаем форму за её поверхность

=== Таскаем форму за её поверхность ===
unit DragMain;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages,
 Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure ButtonClick(Sender: TObject);
 private
 procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCCHitTest;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1. WMNCHitTest(var M: TWMNCHitTest); 
begin
 inherited;
 if M.Result = htClient then
 M.Result := htCaption;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Close;
end;
end.
ID: 00510
Текст в ячейке StringGrid если не помещается переносится на следующую ячейку

=== Текст в ячейке StringGrid если не помещается переносится на следующую ячейку ===
// Сначала нужно обработать событие OnDrawCell компонента TStringGrid: 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
var
 i, x, y: Integer;
begin
 if gdFixed in State then
 Exit;
 if ARow > 1 then
 Exit;
 { Draw row 1 with text from cell 1,1 spanning all cells in the row }
 with sender as TStringGrid do
 begin
 { Extend rect to include grid line on right, if not last cell in row }
 if aCol < Pred(ColCount) then
 Rect.Right := Rect.Right + GridlineWidth;
 { Figure out where the text of the first cell would start
 relative to the current cells rect }
 y := Rect.Top + 2;
 x := Rect.Left + 2;
 for i:= 1 to aCol - 1 do
 x := x - ColWidths[i] - GridlineWidth;
 { Paint cell pale yellow }
 Canvas.Brush.Color := $7FFFFF;
 Canvas.Brush.Style := bsSolid;
 Canvas.FillRect(Rect);
 { Paint text of cell 1,1 clipped to current cell }
 Canvas.TextRect(Rect, x, y, Cells[1, 1]);
 end;
end;
// По созданию окна изобразим следующее 
procedure TForm1.FormCreate(Sender: TObject);
var
 i, k: Integer;
begin
 with StringGrid1 do
 begin
 cells[1, 1] := 'A rather long line which will span cells';
 for i := 1 to colcount-1 do
 for k := 2 to rowcount -1 do
 cells[i, k] := Format('Cell[%d, %d]', [i, k]);
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01107
Текст между двумя определёнными строками

=== Текст между двумя определёнными строками ===
procedure IsolateText(const S: string; Tag1, Tag2: string; list: TStrings);
var
 pScan, pEnd, pTag1, pTag2: PChar;
 foundText: String;
 searchtext: String;
begin
 { Set up pointers we need for the search. HTML is not case sensitive, so
 we need to perform the search on a uppercased copy of S.}
 searchtext := UpperCase(S);
 Tag1 := UpperCase(Tag1);
 Tag2 := UpperCase(Tag2);
 pTag1 := PChar(Tag1);
 pTag2 := PChar(Tag2);
 pScan := PChar(searchtext);
 repeat
 { Search for next occurence of Tag1. }
 pScan:= StrPos(pScan, pTag1);
 if pScan <> nil then
 begin
 { Found one, hop over it, then search from that position
 forward for the next occurence of Tag2. }
 Inc(pScan, Length( Tag1 ));
 pEnd := StrPos( pScan, pTag2 );
 if pEnd <> nil then
 begin
 { Found start and end tag, isolate text between,
 add it to the list. We need to get the text from
 the original S, however, since we want the un-uppercased
 version! So we calculate the address pScan would hold if
 the search had been performed on S instead of searchtext. }
 SetString(foundText, 
 PChar(S) + (pScan- PChar(searchtext) ),
 pEnd - pScan);
 list.Add(foundText);
 { Continue next search after the found end tag. }
 pScan := pEnd + Length(tag2);
 end
 else { Error, no end tag found for start tag, abort. }
 pScan := nil;
 end;
 until pScan = nil;
end;
Source: http://delphiworld.narod.ru
ID: 00925
Текущая строка и поле в DBGrid

=== Текущая строка и поле в DBGrid ===
unit dbcolform;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, Grids, DBGrids, DB, DBTables;
type
 TForm1 = class(TForm)
 Table1: TTable;
 DataSource1: TDataSource;
 DBGrid1: TDBGrid;
 Label1: TLabel;
 procedure DBGrid1ColEnter(Sender: TObject);
 procedure DataSource1DataChange(Sender: TObject; Field: TField);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
type
 TFake = class (TDBGrid);
procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
 Label1.Caption := Format (
 'Column: %2d; Row: %2d',
 [TFake (DbGrid1).Col,
 TFake (DbGrid1).Row]);
end;
procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
 DBGrid1ColEnter (sender);
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03049
Category:Базы данных
Category:DBGrid
Текущий модуль и проект

=== Текущий модуль и проект ===
Компонент во время проектирования может знать имена текущих модулей и имя проекта. Все это можно получить с помощью ToolServices (см. файл TOOLINTF.PAS) 
Имя текущего проекта можно получить с помощью вызова GetProjectName, список модулей/форм - с помощью функции GetUnitCount, которая возвратит количество модулей и затем с помощью GetUnitName(i) мы можем получить имя каждого модуля (также и с формами). 
Вот примерный образец кода (получение и запись имен всех модулей/форм в StringGrid и имени проекта в Label):
procedure TInformationFrm.FormActivate(Sender: TObject);
{ необходимо: StringGrid1 (2 колонки, масса строк), Label1, Label2 }
var
 i, j: Integer;
 Tmp: string;
begin
 StringGrid1.Cells[0, 0] := 'модулей:';
 StringGrid1.Cells[1, 0] := 'форм:';
 if ToolServices <> nil then
 with ToolServices do
 begin
 Label1.Caption := ExtractFileName(GetProjectName); { простое имя }
 Label2.Caption := GetProjectName; { полное правильное имя пути }
 for i := 0 to GetUnitCount do
 begin
 Tmp := ExtractFileName(GetUnitName(i));
 StringGrid1.Cells[0, i + 1] := Tmp;
 Tmp := ChangeFileExt(Tmp, '.DFM');
 for j := 0 to GetFormCount do
 if ExtractFileName(GetFormName(j)) = Tmp then
 StringGrid1.Cells[1, i + 1] := Tmp
 end;
 end;
end;
Source: http://delphiworld.narod.ru
ID: 00035
Тест на корректность GUID и интерфейсов

Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch (и, следовательно, поддерживающих методы автоматизации)?
Вызовите CreateRemoteComObject, передав GUID интерфейса и имя компьютера, к которому Вы пытаетесь подключиться. Если функция вернет ошибку, то наличествует проблема сервера, иначе возможная проблема относится к клиенту.
const
 MyGUID = '{444...111}'; // Whatever the guid is...
var
 Unk: IUnknown;
 Disp: IDispatch;
begin
 { Make sure this line works correctly }
 Unk := CreateRemoteComObject('server1', StringToGUID(MyGUID));
 { If it does, then cast it to a IDispatch }
 Disp := Unk as IDispatch;
end;
Если этот кусок кода работает, а проблема остается, то Вам требуется шаг за шагом пройти через код клиента и найти, где он дает трещину. Если не сможете этого обнаружить, Вам придется запустить сервер под отладчиком и установить связь с клиентом, чтобы Вы могли произвести отладку рядом со местом, дающем слабину.
Author: Nomadic 
Source: http://delphiworld.narod.ru
ID: 04340
Category:COM
Топологическая сортировка

Нерекурсивный алгоритм топологической сортировки ориентированного графа без циклов.
Предположим, что граф имеет вершины с номерами 1..n, для каждой вершины i известно число num[i] выходящих из нее ребер и номера вершин dest[i][1], ..., dest[i][num[i]], в которые эти ребра ведут. Будем условно считать, что ребра перечислены 'слева направо': левее то ребро, у которого номер меньше. Нам надо напечатать все вершины в таком порядке, чтобы конец любого ребра был напечатан перед его началом. Мы предполагаем, что в графе нет ориентированных циклов - иначе такое невозможно.
Для начала добавим к графу вершину 0, из которой ребра ведут в вершины 1, ..., n. Если ее удастся напечатать с соблюдением правил, то тем самым все вершины будут напечатаны.
Алгоритм хранит путь, выходящий из нулевой вершины и идущий по ребрам графа. Переменная l отводится для длины этого пути. Путь образован вершинами vert[1], ..., vert[l] и ребрами, имеющими номера edge[1] ... edge[l]. Номер edge[s] относится к нумерации ребер, выходящих из вершины vert[s]. Тем самым для всех s должны выполняться неравенство
 edge[s] <= num[vert[s]]
и равенство
 vert[s+1] = dest [vert[s]] [edge[s]]
Впрочем, для последнего ребра мы сделаем исключение, разрешив ему указывать 'в пустоту', т.е. разрешим edge[l] равняться num[vert[l]]+1.
В процессе работы алгоритм будет печатать номера вершин, при этом соблюдая требование 'вершина напечатана только после тех вершин, в которые из нее ведут ребра'. Наконец, будет выполняться такое требование:
(И)
вершины пути, кроме последней (т.е. vert[1]..vert[l]) не напечатаны, но свернув с пути налево, мы немедленно упираемся в напечатанную вершину
Вот что получается:
 l := 1;
 vert[1] := 0;
 edge[1] := 1;
 while not ((l = 1) and (edge[1] = n+1)) do
 begin
 if edge[l] = num[vert[l]]+1 then
 begin
 { путь кончается в пустоте, поэтому все вершины,
 следующие за vert[l], напечатаны - можно печатать vert[l]}
 WriteLn(vert[l]);
 l := l-1;
 edge[l] := egde[l]+1;
 end
 else
 begin
 { edge[l] <= num[vert[l]], путь кончается в вершине }
 lastvert := dest[vert[l]][edge[l]]; { последняя }
 if lastvert напечатана then
 begin
 edge[l] := edge[l]+1;
 end
 else
 begin
 l := l+1;
 vert[l] := lastvert;
 edge[l] := 1;
 end;
 end;
 end;
 { путь сразу же ведет в пустоту, поэтому все вершины
 левее, то есть 1..n, напечатаны }
Доказательство, что если в графе нет циклов, то этот алгоритм заканчивает работу:
Пусть это не так. Каждая вершина может печататься только один раз, так что с некоторого момента вершины не печатаются. В графе без циклов длина пути ограничена (вершина не может входить дважды), поэтому подождав еще, мы можем дождаться момента, после которого путь не удлиняется. После этого может разве что увеличиваться edge[l] - но и это не беспредельно.
Source: http://algolist.manual.ru
ID: 04157
Category:Алгоритмы
Category:Сортировка
Транслитерация

=== Транслитерация ===
Например, молоко - moloko. И всё.
Вот пример функции, которая транслирует из русских слов в английские. 
Пригодилась, когда нужно было файлы в mp3-плеер перегонять - он русский не понимает. 
unit Translate;
interface
function Convert(OldName: string): string;
implementation
function Convert(OldName: string): string;
var
 OldNameLength: Integer;
 i: Integer;
 s: string;
begin
 OldNameLength := Length(OldName);
 s := ;
 i := 1;
 while i <= OldNameLength do
 begin
 if (OldName[i] in ['A'..'Z'] + ['a'..'z'] + ['0'..'9'] +
 ['{'] + ['}'] + ['['] + [']'] + ['`'] + ['~'] +
 ['!'] + ['@'] + ['#'] + ['$'] + ['%'] + ['^'] +
 ['&'] + ['*'] + ['('] + [')'] + ['-'] + ['_'] +
 ['+'] + ['='] + ['\'] + ['|'] + [';'] + [':'] +
 ['"'] + ['{'] + ['<'] + ['>'] + [','] + ['.'] +
 [' '] + ['?'] + ['/'] + ['№'] + ['^']) then
 s := s + OldName[i];
 if OldName[i] in ['А', 'Б', 'а', 'б'] then
 s := s + chr(Ord(OldName[i]) - 127);
 if OldName[i] in ['В', 'в'] then
 s := s + chr(Ord(OldName[i]) - 108);
 if OldName[i] in ['Г', 'г', 'Ж', 'ж'] then
 s := s + chr(Ord(OldName[i]) - 124);
 if OldName[i] in ['Д', 'д', 'Е', 'е'] then
 s := s + chr(Ord(OldName[i]) - 128);
 if OldName[i] in ['З', 'з'] then
 s := s + chr(Ord(OldName[i]) - 109);
 if OldName[i] in ['И', 'и', 'К', 'к', 'Л', 'л', 'М', 'м', 'Н',
 'н', 'О', 'о', 'П', 'п'] then
 s := s + chr(Ord(OldName[i]) - 127);
 if OldName[i] in ['Й', 'й'] then
 s := s + chr(Ord(OldName[i]) - 128);
 if OldName[i] in ['Р', 'р', 'С', 'с', 'Т', 'т', 'У', 'у'] then
 s := s + chr(Ord(OldName[i]) - 126);
 if OldName[i] in ['Ф', 'ф'] then
 s := s + chr(Ord(OldName[i]) - 142);
 if OldName[i] in ['Х', 'х'] then
 s := s + chr(Ord(OldName[i]) - 141);
 if OldName[i] in ['Ц', 'ц'] then
 s := s + chr(Ord(OldName[i]) - 147);
 if OldName[i] in ['Ы', 'ы'] then
 s := s + chr(Ord(OldName[i]) - 130);
 if OldName[i] in ['Э', 'э'] then
 s := s + chr(Ord(OldName[i]) - 152);
 if OldName[i] = 'Ё' then
 s := s + 'Yo';
 if OldName[i] = 'ё' then
 s := s + 'yo';
 if OldName[i] = 'Ч' then
 s := s + 'Ch';
 if OldName[i] = 'ч' then
 s := s + 'ch';
 if OldName[i] = 'Ш' then
 s := s + 'Sh';
 if OldName[i] = 'ш' then
 s := s + 'sh';
 if OldName[i] = 'Щ' then
 s := s + 'Sch';
 if OldName[i] = 'щ' then
 s := s + 'sch';
 if OldName[i] in ['Ъ', 'ъ', 'Ь', 'ь'] then
 s := s + chr(39);
 if OldName[i] = 'Ю' then
 s := s + 'Yu';
 if OldName[i] = 'ю' then
 s := s + 'yu';
 if OldName[i] = 'Я' then
 s := s + 'Ya';
 if OldName[i] = 'я' then
 s := s + 'ya';
 i := i + 1;
 end;
 Convert := s;
end;
end.
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01972
Требуется нажать в другом приложении пару кнопок?

=== Требуется нажать в другом приложении пару кнопок? ===
Требуется нажать в "другом" приложении пару кнопок (button). (кнопки не имеют hotkeys). Ищу окно так (Дельфи):
if FindWindow(nil, 'Advanced Dialer')<> 0 then
 ShowMessage('OK');
А теперь в найденном приложении надо нажать кнопку HangUp, подождать 5 сек. и нажать кнопку Dial. Подскажите плз. как это реализовать. Я не знаю, что там за кнопки... Если класс Button, то один вариант, если это кнопки на тулбаре, то другой. Вот посмотри, я писал когда-то, лишнее стирать лень... реализуется 1-й и 2-й способ:
function PressAbortAndReloadBtn: string;
var
 MenuHnd: THandle; // описатель меню
 ItemUint: UINT; // идентификатор пункта меню
 BtnHnd: THandle;
begin
 Result := PRX_UNKNOWN_ERR;
 GetProcList();
 if Prx_MainWHnd <> 0 then
 begin
 BtnHnd := FindWindowEx(Prx_MainWHnd, 0, nil, PChar(PrxABtnName));
 SendMessage(BtnHnd, BM_CLICK, 0, 0);
 Sleep(100);
 MenuHnd := GetMenu(Prx_MainWHnd);
 if Menuhnd <> 0 then
 begin
 ItemUint := GetMenuItemID(Menuhnd, 4);
 if ItemUint <> 0 then
 begin
 SendMessage(Prx_MainWHnd, WM_COMMAND, ItemUint, 0);
 Result := PRX_OK;
 end
 else
 Result := PRX_ITEM_NOT_FOUND;
 end
 else
 Result := PRX_MENU_NOT_FOUND;
 end
 else
 Result := PRX_NOT_FOUND;
 if Result <> PRX_OK then
 WriteLog(result);
end;
// У себя делал так
procedure ClickOnForm(wnd: HWND; caption: string);
var
 TheChildHandle: HWND;
begin
 TheChildHandle := FindWindowEx(wnd, 0, nil, PChar(Caption));
 SendMessage(TheChildHandle, WM_LButtonDown, 1, 1);
 SendMessage(TheChildHandle, WM_LButtonUP, 1, 1);
end;
procedure TForm1.Button4Click(Sender: TObject);
var
 wnd: HWND;
 sCaption: string;
begin
 wnd := GetTopWindow(0);
 repeat
 SetLength(sCaption, GetWindowtextLength(wnd));
 GetWindowText(wnd, @sCaption[1], Length(sCaption) + 1);
 if (Trim(sCaption) = 'Form caption') then
 ClickOnForm(wnd, 'Button name');
 wnd := GetNextWindow(wnd, GW_HWNDNEXT);
 until wnd = 0;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02109
Убиваем активное приложение

=== Убиваем активное приложение ===
Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.
procedure KillProgram(Classname : string; WindowTitle : string);
const
 PROCESS_TERMINATE = $0001;
var
 ProcessHandle: THandle;
 ProcessID: Integer;
 TheWindow: HWND;
begin
 TheWindow := FindWindow(Classname, WindowTitle);
 GetWindowThreadProcessID(TheWindow, @ProcessID);
 ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);
 TerminateProcess(ProcessHandle, 4);
end;
Комментарии
Xianguang Li (22 Октября 2000)
В Delphi 5, при компиляции получается следующая ошибка :
 Incompatible types: 'String' and 'PChar'.
После изменения выражения
 TheWindow := FindWindow(ClassName, WindowTitle)
на
 TheWindow := FindWindow(PChar(ClassName), PChar(WindowTitle)) ,
Нормально откомпилировалось.
И ещё: если мы не знаем ClassName или WindowTitle программы, которую мы хотим убить, то мы не сможем её завершить. Причина в том, что нельзя вызвать функцию в виде:
 KillProgram(nil, WindowTitle)
или
 KillProgram(ClassName, nil).
Компилятор не позволяет передать nil в переменную типа String.
Итак, я изменил объявление
 KillProgram(ClassName: string; WindowTitle: string)
на
 KillProgram(ClassName: PChar; WindowTitle: PChar),
вот теперь функция действительно может завершить любое приложение, если вы не знаете ClassName или WindowTitle этого приложения.
Author: Dale Berry
Source: Взято из http://forum.sources.ru
ID: 02104
Увеличение значения указателя

=== Увеличение значения указателя ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Увеличение значения указателя
Конвертирует указатель в Cardinal, увеличиваем значение адреса,
и конвертирует обратно в указатель, который и возвращает.
Внимание, функция не выделяет никаких блоков памяти,
она просто работает с указателем.
Зависимости: System
Автор: Григорий Ситнин, gregor@gregor.ru, Москва
Copyright: Григорий Ситнин, 2003
Дата: 8 июля 2003 г.
***************************************************** }
function IncPtr(APointer: pointer; AHowMuch: cardinal = 1): pointer;
begin
 //*** Конвертируем указатель в Cardinal, увеличиваем значение адреса,
 //*** и конвертируем обратно в указатель, который и возвращаем.
 //**! Внимание, функция не выделяет никаких блоков памяти,
 //**! она просто работает с указателем.
 Result := Ptr(cardinal(APointer) + AHowMuch);
end;
Пример использования: 
{$APPTYPE CONSOLE}
program testptr;
uses SysUtils, uIncPtr; //*** Модуль uIncPtr содержит функцию IncPtr
var
 ptr1, ptr2: pointer;
begin
 ptr1 := AllocMem(255);
 ptr2 := incptr(ptr1, 10);
 writeln('ptr1 : ', cardinal(ptr1));
 //*** Напечатать увеличенный на 10 указатель ptr1
 writeln('ptr2 (+10): ', cardinal(ptr2));
 FreeMem(ptr1, 255)
end.
Source: http://delphibase.endimus.com
ID: 00832
Увеличение ячейки TStringGrid при увеличении числа строк

=== Увеличение ячейки TStringGrid при увеличении числа строк ===
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow:
 Integer; Rect: TRect; State: TGridDrawState);
var
 Format: Word;
 C: array[0..255] of Char;
 r: integer;
begin
 C := ;
 Format := DT_LEFT or DT_WORDBREAK;
 (Sender as TStringGrid).Canvas.FillRect(Rect);
 StrPCopy(C, (Sender as TStringGrid).Cells[ACol, ARow]);
 if c <> then // если есть значения
 begin
 r := WinProcs.DrawText((Sender as TStringGrid).Canvas.Handle, C,
 StrLen(C), Rect, Format);
 if r > (Sender as TStringGrid).RowHeights[Arow] then
 // если высота колонки меньше
 (Sender as TStringGrid).RowHeights[Arow] := r;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01073
Угол поворота точки окружности относительно центра

{ **** UBPFD *********** by kladovka.net.ru ****
>> Угол поворота точки окружности относительно центра
Center - центр окружности;
P - точка на окружности;
Угол определяется так, как учили в школе: от нуля по оси X вправо и дальше против часовой стрелки.
Значение возвращает в градусах.
Зависимости: Math
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор: Николай Федоровских
Дата: 12 июня 2003 г.
********************************************** }
function GetAngle(const Center, P: TPoint): Double;
begin
 Result := ArcTan2(Center.y - P.y, P.x - Center.x) * (180 / Pi);
 { Чтобы возвращала результат в радианах, нужно <* (180 / Pi)> убрать }
 if Result < 0 then
 Result := Result + 360; { Эта строка необязательна }
end;
Author: Fenik
ID: 04125
Category:Алгоритмы
Category:Графика
Category:Геометрия