nyuuzyou/wikis huggingface dataset:
Форма окна по Bitmap

unit Unit1;
interface
uses
 Windows, Classes, SysUtils, Graphics, Forms;
type
 TRGBArray = array[0..32767] of TRGBTriple;
 PRGBArray = ^TRGBArray;
type
 TForm1 = class(TForm)
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 { Private declarations }
 FRegion: THandle;
 function CreateRegion(Bmp: TBitmap): THandle;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.CreateRegion(Bmp: TBitmap): THandle;
var
 X, Y, StartX: Integer;
 Excl: THandle;
 Row: PRGBArray;
 TransparentColor: TRGBTriple;
begin
 Bmp.PixelFormat := pf24Bit;
 Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
 for Y := 0 to Bmp.Height - 1 do
 begin
 Row := Bmp.Scanline[Y];
 StartX := -1;
 if Y = 0 then
 TransparentColor := Row[0];
 for X := 0 to Bmp.Width - 1 do
 begin
 if (Row[X].rgbtRed = TransparentColor.rgbtRed)
 and (Row[X].rgbtGreen = TransparentColor.rgbtGreen)
 and (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
 begin
 if StartX = -1 then StartX := X;
 end
 else
 begin
 if StartX > -1 then
 begin
 Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
 try
 CombineRGN(Result, Result, Excl, RGN_DIFF);
 StartX := -1;
 finally
 DeleteObject(Excl);
 end;
 end;
 end;
 end;
 if StartX > -1 then
 begin
 Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
 try
 CombineRGN(Result, Result, Excl, RGN_DIFF);
 finally
 DeleteObject(Excl);
 end;
 end;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
 Bmp: TBitmap;
begin
 Bmp := TBitmap.Create;
 try
 Bmp.LoadFromFile('C:\YourBitmap.bmp');
 FRegion := CreateRegion(Bmp);
 SetWindowRGN(Handle, FRegion, True);
 finally
 Bmp.Free;
 end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 DeleteObject(FRegion);
end;
end.
ID: 03788
Category:Графика
Category:Bitmap
Формат wave файла

TWaveHeader = record
 Marker1: array[0..3] of AnsiChar;
 BytesFollowing: LongInt;
 Marker2: array[0..3] of AnsiChar;
 Marker3: array[0..3] of AnsiChar;
 Fixed1: LongInt;
 FormatTag: Word;
 Channels: Word;
 SampleRate: LongInt;
 BytesPerSecond: LongInt;
 BytesPerSample: Word;
 BitsPerSample: Word;
 Marker4: array[0..3] of AnsiChar;
 DataBytes: LongInt;
end;
Для создания собственного WAV-файла сделайте следующее:
DataBytes := Channels;
DataBytes := DataBytes * SampleRate;
DataBytes := DataBytes * Resolution;
DataBytes := DataBytes div 8;
DataBytes := DataBytes * Duration;
DataBytes := DataBytes div 1000;
WaveHeader.Marker1 := 'RIFF';
WaveHeader.BytesFollowing := DataBytes + 36;
WaveHeader.Marker2 := 'WAVE';
WaveHeader.Marker3 := 'fmt ';
WaveHeader.Fixed1 := 16;
WaveHeader.FormatTag := 1;
WaveHeader.SampleRate := SampleRate;
WaveHeader.Channels := Channels;
WaveHeader.BytesPerSecond := Channels;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * SampleRate;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * Resolution;
WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond div 8;
WaveHeader.BytesPerSample := Channels * Resolution div 8;
WaveHeader.BitsPerSample := Resolution;
WaveHeader.Marker4 := 'data';
WaveHeader.DataBytes := DataBytes;
Остальная часть файлы является звуковыми данными. Порядок следования: верхний уровень для левого канала, верхний уровень для правого канала и так далее. Для моно или 8-битных файлов сделайте соответствующие изменения.
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 04306
Category:Форматы файлов
Формат и размер dBase-поля

=== Формат и размер dBase-поля ===
procedure GetdBaseFieldTypes(t: TTable; var l: TStringList);
var
 pF: pFLDDesc;
 cProps: CURProps;
 p: pFLDDesc;
 i: Byte;
 w: Word;
 s: string;
 oldmode: LongInt;
begin
 Check(DbiGetCursorProps(t.Handle, cProps));
 Check(DbiGetProp(hDBIObj(t.Handle), curXLTMODE, oldmode, SizeOf(LongInt), w));
 Check(DbiSetProp(hDBIObj(t.Handle), curXLTMODE, LongInt(xltNONE)));
 try
 if MaxAvail < (cProps.iFields * SizeOf(FLDDesc)) then
 raise EOutofMemory.Create('Недостаточно памяти для процесса');
 GetMem(pF, (cProps.iFields * SizeOf(FLDDesc)));
 Check(DbiGetFieldDescs(t.Handle, pF));
 p := pF;
 for i := 1 to cProps.iFields do
 begin
 with p^ do
 begin
 s := IntToStr(iFldNum) + ' : ' + StrPas(szName) + ' : ';
 case iFldType of
 fldDBCHAR:
 begin { Char string, строка символов }
 s := s + 'CHARACTER(' + IntToStr(iUnits1) + ')';
 end;
 fldDBNUM:
 begin { Number, число }
 s := s + 'NUMBER(' + IntToStr(iUnits1) + ',' + InttoStr(iUnits2) + ')';
 end;
 fldDBMEMO:
 begin { Memo (blob), МEMO-BLOB-поле }
 s := s + 'MEMO';
 end;
 fldDBBOOL:
 begin { Logical, лочическая величина }
 s := s + 'LOGICAL';
 end;
 fldDBDATE:
 begin { Date, поле даты }
 s := s + 'DATE';
 end;
 fldDBFLOAT:
 begin { Float, числа с плавающей точкой }
 s := s + 'FLOAT(' + IntToStr(iUnits1) + ',' + InttoStr(iUnits2) + ')';
 end;
 fldDBLOCK:
 begin { Логический тип LOCKINFO }
 s := s + 'LOCKINFO';
 end;
 fldDBOLEBLOB:
 begin { OLE object (blob), OLE-объект, BLOB-поле }
 s := s + 'OLE';
 end;
 fldDBBINARY:
 begin { Binary data (blob), двоичные данные, BLOB-поле }
 s := s + 'BINARY';
 end;
 else
 s := s + 'НЕИЗВЕСТНО';
 end;
 end;
 l.Add(s);
 Inc(p);
 end;
 finally
 Check(DbiSetProp(hDBIObj(t.Handle), curXLTMODE, oldmode));
 FreeMem(pF, (cProps.iFields * SizeOf(FLDDesc)));
 end;
end;
Author: Eryk Bottomley
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02701
Формат файла ASCII-схемы

=== Формат файла ASCII-схемы ===
В файле asciidrv.txt насчет последнего числа в строке схемы поля говорится:
"* Offset - Number of characters from the beginning of the line that the field begins. Used for FIXED format only." (Offset - количество символов он начала линии до начала поля. Используется только для фиксированного формата.).
С тех пор, как мой файл имеет переменный (Variable) формат, я задал в каждой строке смещение, равное нулю. После некоторых попыток, чтобы заставить это работать, я следал следующие изменения:
 [discs]
 filetype = varying
 charset = ascii
 delimiter = "
 separator = ,
 field1 = id,char,10,0,1
 field2 = title,char,30,0,2
 field3 = artist,char,30,0,3
 ...
 field36 = song30,char,50,0,36
После более произвольных изменений это стало таким:
 [discs]
 filetype = varying
 charset = ascii
 delimiter = "
 separator = ,
 field1 = id,char,10,0,10
 field2 = title,char,30,0,20
 field3 = artist,char,30,0,30
 ...
 field36 = song30,char,50,0,360
и внезапно все заработало! Для поля, которое игнорируется форматом файла, "Offset" несомненно дало огромный эффект.
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02972
Category:Базы данных
Category:CSV
Форматирование строки с использованием подстановочных символов

=== Форматирование строки с использованием подстановочных символов ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Форматирование строки с использованием подстановочных символов %1, %2 и т.д.
Функция заменяет в строке Str все подстроки '%1', '%2', и т.д. На
соответствующие значения из массива Values. При этом значения этого массива
не должны содержать подстановочных подстрок, в противном случае возможно
зависание функции.
Зависимости: SysUtils
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 15 мая 2002 г.
***************************************************** }
{Эта функция работает неверно, если в строке, на которую надо
заменить %1,%2,… содержится одна из строк %1,%2,…
( она зависнет в бесконечном цикле )}
function FmtString(const Str: string; const Values: array of string): string;
 function InternalPos(SubStr: string; Str: PChar; out P: Integer): Integer;
 var
 Ptr: PChar;
 begin
 Ptr := StrPos(Str, PChar(SubStr));
 if Ptr = nil then
 Result := -1
 else
 Result := Integer(Ptr) - Integer(Str);
 P := Result;
 end;
 function InternalReplace(const Str, OldSub, NewSub: string): string;
 var
 PrePos: Integer;
 CurPos: Integer;
 OldLen, NewLen: Integer;
 begin
 PrePos := 1;
 Result := Str;
 OldLen := Length(OldSub);
 NewLen := Length(NewSub);
 while InternalPos(OldSub, @Result[PrePos], CurPos) >= 0 do
 begin
 Inc(PrePos, CurPos);
 Delete(Result, PrePos, OldLen);
 Insert(NewSub, Result, PrePos);
 Inc(PrePos, NewLen);
 end;
 end;
