nyuuzyou/wikis huggingface dataset:
Как рисовать линии (или ещё что-нибудь) на экране (TDesktopCanvas)

{ Пример рисует две горизонтальные линии на экране используя TDesktopCanvas. }
program TrinitronTraining;
uses
 Messages, Windows, Graphics, Forms;
type
 TDesktopCanvas = class(TCanvas)
 private
 DC: hDC;
 function GetWidth: Integer;
 function GetHeight: Integer;
 public
 constructor Create;
 destructor Destroy; override;
 published
 property Width: Integer read GetWidth;
 property Height: Integer read GetHeight;
 end;
{ Объект TDesktopCanvas }
function TDesktopCanvas.GetWidth: Integer;
begin
 Result := GetDeviceCaps(Handle, HORZRES);
end;
function TDesktopCanvas.GetHeight: Integer;
begin
 Result := GetDeviceCaps(Handle, VERTRES);
end;
constructor TDesktopCanvas.Create;
begin
 inherited Create;
 DC := GetDC(0);
 Handle := DC;
end;
destructor TDesktopCanvas.Destroy;
begin
 Handle := 0;
 ReleaseDC(0, DC);
 inherited Destroy;
end;
const
 YCount = 2;
var
 desktop: TDesktopCanvas;
 dx, dy: Integer;
 i: Integer;
 F: Array[1..YCount] of TForm;
function CreateLine(Y: Integer): TForm;
begin
 Result := TForm.Create(Application);
 with Result do
 begin
 Left := 0;
 Top := y;
 Width := dx;
 Height := 1;
 BorderStyle := bsNone;
 FormStyle := fsStayOnTop;
 Visible := True;
 end;
end;
procedure ProcessMessage;
var
 Msg: TMsg;
begin
 if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
 if Msg.Message = WM_QUIT then
 Application.Terminate;
