nyuuzyou/wikis huggingface dataset:
Как найти пароль к базе данных?

=== Как найти пароль к базе данных? ===
I know there that there are many utilities out there costing $$ for removing the password of an access database. Here's how to implement it in Delphi.Please note that this method is not meant for a database with user-level security and work group information file. The idea is based on the file format of an access db.
The password is stored from location $42 and encrypted using simple xoring. The following function does decryption.
function GetPassword(filename: string): string;
var
 Stream: TFilestream;
 buffer: array[0..12] of char;
 str: string;
begin
 try
 stream := TFileStream.Create(filename, fmOpenRead);
 except
 ShowMessage('Could not open the file.Make sure that the file is not in use.');
 exit;
 end;
 stream.Seek($42, soFromBeginning);
 stream.Read(buffer, 13);
 stream.Destroy;
 str := chr(Ord(buffer[0]) xor $86);
 str := str + chr(Ord(buffer[1]) xor $FB);
 str := str + chr(Ord(buffer[2]) xor $EC);
 str := str + chr(Ord(buffer[3]) xor $37);
 str := str + chr(Ord(buffer[4]) xor $5D);
 str := str + chr(Ord(buffer[5]) xor $44);
 str := str + chr(Ord(buffer[6]) xor $9C);
 str := str + chr(Ord(buffer[7]) xor $FA);
 str := str + chr(Ord(buffer[8]) xor $C6);
 str := str + chr(Ord(buffer[9]) xor $5E);
 str := str + chr(Ord(buffer[10]) xor $28);
 str := str + chr(Ord(buffer[11]) xor $E6);
 str := str + chr(Ord(buffer[12]) xor $13);
 Result := str;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02755
Как найти позицию текстового курсора в пикселях?

=== Как найти позицию текстового курсора в пикселях? ===
var
 pt: TPoint;
begin
 with RichEdit1 do
 begin
 Perform(messages.EM_POSFROMCHAR, WPARAM(@pt), SelStart);
 Label1.caption := Format('(%d,%d)', [pt.x, pt.y]);
 end;
end;
var
 r: LongInt;
begin
 with memo1 do
 begin
 r := Perform(messages.EM_POSFROMCHAR, SelStart, 0);
 if r >= 0 then
 begin
 Label1.Caption := IntToStr(HiWord(r));
 Label2.Caption := IntToStr(LoWord(r));
 end;
 end;
end;
ID: 00581
Как найти полный путь и имя файла запущенной DLL из самой DLL

=== Как найти полный путь и имя файла запущенной DLL из самой DLL ===
uses Windows; 
procedure ShowDllPath stdcall;
var
 TheFileName: array[0..MAX_PATH] of Char;