var
 i: Integer;
begin
 Result := Str;
 for i := High(Values) downto Low(Values) do
 Result := InternalReplace(Result, '%' + IntToStr(i + 1), Values[i]);
end;
// Пример использования: 
FmtString('%1 %2', ['Пример', 'использования']);
Source: http://delphibase.endimus.com
ID: 00894
Функции для выделения, перераспределения и освобождения памяти

=== Функции для выделения, перераспределения и освобождения памяти ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Функции для выделения/перераспределения/освобождения памяти
Модуль содержит функции для работы с блоками памяти.
AllocateMem - выделяет блок памяти из Count записей по RecSize байт, возвращает
адрес выделенного блока памяти в случае успеха или nil в случае ошибки.
ReallocateMem - устанавливает новый размер блока памяти, выделенного функцией
AllocateMem. В качестве параметра Pointer можт быть использован как
типизированный так и нетипизированный указатель.
DeallocateMem - освобождает память, выделенную функциями AllocateMem или
ReallocateMem. В качестве параметра Pointer можт быть использован как
типизированный так и нетипизированный указатель.
MemSize - возвращает размер блока памяти, выделенного функциями AllocateMem или
ReallocateMem.
Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 21 мая 2002 г.
***************************************************** }
unit MemFuncs;
uses Windows;
interface
function AllocateMem(Count: Integer; RecSize: Integer): Pointer;
procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
procedure DeallocateMem(var Pointer);
function MemSize(P: Pointer): Integer;
implementation
function LocalHandle; external kernel32 name 'LocalHandle';
function AllocateMem(Count: Integer; RecSize: Integer = 1): Pointer;
asm
 test eax, eax
 jle @@10
 test edx, edx
 jle @@10
 imul edx
 push eax
 push LHND
 call LocalAlloc
 push eax
 call LocalLock
 ret