end;
begin
 desktop := TDesktopCanvas.Create;
 try
 dx := desktop.Width;
 dy := desktop.Height div (YCount+1);
 finally
 desktop.free;
 end;
 for i := 1 to YCount do
 F[i] := CreateLine(i * dy);
 Application.NormalizeTopMosts;
 ShowWindow(Application.Handle, SW_Hide);
 for i := 1 to YCount do
 SetWindowPos(F[i].Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_NOMOVE + SWP_NOSIZE);
{ следующие строки используются для того, чтобы не останавливаться
 repeat
 ProcessMessage;
 until false;
{}
 Sleep(15000);
 for i:=1 to YCount do F[i].Free;
end.
Source: http://forum.sources.ru
ID: 03732
Category:Графика
Category:Рисование
Как рисовать на компоненте, если свойство Canvas недоступно?

У всех компонентов, порожденных от TCustomControl, имеется свойство Canvas типа TCanvas.
Если свойство Canvas недоступно, Вы можете достучаться до него созданием потомка и переносом этого свойства в раздел Public.
{ Example. We recommend You to create this component through Component Wizard.
In Delphi 1 it can be found as 'File|New Component...', and can be found
as 'Component|New Component...' in Delphi 2 or above. }
type
 TcPanel = class(TPanel)
 public
 property Canvas;
 end;
Author: Akzhan Abdulin (2:5040/55)
----
Если у объекта нет свойства Canvas (у TDBEdit, вpоде-бы нет), по кpайней меpе в D3 можно использовать класс TControlCanvas. Пpимеpное использование:
var
 cc: TControlCanvas;
begin
 cc := TControlCanvas.Create;
 cc.Control := youControl;
end;
и далее как обычно можно использовать методы Canvas.
Author: Andrew Velikoredchanin (2:5026/29.3)
ID: 03742
Category:Графика
Category:Рисование
Как с помощью API поместить Label на Form?

=== Как с помощью API поместить Label на Form? ===
var 
 hLabel: HWND ;
begin
 hLabel := CreateWindow('STATIC', 'test', WS_CHILD or WS_VISIBLE, 0, 0, 200, 40, hWnd, NULL, hInstance, NULL);
end;
 Vit Примечание:
 Скорее всего последний параметр не "NULL", а "Nil" (NULL в паскале - варианта для обозначения пустого поля в базе данных)
Author: Baa
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02021
----
program Project1;
uses
 Windows,
 Messages;
const
 myClassName = 'myWindow';
var
 handleWnd, Label1: THandle;
 WndClass: TWndClass;
 Msg: TMsg;
function WindowProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
begin
 WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
 case AMessage of
 {WM_COMMAND: if lParam = Button1 then
 MessageBox(0, 'Вы нажали кнопку!', 'Информация', MB_OK or MB_ICONINFORMATION); }
 WM_DESTROY: Halt;
 end;
end;
begin
 with WndClass do
 begin
 hInstance := hInstance;
 lpszClassName := myClassName;
 style := cs_hRedraw or cs_vRedraw;
 hbrBackground := color_btnface + 1;
 lpfnWndProc := @WindowProc;
 hCursor := LoadCursor(0, idc_Arrow);
 hIcon := LoadIcon(0, IDI_EXCLAMATION);
 lpszMenuName := NIL;
 cbWndExtra := 0;
 cbClsExtra := 0;
 end;
 RegisterClass(WndClass);
 handleWnd := CreateWindow(myClassName, 'Hажми кнопку', ws_OverlappedWindow,
 400, 300, 200, 100, 0, 0, hInstance , NIL);
 if handleWnd = 0 then
 begin
 MessageBox(0, 'Error', NIL, MB_OK);
 Exit;
 end;
 Label1 := CreateWindow('Label', 'Text', WS_VISIBLE or WS_CHILD or WM_SETTEXT,
 20, 10, 60, 23, handleWnd, 0, hInstance, nil);
 ShowWindow(handleWnd, SW_SHOW);
 UpdateWindow(handleWnd);
 while GetMessage(Msg, handleWnd, 0, 0) do
 begin
 TranslateMessage(Msg);
 DispatchMessage(Msg);
 end;
end.
Author: alex-co 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02022
Category:WinAPI
Как сворачивать все приложение при сворачивании неглавного окна?

=== Как сворачивать все приложение при сворачивании неглавного окна? ===
 procedure WMActivateApp(var Msg: TWMActivateApp); message WM_ACTIVATEAPP;
 procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
procedure Form2.WMActivateApp(var Msg: TWMActivateApp);
begin
 if IsIconic(Application.Handle) then begin
 ShowWindow(Application.Handle, SW_RESTORE);
 SetActiveWindow(Handle);
 end;
 inherited;
end;
procedure Form2.WMSysCommand(var Msg: TWMSysCommand);
begin
 if (Msg.CmdType = SC_Minimize) then
 ShowWindow(Application.Handle, SW_MINIMIZE)
 else
 inherited;
end;
Теперь при сворачивании формы сворачивается все приложение. 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00412
Как связать TreeView и PageControl?

=== Как связать TreeView и PageControl? ===
На форме стоит TreeView, PageControl и кнопка.
При смене страницы - меняется текущий узел, а при смене узла меняется страница. 
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ComCtrls;
type
 TForm1 = class(TForm)
 TreeView1: TTreeView;
 Button1: TButton;
 PageControl1: TPageControl;
 procedure Button1Click(Sender: TObject);
 procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
 procedure PageControl1Change(Sender: TObject);
 private
 procedure AddItem(s: String);
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AddItem(s: String);
var
 TabSheet: TTabSheet;
 Node: TTreeNode;
begin
 TabSheet := TTabSheet.Create(Self);
 TabSheet.PageControl := PageControl1;
 TabSheet.Caption := s;
 Node := TreeView1.Items.Add(nil, s);
 Node.data := TabSheet; // ассоциируем узел с страницей
 TabSheet.Tag := Integer(Node); // ассоциируем страницу с узлом
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 TreeView1.HideSelection := False;
 AddItem('Item1');
 AddItem('Item2');
 AddItem('Item3');
 AddItem('Item4');
end;
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
 // Доступ к ассоциированной странице через узел
 PageControl1.ActivePage := TTabSheet(Node.Data);
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
 // Доступ к ассоциированному узлу через страницу
 TreeView1.Selected:=TTreeNode(Pointer(PageControl1.ActivePage.Tag));
end;
end.
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00622
Как связать определённое расширение файлов с моим приложением?

=== Как связать определённое расширение файлов с моим приложением? ===
В Win32 необходимо создать новую запись в реестре в корневом ключе HKEY_CLASSES_ROOT, которая будет указывать на расширение файла, командную строку и иконку, которая будет отображаться для этого расширения. В Win16, просто включить расширение файла и командную строку в секцию [Extensions] в Win.ini.
Пример:
uses 
 Registry, { For Win32 } 
 IniFiles; { For Win16 } 
{ Для Win32 } 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 reg: TRegistry; 
begin 
 reg := TRegistry.Create; 
 reg.RootKey := HKEY_CLASSES_ROOT; 
 reg.LazyWrite := false; 
 { Add Program Support } 
 reg.OpenKey('.bor\shell\open\command', true); 
 { Имя файла будет передавать в приложение как первый параметр }
 reg.WriteString(, 'C:\Program Files\Borland\Delphi 3\Project1.exe %1'); 
 { Добавляем отображаемую иконку }
 reg.CloseKey; 
 reg.OpenKey('.bor\DefaultIcon', true); 
 { Для отображения используем первую иконку в нашем приложении }
 reg.WriteString(, 'C:\Program Files\Borland\Delphi 3\Project1.exe,0');
 reg.CloseKey; 
 reg.Free; 
end; 
{ Для Win16 } 
procedure TForm1.Button2Click(Sender: TObject); 
var 
 WinIni: TIniFile; 
 WinIniFileName: array[0..MAX_PATH] of char; 
 s: array[0..64] of char; 
begin 
 GetWindowsDirectory(WinIniFileName, SizeOf(WinIniFileName)); 
 StrCat(WinIniFileName, '\win.ini'); 
 WinIni := TIniFile.Create(WinIniFileName); 
 WinIni.WriteString('Extensions', 
 'bor', 
 'C:\PROGRA~1\BORLAND\DELPHI~1\PROJECT1.EXE ^.bor'); 
 WinIni.Free; 
 StrCopy(S, 'Extensions'); 
 SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); 