begin
 FillChar(TheFileName, sizeof(TheFileName), #0);
 GetModuleFileName(hInstance, TheFileName, SizeOf(TheFileName));
 MessageBox(0, TheFileName, 'The DLL file name is:', mb_ok);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01999
----
function GetModuleFileNameStr(Instance: THandle): string;
var
 buffer: array [0..MAX_PATH] of Char;
begin
 GetModuleFileName(Instance, buffer, MAX_PATH);
 Result := buffer;
end;
GetModuleFileNameStr(Hinstance); // dll name
GetModuleFileNameStr(0); // exe name
Source: Взято с http://delphiworld.narod.ru
ID: 02000
Как найти путь к моей программе?

=== Как найти путь к моей программе? ===
Application.ExeName
Author: Baa
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03157
----
Или еще лучше Paramstr(0) - лучше потому что работает и без объекта Application и в DLL
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03158
Category:Файловая система
Как найти размер записи?

=== Как найти размер записи? ===
procedure TMainFrm.CalculateRecordSizeClick(Sender: TObject);
var
 MaxRecs, RecSize, RecsPerBlock, FreeSpace: Longint;
 i: Integer;
begin
 RecSize := 0;
 with StrucGrid do
 begin
 for i := 0 to pred(RowCount) do
 begin
 case Cells[1, i][1] of
 'A': RecSize := RecSize + StrToInt(Cells[2, i]);
 'D', 'T', 'I', '+': RecSize := RecSize + 4;
 'N', '$', 'Y', '@': RecSize := RecSize + 8;
 'M', 'B', 'F', 'O', 'G': RecSize := RecSize + 10 + StrToInt(Cells[2, i]);
 'S': RecSize := RecSize + 2;
 'L': RecSize := RecSize + 1;
 end;
 end;
 end;
 RecsPerBlock := (SpinEdit2.Value - 6) div RecSize;
 FreeSpace := (SpinEdit2.Value - 6) - (RecSize * RecsPerBlock);
 MaxRecs := 65536 * RecsPerBlock;
 ShowMessage('Record Size is: ' + IntToStr(RecSize) + ' bytes' + #13#10
 + 'Records per Block: ' + IntToStr(RecsPerBlock) + #13#10
 + 'Unused Space per Block: ' + IntToStr(FreeSpace) + ' bytes' + #13#10
 + 'Max No of Records in Table: ' + FormatFloat('###############,', MaxRecs));
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02405
Как найти системные папки Windows?

=== Как найти системные папки Windows? ===
type
 TSystemPath = (Desktop, StartMenu, Programs, Startup, Personal, Winroot, WinSys);
implementation
function GetSystemPath(SystemPath: TSystemPath): string;
var
 p: PChar;
begin
 with TRegistry.Create do
 begin
 try
 RootKey := HKEY_CURRENT_USER;
 OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', True);
 case SystemPath of
 Desktop: Result := ReadString('Desktop');
 StartMenu: Result := ReadString('Start Menu');
 Programs: Result := ReadString('Programs');
 Startup: Result := ReadString('Startup');
 Personal: Result := ReadString('Personal');
 Winroot:
 begin
 GetMem(p, 255);
 GetWindowsDirectory(p, 254);
 Result := StrPas(p);
 Freemem(p);
 end;
 WinSys:
 begin
 GetMem(p, 255);
 GetSystemDirectory(p, 254);
 Result := StrPas(p);
 Freemem(p);
 end;
 end;
 finally
 CloseKey();
 Free();
 end;
 end;
 if (Result <> ) and (Result[Length(Result)] <> '\') then
 Result := Result + '\';
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01658
----
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 reg: TRegistry;
 ts: TStrings;
 i: Integer;
begin
 reg := TRegistry.Create;
 reg.RootKey := HKEY_CURRENT_USER;
 reg.LazyWrite := False;
 reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\ShellFolders', False);
 ts := TStringList.Create;
 reg.GetValueNames(ts);
 for i := 0 to ts.Count -1 do
 Memo1.Lines.Add(ts.Strings[i] + ' = ' + reg.ReadString(ts.Strings[i]));
 ts.Free;
 reg.CloseKey;
 reg.Free;
end;
Source: Взято с http://delphiworld.narod.ru
Как найти список параллельных портов?

=== Как найти список параллельных портов? ===
function PortExists(const PortName: string): Boolean;
var
 hPort: HWND;
begin
 Result := False;
 hPort := CreateFile(PChar(PortName), { name }
 GENERIC_READ or GENERIC_WRITE, { access attributes }
 0, { no sharing }
 nil, { no security }
 OPEN_EXISTING, { creation action }
 FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, { attributes }
 0); { no template }
 if hPort <> INVALID_HANDLE_VALUE then
 begin
 CloseHandle(hPort);
 Result := True;
 end;
end;
{ Parallel Ports }
for i := 1 to 9 do
begin
 if PortExists('LPT' + IntToStr(i)) then
 List.Append('Ports: Printer Port (LPT' + IntTostr(i) + ')');
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 01348
Как написать DLL, которую можно было-бы выполнить с помощью RunDll, RunDll32?

=== Как написать DLL, которую можно было-бы выполнить с помощью RunDll, RunDll32? ===
Вы должны определить в программе вызываемую снаружи функцию. 
Функция должна быть __stdcall (или WINAPI, что то же самое ;)) и иметь четыре аргумента. Первый - HWND окна, порождаемого rundll32 (можно использовать в качестве owner'а своих dialog box'ов), второй - HINSTANCE задачи, третий - остаток командной строки (LPCSTR, даже под NT), четвертый - не знаю ;). Hапример, 
int __stdcall __declspec(dllexport) Test 
( 
 HWND hWnd, 
 HINSTANCE hInstance, 
 LPCSTR lpCmdLine, 
 DWORD dummy 
 ) 
{ 
MessageBox(hWnd, lpCmdLine, "Command Line", MB_OK); 
return 0; 
} 
 rundll32 test.dll,_Test@16 this is a command line 
