nyuuzyou/wikis huggingface dataset:
Как разделить строку на элементы, Аналог VB функции Split

=== Как разделить строку на элементы, Аналог VB функции Split ===
Вариант 1. 
В Дельфи есть специальный класс для хранения массивов строк - TStringList - очень рекомендую. Вот как вашу строку превратить в TStringList:
var 
 t: TStringList;
begin
 t := TStringList.Create(); // создаём класс
 // заменяем все пробелы на символы конца строки 
 t.Text := StringReplace('Ваша строка для разделения', ' ', #13#10, [rfReplaceAll]); 
 // теперь можно убедится что у вас строка разбита на элементы:
 ShowMessage(t[0]);
 ShowMessage(t[1]);
 ShowMessage(t[2]);
 ShowMessage(t[3]);
 // после работы надо уничтожить класс
 t.Free();
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00141
----
Вариант 2. Используем стандартные массивы:
var 
 a: array of string; // наш массив
 s: string; // строка которую мы будем разбивать
begin
 s := 'Windows Messages SysUtils Variants Classes Graphics Controls Forms';
 repeat // мы постепенно заполняем массив на каждом шаге цикла по 1 элементу
 SetLength(a, Length(a)+1); // увеличиваем размер массива на 1
 if Pos(' ', s) > 0 then // если есть пробел то надо взять слово до пробела
 begin
 a[Length(a)-1] := Copy(s, 1, Pos(' ', s)); // присвоение последнему элементу массива первого слова
 s := Copy(s, Pos(' ', s) + 1, Length(s)); // удаляем из строки первое слово
 end
 else // в строке осталось только одно слово
 begin
 a[Length(a)-1] := s; // присвоим последнее слово
 Break; // выход из цикла
 end;
 until False; // цикл бесконечный, выход изнутри
// теперь проверяем что получили
 ShowMessage(a[0]);
 ShowMessage(a[1]);
 ShowMessage(a[2]);
После использования массива не забудьте освободить память a := nil или SetLength(a, 0)
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
----
procedure SplitOnWords(const s: string; Delimiters: set of char; Strings: TStrings);
var
 p, sp: PChar;
 str: string;
begin
 include(Delimiters, #0); //чтоб уж наверняка
 p := Pointer(s); 
 while true do
 begin 
 // пропускаем все разделители в начале
 while p^ in Delimiters do
 begin
 if p^ = #0 then
 Exit
 else
 Inc(p);
 end;
 sp := p;
 // пока не кончилось слово.
 while not (p^ in Delimiters) do Inc(p);
 // запоминаем слово
 SetLength(str, Cardinal(p) - Cardinal(sp));
 Move(sp^, Pointer(str)^, Cardinal(p) - Cardinal(sp));
 Strings.Add(str);
 end; 
end;
Author: Fantasist
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00142
----
См. также Парсинг строк
Как различать звуковые CD

=== Как различать звуковые CD ===
лазерный диск имеет свой идентификатор. Если сохранить, какому диску соответствует какой идентификатор, то можно реализовать определение диска. 
В этой программе при нажатии на кнопку происходит проверка, есть ли название этого диска в файле. Если есть, то в заголовок окна выводится его название, если нет, то введенное пользователем название диска сохраняется в файл.
uses MMSystem, IniFiles;
function GetCDid: string;
var
 InfoParams: TMCI_Info_Parms;
 s: array [0..63] of char;
 OpenParams: TMCI_Open_Parms;
 CloseParams: TMCI_Generic_Parms;
begin
 Result := ;
 FillChar(InfoParams, sizeof(InfoParams), #0);
 InfoParams.lpstrReturn := @s[0];
 InfoParams.dwRetSize := 10;
 OpenParams.dwCallback := 0;
 OpenParams.lpstrDeviceType := 'CDAudio';
 if mciSendCommand(0, mci_Open, mci_Open_Type,
 Longint(addr(OpenParams))) <> 0 then Exit;
 if mciSendCommand(OpenParams.wDeviceID, MCI_INFO,
 MCI_INFO_MEDIA_IDENTITY, longint(@InfoParams)) = 0
 then Result := s;
 mciSendCommand(OpenParams.wDeviceID, mci_Close, 0,
 Longint(addr(CloseParams)));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 id: string;
 ini: TIniFile;
 name: string;
begin
 id := GetCDid;
 if id = then
 begin
 Form1.Caption := 'No disk';
 Exit;
 end;
 ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'cd.ini');
 name := ini.ReadString('CD', id, );
 if name = then begin
 name := 'CD name';
 if not InputQuery('CD name', 'Enter CD name:', name)
 then Exit;
 ini.WriteString('CD', id, name);
 end;
 Form1.Caption := name;
 ini.Destroy;
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: : Алексей Денисов
ID: 01406
Как различаются между собой Paint-события: Invalidate, Update и Refresh?

=== Как различаются между собой Paint-события: Invalidate, Update и Refresh? ===
* Invalidate весь объект перерисовывается заново; обычно перерисовывается только часть бывшая перед этим закрытой 
* Update незамедлительная перерисовка 
* Refresh Invalidate + Update 
ID: 00347
Как разместить прозрачную надпись на TBitmap?

procedure TForm1.Button1Click(Sender: TObject);
var
 OldBkMode: Integer;
begin
 Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
 OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle, TRANSPARENT);
 Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello');
 SetBkMode(Image1.Picture.Bitmap.Canvas.Handle, OldBkMode);
end;
Author: Aziz(JINX)
Source: http://delphi.vitpc.com/
ID: 03650
ID: 03881
Category:Графика
Category:Bitmap
Category:Работа с текстом
Как разрезать wav файл?

Для чтения заголовка смотрите раздел:
* Как прочитать заголовок wav файла?
Код для разрезания файла WAV на две части:
function SplitWave(Source, Dest1, Dest2: TFileName; Pos: Integer): Boolean;
var
 f1, f2, f3: TFileStream;
 w: TWaveHeader;
 p: Integer;
begin
 Result := False
 if not FileExists(Source) then
 Exit;
 try
 w := GetWaveHeader(Source);
 p := Pos - SizeOf(TWaveHeader);
 f1 := TFileStream.Create(Source, fmOpenRead);
 f2 := TFileStream.Create(Dest1, fmCreate);
 f3 := TFileStream.Create(Dest2, fmCreate);
 {++++++++++Create file 1 ++++++++++++++++}
 w.len := p;
 f2.Write(w, SizeOf(w));
 f1.Position := SizeOf(w);
 f2.CopyFrom(f1, p);
 {++++++++++++++++++++++++++++++++++++++++}
 {+++++++++++Create file 2 +++++++++++++++}
 w.len := f1.Size - Pos;
 f3.Write(w, SizeOf(w));
 f1.Position := Pos;
 f3.CopyFrom(f1, f1.Size - Pos);
 {++++++++++++++++++++++++++++++++++++++++}
 finally
 f1.Free;
 f2.Free;
 f3.Free;
 end;
 Result := True;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04300
Category:Форматы файлов
Как разрешить / запретить переключение между задачами?

=== Как разрешить / запретить переключение между задачами? ===
только для ALT+TAB и CTRL+ESC
Это не совсем профессиональный способ, но он работает! Мы просто эмулируем запуск и остановку скринсейвера.
procedure TaskSwitchingStatus(State: Boolean); 
var 
 OldSysParam: LongInt; 
begin 
 SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(State), @OldSysParam, 0);