end;
Source: Взято из http://forum.sources.ru
ID: 01739
Как сгенерировать свою ошибку?

=== Как сгенерировать свою ошибку? ===
raise Exception.Create('Это моя ошибка! Сам что хочу то и пишу здесь!')
Примечание: в отличие от других объектов, объекты типа Exception или других классов, унаследованных от Exception не требуют вызова деструкторов или любых других действий по освобождению памяти после их создания.
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: http://forum.vingrad.ru
ID: 00026
Как сделать, чтобы в DBGrid вместо цифр были соответствующие константы

=== Как сделать, чтобы в DBGrid вместо цифр были соответствующие константы ===
procedure TForm1.Grid1DrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
 // ВАЖНО: имя поля большими буквами!
 if Column.Field.FieldName = 'PLATEZH' then
 begin
 Grid1.Canvas.FillRect(Rect);
 if Column.Field.AsInteger = 0 then
 Grid1.Canvas.TextOut(Rect.Left + 1, Rect.Top + 2, 'наличными')
 else
 Grid1.Canvas.TextOut(Rect.Left + 1, Rect.Top + 2, 'безнал');
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03045
Category:Базы данных
Category:DBGrid
Как сделать, чтобы запускалась только одна копия приложения?

=== Как сделать, чтобы запускалась только одна копия приложения? ===
var AtomText: array[0..31] of Char; 
procedure LookForPreviousInstance; 
var 
 PreviousInstanceWindow: hWnd; 
 AppName: array[0..30] of char; 
 FoundAtom: TAtom; 