выдаст message box со строкой "this is a command line". 
 Oleg Moroz 
 (2:5020/701.22) 
function Test(
 hWnd: Integer;
 hInstance: Integer;
 lpCmdLine: PChar;
 dummy: Longint
 ): Integer; stdcall; export;
begin
 Windows.MessageBox(hWnd, lpCmdLine, 'Command Line', MB_OK);
 Result := 0;
end;
 Akzhan Abdulin 
 (2:5040/55) 
Давненько я ждал эту информацию! Сел проверять и наткнулся на очень забавную вещь. А именно -- пусть у нас есть исходник на Си примерно такого вида: 
 int WINAPI RunDll( HWND hWnd, HINSTANCE hInstance, LPCSTR lpszCmdLine, DWORD dummy ) 
 int WINAPI RunDllW( HWND hWnd, HINSTANCE hInstance, LPCWSTR lpszCmdLine, DWORD dummy ) 
и .def-файл примерно такого вида: 
 EXPORTS 
 RunDll 
 RunDllA=RunDll 
 RunDllW 
то rundll32 становится разборчивой -- под НТ вызывает UNICODE-версию. Под 95, разумеется, ANSI. Rulez. 
 Alexey A Popoff 
 pvax@glas.apc.org, posp@ccas.ru 
 http://www.ccas.ru/~posp/popov/pvax.html 
 (2:5020/487.26)Администрирование 
ID: 01992
Как написать Outlook AddIn?

=== OLAddIn.dpr ===
{
 1. Create an ActiveX-Library
 Save the project as e.g. "OLAddIn.dpr"
 2.Create an automation object
 Call the CoClass e.g. "AddIn"
 Save the Unit as "AddIn.pas"
 3. Add to the uses clause
 - AddInDesignerObjects_TLB
 - Outlook_TLB
}
- procedure OnConnection(const Application: IDispatch; ConnectMode: ext_ConnectMode;
 const AddInInst: IDispatch; var custom: PSafeArray); safecall;
- procedure OnDisconnection(RemoveMode: ext_DisconnectMode; var custom: PSafeArray); safecall;
- procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
- procedure OnStartupComplete(var custom: PSafeArray); safecall;
- procedure OnBeginShutdown(var custom: PSafeArray); safecall;
{
 and complete the class by pressing Ctrl-Shft-C
 4. Step
 Register the COM-object with "run / register ActiveX Server"
 Register the AddIn, so that the Addin will be recognized by Outlook
 - Create a new key: HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\Addins\OLAddIn.AddIn
 - create a DWOrd "LoadBehavior" with the value 3
 5.
 Compile the AddIn
 Start Outllok
 Sourcecode
 *********************************************************************************
}
library OLAddIn;
uses
 ComServ,
 OLAddIn_TLB in 'OLAddIn_TLB.pas',
 AddIn in 'AddIn.pas' {AddIn: CoClass};
exports
 DllGetClassObject,
 DllCanUnloadNow,
 DllRegisterServer,
 DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.
=== AddIn.pas ===
unit AddIn;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
 ComObj, ActiveX, OLAddIn_TLB, StdVcl, AddinDesignerObjects_TLB, Outlook_TLB;
type
 TAddIn = class(TAutoObject, IAddIn, IDTExtensibility2)
 protected
 { Protected declarations }
 procedure OnConnection(const Application: IDispatch; ConnectMode: ext_ConnectMode;
 const AddInInst: IDispatch; var custom: PSafeArray); safecall;
 procedure OnDisconnection(RemoveMode: ext_DisconnectMode; var custom: PSafeArray); safecall;
 procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
 procedure OnStartupComplete(var custom: PSafeArray); safecall;
 procedure OnBeginShutdown(var custom: PSafeArray); safecall;
 end;