@@10:
 xor eax, eax
end;
procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
asm
 push ebx
 mov ebx, eax
 mov eax, [ebx]
 test eax, eax
 jnz @@10
 mov eax, edx
 mov edx, ecx
 call AllocateMem
 mov [ebx], eax
 pop ebx
 ret
@@10:
 push ecx
 push edx
 push eax
 call LocalHandle
 pop edx
 pop ecx
 test eax, eax
 jnz @@20
 pop ebx
 ret
@@20:
 push eax
 mov eax, edx
 imul ecx
 mov edx, eax
 pop eax
 push LHND
 push edx
 push eax
 call LocalRealloc
 push eax
 call LocalLock
 mov [ebx], eax
 pop ebx
end;
procedure DeallocateMem(var Pointer);
asm
 push ebx
 mov ebx, eax
 mov eax, [ebx]
 test eax, eax
 jz @@10
 push eax
 call LocalHandle
 test eax, eax
 jz @@10
 push eax
 push eax
 call LocalUnlock
 call LocalFree
@@10:
 xor eax, eax
 mov [ebx], eax
 pop ebx
end;
function MemSize(P: Pointer): Integer;
asm
 test eax, eax
 jnz @@10
 ret
@@10:
 push eax
 call LocalHandle
 test eax, eax
 jnz @@20
 ret
@@20:
 push eax
 call LocalSize
end;
end.
Source: http://delphibase.endimus.com
ID: 00836
Функции для изменения и получения чуствительности мышки