end;
Source: Взято из http://forum.sources.ru
ID: 02052
Как распечатать Excel файл?

{
 This is a simple example how to print an Excel file using OLE.
}
uses
 ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
 ExcelApp: OLEVariant;
begin
 // Create an Excel instance
 // Excel Instanz erzeugen
 ExcelApp := CreateOleObject('Excel.Application');
 try
 ExcelApp.Workbooks.Open('C:\test\xyz.xls');
 // you can also modify some settings from PageSetup
 // Man kann auch noch einige Einstellungen von "Seite Einrichten" anpassen
 ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;
 // Print it out
 // Ausdrucken
 ExcelApp.Worksheets.PrintOut;
 finally
 // Close Excel
 // Excel wieder schliessen
 if not VarIsEmpty(ExcelApp) then
 begin
 ExcelApp.Quit;
 ExcelApp := Unassigned;
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04378
Category:COM
Category:MS Office
Как распечатать PRN file?

uses
 Printers, Winspool;
function SpoolFile(const FileName, PrinterName: string): Integer;
var
 Buffer: record
 JobInfo: record // ADDJOB_INFO_1
 Path: PChar;
 JobID: DWORD;
 end;
 PathBuffer: array[0..255] of Char;
 end;
 SizeNeeded: DWORD;
 Handle: THandle;
 PrtName: string;
 ok: Boolean;