begin 
 // помещаем имя приложения в AtomText 
 StrFmt(AtomText, 'OnlyOne%s', [Copy(Application.Title, 1, 20)]); 
 // Проверяем, не создано ли уже атома с таким именем приложения
 FoundAtom := GlobalFindAtom(AtomText); 
 if FoundAtom <> 0 then // эта копия приложения уже запущена
 begin 
 StrFmt(AppName,'%s', [Application.Title]); 
 // изменяем текущий заголовок, чтобы FindWindow не видела его
 Application.ShowMainForm := false; 
 Application.Title := 'destroy me'; 
 // ищем предыдущую копию приложения
 PreviousInstanceWindow := FindWindow(nil, AppName); 
 // Передаём фокус на предыдущую копию приложения
 // завершаем текущую копию
 Application.Terminate; 
 if PreviousInstanceWindow <> 0 then 
 if IsIconic(PreviousInstanceWindow) then 
 ShowWindow(PreviousInstanceWindow, SW_RESTORE) 
 else SetForegroundWindow(PreviousInstanceWindow); 
 end; 
 // создаём глобальный атом, чтобы предотвратить запуск другой копии приложения
 FoundAtom := GlobalAddAtom(AtomText); 
end; 
constructor TForm.Create(AOwner: TComponent); 
begin 
 inherited; 
 LookForPreviousInstance; 
 // ... 
end; 
destructor TForm.Destroy; 
var 
 FoundAtom: TAtom; 
 ValueReturned: word; 
begin 
 // не забудьте удалить глобальный атом
 FoundAtom := GlobalFindAtom(AtomText); 
 if FoundAtom <> 0 then
 ValueReturned := GlobalDeleteAtom(FoundAtom); 
 inherited Destroy; 
end;
Примечание от serbod: Правильнее использовать не атомы, а мьютексы (Mutex), потому что они автоматически удаляются из системы при некорректном завершении программы.
Source: Взято из http://forum.sources.ru
ID: 02067
----
В блоке begin..end модуля .dpr:
begin
 if HPrevInst <> 0 then
 begin
 ActivatePreviousInstance;
 Halt;
 end;
end;
Реализация:
unit PrevInst;
interface
uses
 WinProcs,
 WinTypes,
 SysUtils;
type
 PHWnd = ^HWnd;
function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;
procedure ActivatePreviousInstance;
implementation
function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;
var
 ClassName: array[0..30] of char;
begin
 Result := true;
 if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then
 begin
 GetClassName(Wnd, ClassName, 30);
 if STRIComp(ClassName, 'TApplication') = 0 then
 begin
 TargetWindow^ := Wnd;
 Result := false;
 end;
 end;
end;
procedure ActivatePreviousInstance;
var
 PrevInstWnd: HWnd;
begin
 PrevInstWnd := 0;
 EnumWindows(@EnumApps, LongInt(@PrevInstWnd));
 if PrevInstWnd <> 0 then
 if IsIconic(PrevInstWnd) then
 ShowWindow(PrevInstWnd, SW_Restore)
 else
 BringWindowToTop(PrevInstWnd);
end;
end.
Сборник Kuliba
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02068
Как сделать, чтобы компоненты отбрасывали тень?

=== Как сделать, чтобы компоненты отбрасывали тень? ===
procedure ShadeIt(f: TForm; c: TControl; Width: Integer; Color: TColor); 
var 
 rect: TRect; 
 old: TColor; 
begin 
 if (c.Visible) then 
 begin 
 rect := c.BoundsRect; 
 rect.Left := rect.Left + Width; 
 rect.Top := rect.Top + Width; 
 rect.Right := rect.Right + Width; 
 rect.Bottom := rect.Bottom + Width; 
 old := f.Canvas.Brush.Color; 
 f.Canvas.Brush.Color := Color; 
 f.Canvas.fillrect(rect); 
 f.Canvas.Brush.Color := old; 
 end; 
end; 
procedure TForm1.FormPaint(Sender: TObject); 
var 
 i: Integer; 
begin 
 for i := 0 to Self.ControlCount - 1 do 
 ShadeIt(Self, Self.Controls[i], 3, clBlack); 
end; 
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00341
Как сделать, чтобы неглавная форма минимизировалась не на TaskBar, а выше него

=== Как сделать, чтобы неглавная форма минимизировалась не на TaskBar, а выше него ===
 TForm1 = class(TForm)
 protected
 procedure CreateParams(var Params: TCreateParams); override;
 end;
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 inherited;
 Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
 Params.WndParent := GetDesktopWindow();
end;
Source: http://delphiworld.narod.ru/
ID: 01789
Как сделать, чтобы необходимая ячейка DBGrid получила фокус ввода