=== функции для изменения и получения чуствительности мышки ===
function SetMouseSpeed(NewSpeed: Integer): Boolean;
begin
 Result := SystemParametersInfo(SPI_SETMOUSESPEED, 1, Pointer(NewSpeed), SPIF_SENDCHANGE);
end;
function GetMouseSpeed: Integer;
var
 Int: Integer;
begin
 SystemParametersInfo(SPI_GETMOUSESPEED, 0, @Int, SPIF_SENDCHANGE);
 Result := Int;
End;
Author: Radmin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01567
Функции для работы с памятью

=== Функции для работы с памятью ===
; Addr: Возвращает указатель на объект.
; AllocMem: Выделяет на куче блок памяти заданного размера, заполняет его нулями и возвращает указатель на начало блока.
; CompareMem: Выполняет бинарное сравнение двух участков памяти.
; GetHeapStatus: Возвращает текущее состояние диспетчера памяти.
; GetMemoryManager: Возвращает значения указателей полей текущего диспетчера памяти.
; IsMemoryManagerSet: Определяет, используется в настоящий момент диспетчер памяти, установленный по умолчанию, или был установлен другой диспетчер.
; Ptr: Возвращает указатель на адрес памяти, переданный в качестве аргумента.
; SizeOf: Возвращает размер памяти, занимаемый переменной.
; SetMemoryManager: Устанавливает значения полей диспетчера памяти.
; SysFreeMem: Высвобождает память, используемую динамической переменной.
; SysGetMem: Выделяет блок памяти заданного размера и возвращает указатель на него.
; SysReallocMem: Изменяет размер динамически распределенного блока памяти.
Source: Взято с http://atrussk.ru/delphi/
ID: 02072
Category:Справочники
Функции и процедуры для работы с drag-and-drop операциями

=== Функции и процедуры для работы с drag-and-drop операциями ===
procedure CancelDrag(); 
Отменяет текущую drag-and-drop или drag-and-dock операцию. 
function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
Функция возвращает объект базового класса TControl, к которому относится позиция экрана с координатами, определенными параметром Pos. Данная функция используется для определения потенциального получателя drag-and-drop или drag-and-dock операции. Если для указанной позиции не существует никакого оконного средства управления, то функция возвращает nil. Параметр AllowDisabled определяет, будут ли учитываться заблокированные (disabled) объекты. 
function IsDragObject(Sender: TObject): Boolean;
Функция определяет, является ли объект, определенный в параметре Sender, потомком класса TDragObject. Данную функцию можно использовать в качестве параметра Source в обработчиках событий OnDragOver и OnDockOver для того, чтобы определить будет ли принят перетаскиваемый объект. Также функцию IsDragObject можно использовать в качестве параметра Source в обработчиках событий OnDragDrop и OnDockDrop для того, чтобы правильно интерпретировать перетаскиваемый объект. 
Source: Взято с http://atrussk.ru/delphi/
ID: 00371
Category:VCL
Category:DragAndDrop
Функции и процедуры для работы с данными перечислимого типа

=== Функции и процедуры для работы с данными перечислимого типа ===
 Dec Уменьшает значение переменной на заданную величину. 
 Inc Увеличивает значение переменной на заданную величину. 
 Odd Определяет четность аргумента. 
 Ord Возвращает порядковый номер выражения перечислимого типа или код ASCII выражения символьного типа. 
 Pred Возвращает значение, предшествующее аргументу. 
 Succ Возвращает значение, следующее за аргументом. 
Source: Взято с http://atrussk.ru/delphi/
ID: 00261
Функции и процедуры для работы с курсором