begin
 // Flush job to printer
 PrtName := PrinterName;
 if PrtName = then
 PrtName := Printer.Printers[Printer.PrinterIndex]; // Default printer name
 ok := False;
 if OpenPrinter(PChar(PrtName), Handle, nil) then
 if AddJob(Handle, 1, @Buffer, SizeOf(Buffer), SizeNeeded) then
 if CopyFile(PChar(FileName), Buffer.JobInfo.Path, True) then
 if ScheduleJob(Handle, Buffer.JobInfo.JobID) then
 ok := True;
 if not ok then Result := GetLastError
 else
 Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if SpoolFile('c:\test.prn', Printer.Printers[0]) = 0 then
 ShowMessage('No error...');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03227
Category:Принтер
Как распечатать TStringGrid?

uses
 Printers;
procedure PrintGrid(sGrid: TStringGrid; sTitle: string);
var
 X1, X2: Integer;
 Y1, Y2: Integer;
 TmpI: Integer;
 F: Integer;
 TR: TRect;
begin
 Printer.Title := sTitle;
 Printer.BeginDoc;
 Printer.Canvas.Pen.Color := 0;
 Printer.Canvas.Font.Name := 'Times New Roman';
 Printer.Canvas.Font.Size := 12;
 Printer.Canvas.Font.Style := [fsBold, fsUnderline];
 Printer.Canvas.TextOut(0, 100, Printer.Title);
 for F := 1 to sGrid.ColCount - 1 do
 begin
 X1 := 0;
 for TmpI := 1 to (F - 1) do
 X1 := X1 + 5 * (sGrid.ColWidths[TmpI]);
 Y1 := 300;
 X2 := 0;
 for TmpI := 1 to F do
 X2 := X2 + 5 * (sGrid.ColWidths[TmpI]);
 Y2 := 450;
 TR := Rect(X1, Y1, X2 - 30, Y2);
 Printer.Canvas.Font.Style := [fsBold];
 Printer.Canvas.Font.Size := 7;
 Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]);
 Printer.Canvas.Font.Style := [];
 for TmpI := 1 to sGrid.RowCount - 1 do
 begin
 Y1 := 150 * TmpI + 300;
 Y2 := 150 * (TmpI + 1) + 300;
 TR := Rect(X1, Y1, X2 - 30, Y2);
 Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]);
 end;
 end;
 Printer.EndDoc;
end;
// Examplem, Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
begin
 PrintGrid(StringGrid1, 'Print Stringgrid');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03226
Category:Принтер
Category:StringGrid
Как распечатать WEB страничку при помощи HTML контрола?

Можно использовать два метода HTML контрола: AutoPrint или PrintPage.
Пример использования AutoPrint:
uses Printers;
procedure TForm1.Button1Click(Sender: TObject);
var
 OldCur: TCursor;
begin
 OldCur := Screen.Cursor;
 with Printer do
 begin
 BeginDoc;
 HTML1.AutoPrint(handle);
 Title := HTML1.URL;
 EndDoc;
 end;
 Screen.Cursor := OldCur;
end;
Source: http://forum.sources.ru
ID: 03534
Category:Связь
Category:Web
Как распечатать bitmap?

=== Как распечатать bitmap? ===
procedure StretchPrint(R: TRect; ABitmap: Graphics.TBitmap);
var
 dc: HDC;
 isDcPalDevice: Bool;
 hDibHeader: THandle;
 pDibHeader: pointer;
 hBits: THandle;
 pBits: pointer;
 ppal: PLOGPALETTE;
 pal: hPalette;
 Oldpal: hPalette;
 i: integer;