=== Как сделать, чтобы необходимая ячейка DBGrid получила фокус ввода ===
Для установки в ПОЛЕ, связанное с гридом, используется метод TField.FocusControl
Source: Взято с http://delphiworld.narod.ru
ID: 03048
Category:Базы данных
Category:DBGrid
Как сделать, чтобы форма закрывалась при нажатии Esc?

=== Как сделать, чтобы форма закрывалась при нажатии Esc? ===
Для начала необходимо установить свойство формы KeyPreview в True. А потом уже можно отлавливать "Esc":
procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.KeyPreview := True;
end;
procedure TForm1.FormKeyPress
 (Sender: TObject; var Key: Char);
begin
 if key = #27 then Close;
end;
Source: Взято из http://forum.sources.ru
ID: 00433
Как сделать 24bit dithering?

{ ... }
type
 PIntegerArray = ^TIntegerArray;
 TIntegerArray = array[0..maxInt div SizeOf(Integer) - 2] of Integer;
 TColor3 = packed record
 b, g, r: Byte;
 end;
 TColor3Array = array[0..maxInt div SizeOf(TColor3) - 2] of TColor3;
 PColor3Array = ^TColor3Array;
procedure Swap(var p1, p2: PIntegerArray);
var
 t: PIntegerArray;
begin
 t := p1;
 p1 := p2;
 p2 := t;
end;
function clamp(x, min, max: Integer): Integer;
begin
 Result := x;
 if Result < min then
 Result := min;
 else
 if Result > max then
 Result := max;
end;
procedure Dither(bmpS, bmpD: TBitmap);
var
 bmpS, bmpD: TBitmap;
 scanlS, scanlD: PColor3Array;
 error1R, error1G, error1B,
 error2R, error2G, error2B: PIntegerArray;
 x, y: Integer;
 dx: Integer;
 c, cD: TColor3;
 sR, sG, sB: Integer;
 dR, dG, dB: Integer;
 eR, eG, eB: Integer;