implementation
uses ComServ, Dialogs;
{ TAddIn }
procedure TAddIn.OnAddInsUpdate(var custom: PSafeArray);
begin
end;
procedure TAddIn.OnBeginShutdown(var custom: PSafeArray);
begin
end;
procedure TAddIn.OnConnection(const Application: IDispatch;
 ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
 var custom: PSafeArray);
begin
 // To show, that the AddIn has started just say anything
 ShowMessage('Das AddIn wurde gestartet');
end;
procedure TAddIn.OnDisconnection(RemoveMode: ext_DisconnectMode;
 var custom: PSafeArray);
begin
end;
procedure TAddIn.OnStartupComplete(var custom: PSafeArray);
begin
end;
initialization
 TAutoObjectFactory.Create(ComServer, TAddIn, Class_AddIn,
 ciMultiInstance, tmApartment);
end.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04440
Category:COM
Category:MS Office
Как напрямую добраться до Oracle?

=== Как напрямую добраться до Oracle? ===
Для этого можно воспользоваться компонентами от AllRoundAutomations Direct Oracle Access. Если кому надо могу поделиться. При помощи этих компонент можно не только производить простые запросы/вставки, но и выполнять DDL-скрипты, и иметь доступ к объектам Oracle 8, примет смотри ниже...
var
 Address: TOracleObject;
begin
 Query.SQL.Text := 'SELECT Name, Address FROM Persons';
 Query.Execute;
 while not Query.Eof do
 begin
 Address := Query.ObjField('Address');
 if not Address.IsNull then
 ShowMessage(Query.Field('Name') + ' lives in ' + Address.GetAttr('City'));
 Query.Next;
 end;