begin
 pal := 0;
 OldPal := 0;
 { Get the screen dc }
 dc := GetDc(0);
 { Allocate memory for a DIB structure }
 hDibHeader := GlobalAlloc(GHND, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256));
 { get a pointer to the alloced memory }
 pDibHeader := GlobalLock(hDibHeader);
 { fill in the dib structure with info on the way we want the DIB }
 FillChar(pDibHeader^, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256), #0);
 PBITMAPINFOHEADER(pDibHeader)^.biSize := sizeof(TBITMAPINFOHEADER);
 PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
 PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
 PBITMAPINFOHEADER(pDibHeader)^.biWidth := ABitmap.width;
 PBITMAPINFOHEADER(pDibHeader)^.biHeight := ABitmap.height;
 PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
 { find out how much memory for the bits }
 GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, nil, TBitmapInfo(pDibHeader^),
 DIB_RGB_COLORS);
 { Alloc memory for the bits }
 hBits := GlobalAlloc(GHND, PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
 { Get a pointer to the bits }
 pBits := GlobalLock(hBits);
 { Call fn again, but this time give us the bits! }
 GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, pBits, PBitmapInfo(pDibHeader)^,
 DIB_RGB_COLORS);
 { Release the screen dc }
 ReleaseDc(0, dc);
 { Just incase the printer drver is a palette device }
 isDcPalDevice := false;
 if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE then
 begin
 { Create palette from dib }
 GetMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
 FillChar(pPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
 pPal^.palVersion := $300;
 pPal^.palNumEntries := 256;
 for i := 0 to (pPal^.PalNumEntries - 1) do
 begin
 pPal^.palPalEntry[i].peRed := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
 pPal^.palPalEntry[i].peGreen := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
 pPal^.palPalEntry[i].peBlue := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
 end;
 pal := CreatePalette(pPal^);
 FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
 oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
 isDcPalDevice := true
 end;
 { send the bits to the printer }
 StretchDiBits(Printer.Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
 R.Bottom - R.Top, 0, 0, ABitmap.Width, ABitmap.Height, pBits,
 PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS, SRCCOPY);
 { Just incase you printer drver is a palette device }
 if isDcPalDevice = true then
 begin
 SelectPalette(Printer.Canvas.Handle, oldPal, false);
 DeleteObject(Pal);
 end;
 { Clean up allocated memory }
 GlobalUnlock(hBits);
 GlobalFree(hBits);
 GlobalUnlock(hDibHeader);
 GlobalFree(hDibHeader);
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03230
Category:Принтер
Category:Bitmap
Как распечатать decision grid?

procedure TForm1.Button2Click(Sender: TObject);
begin
 Printer.BeginDoc;
 try
 Printer.Canvas.MoveTo(100, 100);
 SetMapMode(Printer.Canvas.Handle, MM_ANISOTROPIC);
 SetWindowExtEx(Printer.Canvas.Handle,
 GetDeviceCaps(Canvas.Handle, LOGPIXELSX),
 GetDeviceCaps(Canvas.Handle, LOGPIXELSY),
 nil);
 SetViewportExtEx(Printer.Canvas.Handle,
 GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX),
 GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY),
 nil);
 grid.PaintTo(Printer.Canvas.Handle, 100, 100);
 finally
 Printer.EndDoc;
 end;
end;
ID: 03259
Category:Принтер
Как реализовать Drag and Drop в TTreeView

=== Как реализовать Drag and Drop в TTreeView ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls;
type
 TForm1 = class(TForm)
 TreeView1: TTreeView;
 Label1: TLabel;
 procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
 procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 private
 { Private declarations }
 procedure MoveNode(TargetNode, SourceNode: TTreeNode);
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
//
// Procedure which will move node and its subnodes
//
procedure TForm1.MoveNode(TargetNode, SourceNode: TTreeNode);
var
 nodeTmp: TTreeNode;
 i: Integer;
begin
 with TreeView1 do
 begin
 nodeTmp := Items.AddChild(TargetNode, SourceNode.Text);
 for i := 0 to SourceNode.Count - 1 do
 begin
 MoveNode(nodeTmp, SourceNode.Item[i]);
 end;
 end;
end;
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
 TargetNode, SourceNode: TTreeNode;
begin
 with TreeView1 do
 begin
 TargetNode := GetNodeAt(X, Y); // Get target node
 SourceNode := Selected;
 if (TargetNode = nil) then
 begin
 EndDrag(False);
 Exit;
 end;
 MoveNode(TargetNode, SourceNode);
 SourceNode.Free;
 end;
end;
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 if (Sender = TreeView1) then // If TRUE than accept the draged item
 begin
 Accept := True;
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 00716
ID: 01113
== См. также ==
* Drag and Drop в TTreeView
Как реализовать визуальный отсчет времени

=== Как реализовать визуальный отсчет времени ===
var Min3: integer;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Timer1.Enabled := True;
 Min3 := 3 * 60;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Label1.Caption := Format('%d : %2d',[Min3 div 60, Min3 mod 60 ]);
 Dec(Min3);
 if Min3 < 0 then
 // Что-то делаешь - 3 минуты закончились