begin
 bmpD.Width := bmpS.Width;
 bmpD.Height := bmpS.Height;
 bmpS.PixelFormat := pf24bit;
 bmpD.PixelFormat := pf24bit;
 error1R := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 error1G := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 error1B := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 error2R := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 error2G := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 error2B := AllocMem((bmpS.Width + 2) * SizeOf(Integer));
 { dx holds the delta for each iteration as we zigzag, it'll change between 1 and -1 }
 dx := 1;
 for y := 0 to bmpS.Height - 1 do
 begin
 scanlS := bmpS.ScanLine[y];
 scanlD := bmpD.ScanLine[y];
 if dx > 0 then
 x := 0
 else
 x := bmpS.Width - 1;
 while (x >= 0) and (x < bmpS.Width) do
 begin
 c := scanlS[x];
 sR := c.r;
 sG := c.g;
 sB := c.b;
 eR := error1R[x + 1];
 eG := error1G[x + 1];
 eB := error1B[x + 1];
 dR := (sR * 16 + eR) div 16;
 dG := (sR * 16 + eR) div 16;
 dB := (sR * 16 + eR) div 16;
 { actual downsampling }
 dR := clamp(dR, 0, 255) and (255 shl 4);
 dG := clamp(dR, 0, 255) and (255 shl 4);
 dB := clamp(dR, 0, 255) and (255 shl 4);
 cD.r := dR;
 cD.g := dG;
 cD.b := dB;
 scanlD[x] := cD;
 eR := sR - dR;
 eG := sG - dG;
 eB := sB - dB;
 Inc(error1R[x + 1 + dx], (eR * 7)); { next }
 Inc(error1G[x + 1 + dx], (eG * 7));
 Inc(error1B[x + 1 + dx], (eB * 7));
 Inc(error2R[x + 1], (eR * 5)); { top }
 Inc(error2G[x + 1], (eG * 5));
 Inc(error2B[x + 1], (eB * 5));
 Inc(error2R[x + 1 + dx], (eR * 1)); { diag forward }
 Inc(error2G[x + 1 + dx], (eG * 1));
 Inc(error2B[x + 1 + dx], (eB * 1));
 Inc(error2R[x + 1 - dx], (eR * 3)); { diag backward }
 Inc(error2G[x + 1 - dx], (eG * 3));
 Inc(error2B[x + 1 - dx], (eB * 3));
 Inc(x, dx);
 end;
 dx := dx * -1;
 Swap(error1R, error2R);
 Swap(error1G, error2G);
 Swap(error1B, error2B);
 FillChar(error2R^, SizeOf(Integer) * (bmpS.Width + 2), 0);
 FillChar(error2G^, SizeOf(Integer) * (bmpS.Width + 2), 0);
 FillChar(error2B^, SizeOf(Integer) * (bmpS.Width + 2), 0);
 end;
 FreeMem(error1R);
 FreeMem(error1G);
 FreeMem(error1B);
 FreeMem(error2R);
 FreeMem(error2G);
 FreeMem(error2B);
end;
Source: http://www.baltsoft.com/
ID: 03873
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Как сделать ADO-connection?

=== Как сделать ADO-connection? ===
uses
 ComObj;
function OpenConnection(ConnectionString: AnsiString): Integer;
var
 ADODBConnection: OleVariant;
begin
 ADODBConnection := CreateOleObject('ADODB.Connection');
 ADODBConnection.CursorLocation := 3; // User client
 ADODBConnection.ConnectionString := ConnectionString;
 Result := 0;
 try
 ADODBConnection.Open;
 except
 Result := -1;
 end;
end;
function DataBaseConnection_Test(bMessage: Boolean): AnsiString;
var
 asTimeout, asUserName, asPassword, asDataSource, ConnectionString: AnsiString;
 iReturn: Integer;
 OldCursor: TCursor;
begin
 OldCursor := Screen.Cursor;
 Screen.Cursor := crHourGlass;
 asTimeout := '150';
 asUserName := 'NT_Server';
 asPassword := 'SA';
 asDataSource := 'SQL Server - My DataBase';
 ConnectionString := 'Data Source = ' + asDataSource +
 'User ID = ' + asUserName +
 'Password = ' + asPassword +
 'Mode = Read|Write;Connect Timeout = ' + asTimeout;
 try
 iReturn := OpenConnection(ConnectionString);
 if (bMessage) then
 begin
 if (iReturn = 0) then
 Application.MessageBox('Connection OK!', 'Information', MB_OK)
 else if (iReturn = -1) then
 Application.MessageBox('Connection Error!', 'Error', MB_ICONERROR + MB_OK);
 end;
 if (iReturn = 0) then
 Result := ConnectionString
 else if (iReturn = -1) then
 Result := ;
 finally
 Screen.Cursor := OldCursor;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 DataBaseConnection_Test(True);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02658
Как сделать MDI-приложение, где сливаются меню дочернего и главного окна, и полосы инструментов?

=== Как сделать MDI-приложение, где сливаются меню дочернего и главного окна, и полосы инструментов? ===
Ваpиант 1. CoolBar. 
procedure TMainForm.SetBands(AControls: array of TWinControl;
 ABreaks: array of boolean);
var
 i: integer;
begin
 with CoolBar do
 begin
 for i := 0 to High(AControls) do
 begin
 if Bands.Count = succ(i) then
 TCoolBand.Create(Bands);
 with Bands[succ(i)] do
 begin
 if Assigned(Control) then
 Control.Hide;
 MinHeight := AControls[i].Height;
 Break := ABreaks[i];
 Control := AControls[i];
 Control.Show;
 Visible := true;
 end
 end;
 for i := High(AControls)+2 to pred(Bands.Count) do
 Bands[i].Free
 end
end;
и 
procedure TMsgForm.FormActivate(Sender: TObject);
begin
 MainForm.SetBands([ToolBar], [false])
end;
Примечание:
Оба массива равны по длине. CoolBar.Bands[0] должен существовать всегда,.. на нём я размешаю "глобальные" кнопки. СoolBar[1] тоже можно сделать в DesignTime с Break:=false и придвинуть поближе с началу. 
При CoolBar.AutoSize := true возможно "мигание" (при добавлении на новую стpоку) так что можно добавить:
AutoSize := false;
try
 ...
finally
 AutoSize := true;
----
TMainForm
 ...
 object SpeedBar: TPanel
 ...
 Align = alTop
 BevelOuter = bvNone
 object ToolBar: TPanel
 ...
 Align = alLeft
 BevelOuter = bvNone
 end
 object RxSplitter1: TRxSplitter
 ...
 ControlFirst = ToolBar
 ControlSecond = ChildBar
 Align = alLeft
 BevelOuter = bvLowered
 end
 object ChildBar: TPanel
 ...
 Align = alClient
 BevelOuter = bvNone
 end
end
TMdiChild { прародитель всех остальных }
 ...
 object pnToolBar: TPanel
 ...
 Align = alTop
 BevelOuter = bvNone
 Visible = False
end
procedure TMDIForm.FormActivate(Sender: TObject);
begin
 pnToolBar.Parent := MainForm.ChildBar;
 pnToolBar.Visible := True;
end;
procedure TMDIForm.FormDeactivate(Sender: TObject);
begin
 pnToolBar.Visible := false;
 pnToolBar.Parent := self
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00497
Как сделать Memo с закруглёнными краями?

=== Как сделать Memo с закруглёнными краями? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 rgn: HRGN;
 r: TRect;
begin
 r := memo1.ClientRect;
 rgn := CreateRoundRectRgn(r.Left, r.top, r.right, r.bottom, 20, 20);
 memo1.BorderStyle := bsNone;
 memo1.Perform(EM_GETRECT, 0, lparam(@r));
 InflateRect(r, -5, -5);
 memo1.Perform(EM_SETRECTNP, 0, lparam(@r));
 SetWindowRgn(memo1.Handle, rgn, true);
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00544
Как сделать Ping?

В коде используется функция ExecCmdine из статьи: Как запустить консольное приложение и перехватить вывод?
function Ping(host: string): Boolean;
var
 params, CommandLine: string;
 t: TStringList;
 i: Integer;
begin
 Params := Format('-s%d ', [32]);
 Params := Params + Format('-c%d ', [1]);
 CommandLine := Format('ping %s%s', [Params, host]);
 t := TStringList.Create;
 try
 ExecCmdine(CommandLine, t);
 Result := Pos('1 received, 0% packet loss', t.text) > 0;
 finally
 t.Free;
 end;
end;
Примечание - под отладчиком Kylix код может не работать. Надо запускать приложение не под Kylix для того чтобы удостовериться что код работает.
Более подробную информацию можно получить запустив в консоли:
 man ping
Author: Vit
ID: 04630
Category:Kylix
Category:Linux
Как сделать Pop-Up меню при щелчке иконке в Sys tray?

=== Как сделать Pop-Up меню при щелчке иконке в Sys tray? ===
Многие программы показывают Pop-Up меню при щелчке на их иконке, помещенной на Tray, как этого добиться?
Вы должны обрабатывать сообщение, указанное вами при добавлении иконки на Tray. При значении (UINT)lParam, равном WM_RBUTTONDOWN (это обычно для Pop-Up меню по правой кнопке), или любому другому необходимому вам, вы должны вызовом функции GetCursorPos() получить позицию курсора в момент события (вряд ли пользователь успеет убрать мышь за время обработки сообщения, особенно если он ожидает меню), получить дескриптор Pop-Up меню одним из многих способов (LoadMenu(), GetSubMenu(), CreateMenu(), и т.д.) и выполнить следующий код: 
 SetForegroundWindow(hWnd);
 TrackPopupMenuEx(hMenu, TPM_HORIZONTAL|TPM_LEFTALIGN, x, y, hWnd, NULL);
 DestroyMenu(hMenu);
 PostMessage(hWnd, WM_USER, 0, 0); 
где
* hWnd - дескриптор окна, которое будет обрабатывать команду меню,
* hMenu - дескриптор меню,
* x и y - позиция курсора. 
Для подробностей смотрите Win32 SDK Help по функции TrackPopupMenuEx.
Source: Взято из FAQ: http://blackman.km.ru/myfaq/cont4.phtml]http://blackman.km.ru/myfaq/cont4.phtml
ID: 01760