end;
Author: Philip A. Milovanov ( http://korys.chat.ru )
Source: Взято из http://forum.sources.ru
ID: 02727
Как нарисовать disable текст

{ Draw Disabled Text **************
 ***** This function draws text in "disabled" style. *****
 ***** i.e. the text is grayed . *****
 **********************************************************}
function DrawDisabledText(Canvas: TCanvas; Str: PChar; Count: Integer;
 var Rect: TRect; Format: Word): Integer;
begin
 SetBkMode(Canvas.Handle, TRANSPARENT);
 OffsetRect(Rect, 1, 1);
 Canvas.Font.Color := ClbtnHighlight;
 DrawText(Canvas.Handle, Str, Count, Rect, Format);
 Canvas.Font.Color := ClbtnShadow;
 OffsetRect(Rect, -1, -1);
 DrawText(Canvas.Handle, Str, Count, Rect, Format);
end;
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03646
Category:Графика
Category:Работа с текстом
Как нарисовать график функции?

procedure TForm1.Button3Click(Sender: TObject);
var
 x, y: array[1..50] of Double;
 i: Integer;
 scalex, scaley, ymin, ymax, xmin, xmax: Double;
begin
 for i := 1 to 50 do
 begin
 y[i] := sin(i * 0.5);
 x[i] := i;
 end;
 xmin := x[1];
 xmax := x[1];
 ymin := y[1];
 ymax := y[1];
 for i := 2 to 50 do
 begin // или используйте ymin := MinValue(y); и т.д.
 if y[i] < ymin then ymin := y[i];
 if y[i] > ymax then ymax := y[i];
 if x[i] < xmin then xmin := x[i];
 if x[i] > xmax then xmax := x[i];
 end;
 scalex := PaintBox1.Width / (xmax - xmin);
 scaley := PaintBox1.Height / (ymax - ymin);
 with PaintBox1.canvas do
 begin
 MoveTo(Trunc(scalex * (x[1] - xmin)), PaintBox1.Height - Trunc(scaley * (y[1] - ymin)));
 for i := 2 to 50 do
 LineTo(Trunc(scalex * (x[i] - xmin)), PaintBox1.Height - Trunc(scaley * (y[i] - ymin)));
 end;
end;
ID: 04098
----
Забавная штука синусы:
for i:=1 to 500 do
 PaintBox1.Canvas.Pixels[Round(sin(i*5)*10+50), Round(sin(i*10)*10+50)] := RGB(0,0,0);
Author: Baa
Source: http://forum.vingrad.ru
ID: 04099
Category:Алгоритмы
Category:Графика
Как нарисовать метафайл?

unit Metaform;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
type
 TForm1 = class(TForm)
 Panel1: TPanel;
 BitBtn1: TBitBtn;
 Image1: TImage;
 procedure BitBtn1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
type
 TMetafileCanvas = class(TCanvas)
 private
 FClipboardHandle: THandle;
 FMetafileHandle: HMetafile;
 FRect: TRect;
 protected
 procedure CreateHandle; override;
 function GetMetafileHandle: HMetafile;
 public
 constructor Create;
 destructor Destroy; override;
 property Rect: TRect read FRect write FRect;
 property MetafileHandle: HMetafile read GetMetafileHandle;
 end;
constructor TMetafileCanvas.Create;
begin
 inherited Create;
 FClipboardHandle := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;
destructor TMetafileCanvas.Destroy;
begin
 DeleteMetafile(CloseMetafile(Handle));
 if Bool(FClipboardHandle) then
 GlobalFree(FClipboardHandle);
 if Bool(FMetafileHandle) then
 DeleteMetafile(FMetafileHandle);
 inherited Destroy;
end;
procedure TMetafileCanvas.CreateHandle;
var
 MetafileDC: HDC;
begin
 { Create a metafile DC in memory }
 MetafileDC := CreateMetaFile(nil);
 if Bool(MetafileDC) then
 begin
 { Map the top,left corner of the displayed rectangle to the top,left of the
 device context. Leave a border of 10 logical units around the picture. }
 with FRect do
 SetWindowOrg(MetafileDC, Left - 10, Top - 10);
 { Set the extent of the picture with a border of 10 logical units.}
 with FRect do
 SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
 { Play any valid metafile contents to it. }
 if Bool(FMetafileHandle) then
 begin
 PlayMetafile(MetafileDC, FMetafileHandle);
 end;
 end;
 Handle := MetafileDC;
end;
function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
 MetafilePict: PMetafilePict;
 IC: HDC;
 ExtRect: TRect;
begin
 if Bool(FMetafileHandle) then
 DeleteMetafile(FMetafileHandle);
 FMetafileHandle := CloseMetafile(Handle);
 Handle := 0;
 { Prepair metafile for clipboard display. }
 MetafilePict := GlobalLock(FClipboardHandle);
 MetafilePict^.mm := mm_AnIsoTropic;
 IC := CreateIC('DISPLAY', nil, nil, nil);
 SetMapMode(IC, mm_HiMetric);
 ExtRect := FRect;
 DPtoLP(IC, ExtRect, 2);
 DeleteDC(IC);
 MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
 MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
 MetafilePict^.HMF := FMetafileHandle;
 GlobalUnlock(FClipboardHandle);
 { I'm giving you this handle, but please do NOT eat it. }
 Result := FClipboardHandle;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
 MetafileCanvas: TMetafileCanvas;
begin
 MetafileCanvas := TMetafileCanvas.Create;
 MetafileCanvas.Rect := Rect(0, 0, 500, 500);
 MetafileCanvas.Ellipse(10, 10, 400, 400);
 Image1.Picture.Metafile.LoadFromClipboardFormat(cf_MetafilePict,
 MetafileCanvas.MetafileHandle, 0);
 MetafileCanvas.Free;
end;
end.
Source: http://www.baltsoft.com/
ID: 03813
Category:Графика
Как нарисовать повёрнутый текст

uses
 QT;
procedure TForm1.RotatedText(Cnv: TCanvas; Wkl: Integer; Pxy: TPoint; Txt: string);
var
 PrPoint: TPoint;
begin
 // Rotate Canvas
 QPainter_rotate(Cnv.Handle, Wkl);
 // Convert Device Coord. to Modell- Coord.
 QPainter_xFormDev(Cnv.Handle, PPoint(@PrPoint), PPoint(@Pxy));
 // Write text.
 Canvas.TextOut(PrPoint.X, PrPoint.Y, 'Txt');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04613
Category:Kylix
Как нарисовать что-нибудь на TMemo?

=== Как нарисовать что-нибудь на TMemo? ===
Для рисования на поверхности TMemo необходимо создать создать собственный компонент, наследованный от TMemo и переопределить в нём рисование. Примерно так:
type 
 TMyMemo = class(TMemo) 
 protected 
 procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 
 end;
А теперь добавьте реализацию этой процедуры:
procedure TMyMemo.WMPaint(var Message: TWMPaint); 
var 
 MCanvas: TControlCanvas; 
 DrawBounds: TRect; 
begin 
 inherited; 
 MCanvas:=TControlCanvas.Create; 
 DrawBounds := ClientRect; // Работаем с временной записью TRect.
 try 
 MCanvas.Control := Self; 
 with MCanvas do 
 begin 
 Brush.Color := clBtnFace; 
 FrameRect(DrawBounds); 
 InflateRect(DrawBounds, -1, -1); 
 FrameRect(DrawBounds); 
 FillRect(DrawBounds); 
 MoveTo(33, 0); 
 Brush.Color := clWhite; 
 LineTo(33, ClientHeight); 
 PaintImages; 
 end; 
 finally 
 MCanvas.Free; 
 end; 
end; 
Процедура PaintImages рисует картинки на канвасе Memo.
procedure TMyMemo.PaintImages; 
var 
 MCanvas: TControlCanvas; 
 DrawBounds: TRect; 
 i, j: Integer; 
 OriginalRegion: HRGN; 
 ControlDC: HDC; 
begin 
 MCanvas := TControlCanvas.Create; 
 DrawBounds := ClientRect; // Работаем с временной записью TRect.
 try 
 MCanvas.Control := Self; 
 ControlDC := GetDC(Handle); 
 MCanvas.Draw(0, 1, Application.Icon); 
 finally 
 MCanvas.Free; 
 end; 
end;
Теперь мы имеем собственноручно нарисованный memo.
Source: Взято из http://forum.sources.ru
ID: 00554
Как настроить Personal Oracle с русским языком на корректную работу с числами и BDE

=== Как настроить Personal Oracle с русским языком на корректную работу с числами и BDE ===
прописать в
 \HKEY_LOCAL_MACHINE\SOFTWARE\ORACLE
параметр:
 NLS_NUMERIC_CHARACTERS = '.,'
или после соединения с ORACLE выполнить
ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'
Source: Взято с http://delphiworld.narod.ru
ID: 02728
Как настроить табуляцию в компоненте TMemo?

=== Как настроить табуляцию в компоненте TMemo? ===
Пошлите в Memo сообщение EM_SETTABSTOPS
Source: Взято с сайта http://blackman.wp-club.net/
ID: 00552
----
procedure TForm1.FormCreate(Sender: TObject);
var
 DialogUnitsX: LongInt;
 PixelsX: LongInt;
 i: integer;
 TabArray: array[0..4] of integer;
begin
 Memo1.WantTabs := true;
 DialogUnitsX := LoWord(GetDialogBaseUnits);
 PixelsX := 20;
 for i := 1 to 5 do
 begin
 TabArray[i - 1] := ((PixelsX * i) * 4) div DialogUnitsX;
 end;
 SendMessage(Memo1.Handle, EM_SETTABSTOPS, 5, LongInt(@TabArray));
 Memo1.Refresh;
end;
 DELPHI VCL FAQ Перевод с английского
 Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
 специально для Королевства Дельфи
Source: Взято из 
ID: 00553
----
Для этого надо послать сообщение EM_SetTabStops компоненте TMemo, в котором необходимо указать два параметра. Количество передаваемых значений и величины табуляций. 
Если первый параметр равняется нулю, то второй параметр игнорируется и величина табуляции сбрасывается в значение по умолчанию (32). Иначе, устанавливается величина указанная во втором параметре, причем, при единичном значении все величины табуляций будут равны, а при большем значении величины берутся из переданного массива. 
{ Установка одной величины табуляции }
const
 TabInc: LongInt = 40;
begin
 SendMessage(Memo1.Handle, EM_SetTabStops, 1, Longint(@TabInc));
end;
{ Установка двух величин табуляции }
const
 TabInc: array [1..2] of LongInt = (10, 30);
begin
 SendMessage(Memo1.Handle, EM_SetTabStops, 2, Longint(@TabInc));
end;
Source: http://delphiworld.narod.ru/
ID: 00991
Как начертить круг?

uses
 Math;
procedure DrawCircle(CenterX, CenterY, Radius: Integer; Canvas: TCanvas; Color: TColor);
 procedure PlotCircle(x, y, x1, y1: Integer);
 begin
 Canvas.Pixels[x + x1, y + y1] := Color;
 Canvas.Pixels[x - x1, y + y1] := Color;
 Canvas.Pixels[x + x1, y - y1] := Color;
 Canvas.Pixels[x - x1, y - y1] := Color;
 Canvas.Pixels[x + y1, y + x1] := Color;
 Canvas.Pixels[x - y1, y + x1] := Color;
 Canvas.Pixels[x + y1, y - x1] := Color;
 Canvas.Pixels[x - y1, y - x1] := Color;
 end;
var
 x, y, r: Integer;
 x1, y1, p: Integer;
begin
 x := CenterX;
 y := CenterY;
 r := Radius;
 x1 := 0;
 y1 := r;
 p := 3 - 2 * r;
 while (x1 < y1) do
 begin
 plotcircle(x, y, x1, y1);
 if (p < 0) then
 p := p + 4 * x1 + 6
 else
 begin
 p := p + 4 * (x1 - y1) + 10;
 y1 := y1 - 1;
 end;
 x1 := x1 + 1;
 end;
 if (x1 = y1) then
 PlotCircle(x, y, x1, y1);
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
 DrawCircle(ClientWidth div 2, ClientHeight div 2, Min(ClientWidth div 2,
 ClientHeight div 2), Canvas, clBlack);
 { Добавьте Math в uses для работы функции Min }
end;
Source: http://www.baltsoft.com/
ID: 03905
Category:Графика
Category:Рисование
Как обновить TQuery не потеряв при этом текущей записи?

=== Как обновить TQuery не потеряв при этом текущей записи? ===
procedure RefreshQuery(AQuery: TQuery; const FieldsForSearch: String);
var
 AList: TList;
 AVarArray: Variant;
 i: Byte;
begin
 AList := TList.Create;
 try
 AQuery.GetFieldList(AList, FieldsForSearch);
 AVarArray := VarArrayCreate([0, AList.Count - 1], varVariant);
 for i := 0 to Pred(AList.Count) do
 AVarArray[i] := TField(AList.Items[i]).AsVariant;
 AQuery.Close;
 AQuery.Open;
 AQuery.Locate(FieldsForSearch, AVarArray, []);
 finally
 AList.Free;
 AVarArray.Free;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 02548
Как обновить все окна Internet Explorer?

uses
 MSHTML_TLB, SHDocVw_TLB;
procedure TForm1.Button1Click(Sender: TObject);
var
 ShellWindow: IShellWindows;
 WB: IWebbrowser2;
 spDisp: IDispatch;
 IDoc1: IHTMLDocument2;
 k: Integer;
begin
 ShellWindow := CoShellWindows.Create;
 for k := 0 to ShellWindow.Count do
 begin
 spDisp := ShellWindow.Item(k);
 if spDisp = nil then Continue;
 spDisp.QueryInterface(iWebBrowser2, WB);
 if WB <> nil then
 begin
 WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
 if iDoc1 <> nil then
 begin
 WB := ShellWindow.Item(k) as IWebbrowser2;
 WB.Refresh;
 end;
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03519
Category:Связь
Category:WebBrowser