end;
Source: http://delphiworld.narod.ru
ID: 00777
Как реализовать обработку информации одновременно несколькими потоками

=== Как реализовать обработку информации одновременно несколькими потоками ===
Запускайте Delphi. Итак, наша программа будет представлять из себя форму с двумя edit'ами и кнопкой. Добавьте их на форму.
При нажатии на кнопку будут осуществляться некоторые долгие вычисления. Если бы мы не использовали потоки, то, пока эти вычисления не закончатся, делать мы ничего бы не смогли. Надо было бы ждать. Но, так как потоки у нас будут, то во время долгих вычислений можно будет что-нибудь вводить во второй edit (он, собственно, только для этого и существует). В первый же edit наш поток будет выводить некоторые промежуточные результаты своей работы.
Добавьте в программу еще один модуль (меню File, New, Unit).
Внесите в окно кода нового модуля следующий код:
unit Unit2;
interface
uses
 Classes;
type
 TMyThread = class(TThread) //Новый класс
 private
 answer: Integer;
 protected
 procedure ShowResult;
 procedure Execute; override;
 end;
implementation
uses
 SysUtils, Unit1;
//Процедура для вывода информации из потока
procedure TMyThread.ShowResult;
begin
 Form1.Edit1.Text := IntToStr(answer);
end;
//Длинная процедура
procedure TMyThread.Execute;
var
 i: Integer;
begin
 for i := 1 to 10000 do
 begin
 answer := answer + 1;
 Synchronize(ShowResult);
 end;
end;
end.
Немного комментария по коду. В нашем модуле мы вводим новый класс TMyThread как «потомок» TThread. В экземпляре нашего класса и будет выполнятся отдельный поток программы. В классе есть процедура ShowResult для вывода информации из работающего потока в основной поток (форму) нашей программы. Кроме того, в классе есть наша версия метода Execute из родительского класса TThread. Обратите внимание, что в нашей реализации Execute мы пишем 
 Synchronize(ShowResult);
Тем самым наш поток что-то отправляет в основной поток программы (в данном случае, значение переменной answer). Делаем мы это посредством вызова Synchronize, в котором в качестве параметра указываем имя нужной процедуры. 
Теперь переходим к нашему основному модулю Unit1. Во-первых, добавьте в секцию uses ссылку на Unit2: 
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, 
 Forms, Dialogs, StdCtrls, Unit2;
Во-вторых, напишите обработчик для нажатия кнопки: 
procedure TForm1.Button1Click(Sender: TObject);
var
 MyThread: TMyThread;
begin
 MyThread := TMyThread.Create(False);
end;
Тут мы создаем второй поток для нашего приложения. Параметр False означает, что метод Execute для нашего потока вызовется немедленно.
Запускайте программу. Нажимайте на кнопку. В первом edit'е замелькают промежуточные результаты работы второго потока. Во время его работы вы можете вводить информацию во второй edit - т.е. работа одного потока не мешает работе другого.
Source: Взято с http://delphiworld.narod.ru
ID: 00304
Как редактировать группы и пользователей

=== Как редактировать группы и пользователей ===
например, подключился я к базе с правами админа и надо мне кого-нить подредактировать. Вот как это сделать можно?
ADD USER пользователь
ALTER USER пользователь PASSWORD новыйПароль прежнийПароль
DROP USER пользователь
а с группами как быть?
CREATE GROUP группа код[, группа код, …]
GRANT {привилегия[, привилегия, …]} ON
 {TABLE таблица |
 OBJECT объект|
CONTAINER контейнер } TO {имяПравообладателя[, имяПравообладателя, …]}
REVOKE {привилегия[, привилегия, …]} ON
 {TABLE таблица |
 OBJECT объект|
 CONTAINER контейнер}
FROM {имяПравообладателя[, имяПравообладателя, …]}
DROP USER пользователь[, пользователь, …] [FROM группа]
Удаление одной или нескольких групп:
DROP GROUP группа[, группа, …]
Author: BAS
Source: Взято из http://forum.sources.ru
ID: 02761
Как результат Query сделать в виде постоянной таблицы?

=== Как результат Query сделать в виде постоянной таблицы? ===
Traditionally, to write the results of a query to disk, you use a TBatchMove and a TTable in addition to your query. But you can short-circuit this process by making a couple of simple, direct calls to the BDE.
Make sure you have BDE declared in your uses section
procedure MakePermTable(Qry: TQuery; PermTableName: string);
var
 h: HDBICur;
 ph: PHDBICur;