== CursorToIdent ==
function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
Функция возвращает строковое значение предопределенной константы, определяющее вид курсора. Числовое значение, определяющее вид курсора, передается в параметре Cursor. Строковое значение константы возвращается в параметре Ident. Если для указанного числового значения, определяющего вид курсора, есть соответствующая строковая константа, то функция возвращает True, а иначе - False.
На практике возникают ситуации, когда необходимо, чтобы функция возвращала в результате строковое значение даже в том случае, когда для числового значения вида курсора, нет предопределенной строковой константы. В данных ситуациях используйте функцию CursorToString
== CursorToString ==
function CursorToString(Cursor: TCursor): string;
type TCursor = -32768...32767;
Функция возвращает строковое значение константы или числа, соответствующих указанному виду курсора. Числовое значение, определяющее вид курсора, передается в параметре Cursor. Если указанному значению соответствует предопределенная строковая константа, то функция возвращает имя этой константы, иначе возвращается строковое представление значения переданного в параметре Cursor.
== GetCursorValues ==
procedure GetCursorValues(Proc: TGetStrProc);
type TGetStrProc = procedure(const S: string) of object;
Процедура передает каждое предопределенное в VCL имя курсора (значение предопределенной строковой константы, определяющей вид курсора) процедуре повторного вызова Proc.
== IdentToCursor ==
function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
Функция возвращает числовое значение, соответствующее строковой константе, определяющей вид курсора. Строковое значение передается в параметре Ident. Числовое значение возвращается в переменной Cursor. При успешном выполнении функция возвращает True, а если значение Ident не является предопределенной константой, то функция возвращает False. Данная функция обратна по функциональности функции CursorToIdent.
== StringToCursor ==
function StringToCursor(const S: string): TCursor;
type TCursor = -32768...32767;
Функция преобразовывает строковое значение S, определяющее вид курсора, в значение типа TCursor. Функция обратна по функциональности функции CursorToString. Параметр S должен представлять собой либо предопределенную константу вида курсора, либо строковое представление соответствующего ему числового значения, в противном случае возникнет исключение EConvertError.
var
 I1, I2: Longint;
begin
 I1:= StringToCursor('crHelp'); // I1:= -20
 I2:= StringToCursor('-20'); // I2:= -20
end;
Source: Взято с http://atrussk.ru/delphi/
ID: 02330
Category:Справочники
Функции и процедуры управления мышью

=== Функции и процедуры управления мышью ===
; function FindVCLWindow(const Pos: TPoint): TWinControl;
: Функция возвращает оконное средство управления для местоположения, определенного параметром Pos. Если для данного местоположения нет оконных средств управления, то функция возвращает nil. 
; function GetCaptureControl: TControl;
: Функция возвращает средство управления класса TControl, которое получает в текущий момент все сообщения от мыши.
; function SetCaptureControl(Control: TControl);
: Функция передает управление мышью средству управления, определенному в параметре Control. Данное средство управления будет получать все сообщения от мыши, пока управление мышью не будет передано другому средству управления с помощью функции SetCaptureControl или функцией ReleaseCapture Windows API. 
Source: Взято с http://atrussk.ru/delphi/
ID: 01603
Функции преобразования UNICODE и ANSI строк

=== Функции преобразования UNICODE и ANSI строк ===
{ Преобразовывает строку формата ANSI в Unicode-строку. }
function StringToWideChar(const Source: string; Dest: PWideChar; DestSize: Integer): PWideChar; 
{ Преобразовывает указанное количество символов Unicode-строки в ANSI строку. }
function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
{ Преобразовывает заданное количество символов Unicode-строки в ANSI формат и копирует результат в указанную переменную. }
procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer; var Dest: string);
{ Преобразовывает длинную строку Unicode в ANSI строку. }
function WideCharToString(Source: PWideChar): string;
{ Преобразовывает строку формата Unicode в ANSI-формат и копирует результирующую строку в указанную переменную. }
procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer; var Dest: string);
Source: Взято с http://atrussk.ru/delphi/
ID: 00152
Функции редактора полей во время выполнения программы

=== Функции редактора полей во время выполнения программы ===
; Возможен ли вызов функций редактора полей (Fields Editor) во время выполнения программы?
: Да. Если вы определили поля во время разработки приложения, то во время выполнения можно менять их свойства (например, Size).
Например, следующий код изменяет каждый размер поля TField.Size так, чтобы соответствовать фактическому размеру поля открываемого набора данных:
procedure SetupFieldsAndOpenDataset(DataSet: TDataSet);
var
 FieldNum, DefNum: Integer;
begin
 with DataSet do
 begin
 if Active then
 Close;
 FieldDefs.Update; { набор данных должен быть закрыт }
 { ищем каждое предопределенное TField в DataSet.FieldDefs: }
 for FieldNum := FieldCount - 1 downto 0 do
 with Fields[FieldNum] do
 begin
 DefNum := FieldDefs.IndexOf(FieldName);
 if DefNum < 0 then
 raise Exception.CreateFmt(
 'Поле "%s" не найдено в наборе данных "%s"',
 [FieldName, Dataset.Name]);
 { устанавливаем свойство size: }
 Size := FieldDefs[DefNum].Size;
 end;
 Open;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02619
Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi

=== Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi ===
Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi. По умолчанию в дизайнере Delphi отступы равны 8 пикселям 
procedure TForm1.DrawGrid;
var
 TmpBmp: TBitmap;
begin
 TmpBmp := TBitmap.Create;
 try
 with TmpBmp do
 begin
 Width := 8;
 Height := 8;
 Canvas.Brush.Color := clBtnFace;
 Canvas.FillRect(TmpBmp.Canvas.ClipRect);
 Canvas.Pixels[0, 0] := clBlack;
 Canvas.Pixels[0, Height] := clBlack;
 Canvas.Pixels[Width, 0] := clBlack;
 Canvas.Pixels[Width, Height] := clBlack;
 end;
 with Canvas, Brush do
 begin
 Bitmap := TBitmap.Create;
 try
 Bitmap.Assign(TmpBmp);
 Canvas.FillRect(Canvas.ClipRect);
 finally
 Bitmap.Free;
 end;
 end;
 finally
 TmpBmp.Free;
 end;
end;
{ Использование }
procedure TForm1.FormPaint(Sender: TObject);
begin
 DrawGrid; 
end;
Ещё способ, рисует сетку либо линии на компоненте AObject цветом FGridColor, в параметре ACanvas нужно передать холст компонента, FSizeX и FSizeY определяют размер сетки либо линий:
type
 TGridType = (gtDots, gtLines);
procedure Draw(AObject: TControl; ACanvas: TCanvas; FGridType: TGridType; FGridColor: TColor;
 FSizeX, FSizeY: Integer);
var
 ColorRGB, X, Y, MaxX, MaxY: Integer;
 DC: HDC;
begin
 MaxX := AObject.ClientWidth Div FSizeX;
 MaxY := AObject.ClientHeight Div FSizeY;
 case FGridType of
 gtDots:
 begin
 ColorRGB := ColorToRGB(FGridColor);
 DC := ACanvas.Handle;
 for X := 0 to MaxX do
 for Y := 0 to MaxY do
 SetPixel(DC, X * FSizeX, Y * FSizeY, ColorRGB);
 end;
 
 gtLines:
 begin
 ACanvas.Pen.Color := FGridColor;
 for X := 0 to MaxX do
 begin
 ACanvas.MoveTo(X * FSizeX, 0);
 ACanvas.LineTo(X * FSizeY, AObject.ClientHeight);
 end;
 for Y := 0 to MaxY do
 begin
 ACanvas.MoveTo(0, Y * FSizeY);
 ACanvas.LineTo(AObject.ClientWidth, Y * FSizeY);
 end;
 end;
 end;
end;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00431
Функция вычисления суммы полей

=== Функция вычисления суммы полей ===
function SumField(const fieldName: OpenString): LongInt;
var
 fld: TField;
 bm: TBookmark; // закладка
begin
 Result := 0;
 tbl.DisableControls; // выключаем реакцию на перемещение по набору данных
 bm := tbl.GetBookmark; // сохраняем позицию
 fld := tbl.FieldByName(fieldName);
 tbl.First;
 while not tbl.Eof do
 begin
 Result := Result + fld.AsInteger;
 tbl.Next;
 end;
 tbl.GotoBookmark(bm); // позиционируем обратно
 tbl.EnableControls; // включаем реакцию на перемещение по набору данных
end;
Примечание Vit: данный способ один из худших, а точнее самый худший из всех возможных и мог бы служить пособием того как делать не следует (собственно для этого я его здесь и привёл). На больших таблицах, особенно на серверных базах данных выполнение этого кода будет исключительно медленное. Намного выгоднее выполнение SQL запроса вида:
SELECT Sum(MyField) FROM MyTable
И в коде чтение первого поля первой записи:
function Form1.GetRecordSum(TableName: string): Integer;
begin
 // на форме должен стоять компонент Query1 подсоединённый к нужной базе данных (код будет работать для любых разновидностей TQuery, TADOQuery и т.д.)
 Query1.Active := False;
 Query1.SQL.Text := 'SELECT Sum(MyField) FROM ' + TableName;
 Query1.Active := True;
 Result := Query1.Fields[0].AsInteger;
 Query1.Active := False;
end;
при этом все другие открытые TTable/TQuery и т.п. на этой таблице могут продолжать оставаться открытыми.
Source: Взято с http://delphiworld.narod.ru
ID: 02560