begin
 Qry.Prepare;
 Check(dbiQExec(Qry.StmtHandle, ph));
 h := ph^;
 Check(DbiMakePermanent(h, PChar(PermTableName), True));
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02557
Как рисовать в чужом окне или по всему экрану

Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:
function GetDC(Wnd: HWnd): HDC;
где Wnd - указатель на нужное окно, или 0 для получения контекста всего экрана.
И далее, пользуясь функциями API, нарисовать все что надо.
procedure DrawOnScreen;
var
 ScreenDC: hDC;
begin
 ScreenDC := GetDC(0); { получить контекст экрана }
 Ellipse(ScreenDC, 0, 0, 200, 200); { нарисовать }
 ReleaseDC(0, ScreenDC); { освободить контекст }
end;
Не забывайте после своих манипуляций посылать пострадавшим (или всем) окнам сообщение о необходимости перерисовки, для восстановления их первоначального вида.
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03821
ID: 03822
Category:Графика
Category:Рисование
Как рисовать за пределами формы

Создайте обработчик сообщения для WM_NCPAINT. Следующий пример рисует красную рамку вокруг формы шириной в один пиксель.
type
 TForm1 = class(TForm)
 private
 { Private declarations }
 procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
 dc: hDc;
 Pen: hPen;
 OldPen: hPen;
 OldBrush: hBrush;
begin
 inherited;
 dc := GetWindowDC(Handle);
 msg.Result := 1;
 Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
 OldPen := SelectObject(dc, Pen);
 OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
 Rectangle(dc, 0,0, Form1.Width, Form1.Height);
 SelectObject(dc, OldBrush);
 SelectObject(dc, OldPen);
 DeleteObject(Pen);
 ReleaseDC(Handle, Canvas.Handle);
end;
Source: http://forum.sources.ru
ID: 03820
Category:Графика
Category:Рисование
Как рисовать картинки в пунктах меню?

=== Как рисовать картинки в пунктах меню? ===
unit DN_Win;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, Menus, StdCtrls,
type
 TDNForm = class(TForm)
 MainMenu1: TMainMenu;
 cm_MainExit: TMenuItem;
 procedure FormCreate(Sender: TObject);
 procedure cm_MainExitClick(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 BM:TBitmap;
 procedure WMDrawItem(var Msg: TWMDrawItem); message wm_DrawItem;
 procedure WMMeasureItem(var Msg: TWMMeasureItem); message wm_MeasureItem;
 end;
var
 DNForm: TDNForm;
implementation
{$R *.DFM}
var
 Comm, yMenu: word;
procedure TDNForm.FormCreate(Sender: TObject);
begin
 yMenu := GetSystemMetrics(SM_CYMENU);
 comm := cm_MainExit.Command;
 ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition or mf_OwnerDraw, comm, 'Go');
end;
procedure TDNForm.cm_MainExitClick(Sender: TObject);
begin
 DNForm.Close;
end;
procedure TDNForm.WMMeasureItem(var Msg: TWMMeasureItem);
begin
 with Msg.MeasureItemStruct^ do
 if ItemID = comm then
 begin
 ItemWidth := yMenu;
 Itemheight := yMenu;
 end;
end;
procedure TDNForm.WMDrawItem(var Msg: TWMDrawItem);
var
 MemDC: hDC;
 BM: hBitMap;
 mtd: longint;
begin
 with Msg.DrawItemStruct^ do
 begin
 if ItemID = comm then
 begin
 BM := LoadBitMap(hInstance, 'dver');
 MemDC := CreateCompatibleDC(hDC); { hDC ? TDrawItemStruct }
 SelectObject(MemDC, BM); { rcItem ? TDrawItemStruct }
 if ItemState = ods_Selected then
 mtd := NotSrcCopy
 else
 mtd := SrcCopy;
 StretchBlt(hDC, rcItem.left, rcItem.top, yMenu, yMenu, MemDC, 0, 0, 24, 23, mtd);
 DeleteDC(MemDC);
 DeleteObject(BM);
 end;
 end;
end;
end.
 Eugeny Sverchkov
 es906@kolnpp.elektra.ru
 (2:5031/12.23)
Author: StayAtHome
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01305